* F08FPF 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, LWORK PARAMETER (LDA=NMAX,LDZ=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, LWKOPT, M, N * .. Local Arrays .. COMPLEX *16 A(LDA,NMAX), WORK(LWORK), Z(LDZ,MMAX) DOUBLE PRECISION RWORK(7*NMAX), W(NMAX) INTEGER IWORK(5*NMAX), JFAIL(NMAX) * .. External Subroutines .. EXTERNAL X04DAF, ZHEEVX * .. Intrinsic Functions .. INTRINSIC INT * .. Executable Statements .. WRITE (NOUT,*) 'F08FPF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read the lower and upper bounds of the interval to be searched, * and read the upper triangular part of the matrix A from data * file * READ (NIN,*) VL, VU 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 Hermitian eigenvalue problem * CALL ZHEEVX('Vectors','Values in range','Upper',N,A,LDA,VL,VU, + IL,IU,ABSTOL,M,W,Z,LDZ,WORK,LWORK,RWORK,IWORK, + JFAIL,INFO) LWKOPT = INT(WORK(1)) * IF (INFO.GE.0 .AND. M.LE.MMAX) THEN * * Print solution * WRITE (NOUT,99999) 'Number of eigenvalues found =', M WRITE (NOUT,*) WRITE (NOUT,*) 'Eigenvalues' WRITE (NOUT,99998) (W(J),J=1,M) * IFAIL = 0 CALL X04DAF('General',' ',N,M,Z,LDZ,'Selected eigenvectors', + IFAIL) IF (INFO.GT.0) THEN WRITE (NOUT,99999) + 'INFO eigenvectors failed to converge, INFO =', INFO WRITE (NOUT,*) + 'Indices of eigenvectors that did not converge' WRITE (NOUT,99997) (JFAIL(J),J=1,M) END IF ELSE IF (M.GT.MMAX) THEN WRITE (NOUT,99996) 'M greater than MMAX, M =', M, + ', MMAX =', MMAX ELSE WRITE (NOUT,99999) 'Failure in ZHEEVX. INFO =', INFO END IF * * Print workspace information * IF (LWORK.LT.LWKOPT) THEN WRITE (NOUT,*) WRITE (NOUT,99995) 'Optimum complex workspace required = ', + LWKOPT, 'Workspace provided in WORK = ', LWORK END IF ELSE WRITE (NOUT,*) WRITE (NOUT,*) 'NMAX too small' END IF * 99999 FORMAT (1X,A,I5) 99998 FORMAT (3X,(8F8.4)) 99997 FORMAT (3X,(8I8)) 99996 FORMAT (1X,A,I5,A,I5) 99995 FORMAT (1X,A,I5,/1X,A,I5) END