* F08FRF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NB, NMAX, MMAX PARAMETER (NB=64,NMAX=10,MMAX=5) INTEGER LDA, LDZ, LIWORK, LRWORK, LWORK PARAMETER (LDA=NMAX,LDZ=NMAX,LIWORK=10*NMAX,LRWORK=24*NMAX, + LWORK=(NB+1)*NMAX) DOUBLE PRECISION ZERO PARAMETER (ZERO=0.0D+0) * .. Local Scalars .. DOUBLE PRECISION ABSTOL, VL, VU INTEGER I, IFAIL, IL, INFO, IU, J, LIWOPT, LRWOPT, LWOPT, + M, N * .. Local Arrays .. COMPLEX *16 A(LDA,NMAX), WORK(LWORK), Z(LDZ,MMAX) DOUBLE PRECISION RWORK(LRWORK), W(NMAX) INTEGER ISUPPZ(2*MMAX), IWORK(LIWORK) * .. External Subroutines .. EXTERNAL X04DAF, ZHEEVR * .. Executable Statements .. WRITE (NOUT,*) 'F08FRF Example Program Results' WRITE (NOUT,*) * Skip heading in data file and read N and the lower and upper * indices of the smallest and largest eigenvalues to be found READ (NIN,*) READ (NIN,*) N, IL, IU IF (N.LE.NMAX .AND. (IU-IL+1).LE.MMAX) THEN * * Read the upper triangular part of the matrix A from data file * READ (NIN,*) ((A(I,J),J=I,N),I=1,N) * * Set the absolute error tolerance for eigenvalues. With ABSTOL * set to zero, the default value is used instead * ABSTOL = ZERO * * Solve the symmetric eigenvalue problem * CALL ZHEEVR('Vectors','I','Upper',N,A,LDA,VL,VU,IL,IU,ABSTOL,M, + W,Z,LDZ,ISUPPZ,WORK,LWORK,RWORK,LRWORK,IWORK, + LIWORK,INFO) LWOPT = WORK(1) LRWOPT = RWORK(1) LIWOPT = IWORK(1) * IF (INFO.EQ.0) THEN * * Print solution * WRITE (NOUT,*) 'Selected eigenvalues' WRITE (NOUT,99999) (W(J),J=1,M) * IFAIL = 0 CALL X04DAF('General',' ',N,M,Z,LDZ,'Selected eigenvectors', + IFAIL) ELSE WRITE (NOUT,99998) 'Failure in ZHEEVR. INFO =', INFO END IF * * Print workspace information * IF (LWORK.LT.LWOPT) THEN WRITE (NOUT,*) WRITE (NOUT,99997) 'Optimum complex workspace required = ', + LWOPT, 'Complex workspace provided = ', LWORK END IF IF (LRWORK.LT.LRWOPT) THEN WRITE (NOUT,*) WRITE (NOUT,99997) 'Real workspace required = ', LRWOPT, + 'Real workspace provided = ', LRWORK END IF IF (LIWORK.LT.LIWOPT) THEN WRITE (NOUT,*) WRITE (NOUT,99997) 'Integer workspace required = ', LIWOPT, + 'Integer workspace provided = ', LIWORK END IF ELSE WRITE (NOUT,*) 'NMAX and/or MMAX too small' END IF STOP * 99999 FORMAT (3X,(8F8.4)) 99998 FORMAT (1X,A,I5) 99997 FORMAT (1X,A,I5,/1X,A,I5) END