* F08UPF Example Program Text * Mark 21. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER KAMAX, KBMAX, NMAX, MMAX PARAMETER (KAMAX=5,KBMAX=5,NMAX=20,MMAX=10) INTEGER LDAB, LDBB, LDQ, LDZ PARAMETER (LDAB=KAMAX+1,LDBB=KBMAX+1,LDQ=NMAX,LDZ=NMAX) CHARACTER UPLO PARAMETER (UPLO='U') DOUBLE PRECISION ZERO PARAMETER (ZERO=0.0D+0) * .. Local Scalars .. DOUBLE PRECISION ABSTOL, VL, VU INTEGER I, IFAIL, IL, INFO, IU, J, KA, KB, M, N * .. Local Arrays .. COMPLEX *16 AB(LDAB,NMAX), BB(LDBB,NMAX), Q(LDQ,NMAX), + WORK(NMAX), Z(LDZ,MMAX) DOUBLE PRECISION RWORK(7*NMAX), W(NMAX) INTEGER INDEX(NMAX), IWORK(5*NMAX) * .. External Subroutines .. EXTERNAL X04DAF, ZHBGVX * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Executable Statements .. WRITE (NOUT,*) 'F08UPF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) N, KA, KB IF (N.LE.NMAX .AND. KA.LE.KAMAX .AND. KB.LE.KBMAX) THEN * * Read the lower and upper bounds of the interval to be searched, * and read the upper or lower triangular parts of the matrices A * and B from data file * READ (NIN,*) VL, VU IF (UPLO.EQ.'U') THEN READ (NIN,*) ((AB(KA+1+I-J,J),J=I,MIN(N,I+KA)),I=1,N) READ (NIN,*) ((BB(KB+1+I-J,J),J=I,MIN(N,I+KB)),I=1,N) ELSE IF (UPLO.EQ.'L') THEN READ (NIN,*) ((AB(1+I-J,J),J=MAX(1,I-KA),I),I=1,N) READ (NIN,*) ((BB(1+I-J,J),J=MAX(1,I-KB),I),I=1,N) END IF * * Set the absolute error tolerance for eigenvalues. With ABSTOL * set to zero, the default value is used instead * ABSTOL = ZERO * * Solve the generalized symmetric eigenvalue problem * A*x = lambda*B*x * CALL ZHBGVX('Vectors','Values in range',UPLO,N,KA,KB,AB,LDAB, + BB,LDBB,Q,LDQ,VL,VU,IL,IU,ABSTOL,M,W,Z,LDZ,WORK, + RWORK,IWORK,INDEX,INFO) * IF (INFO.GE.0 .AND. INFO.LE.N .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) (INDEX(J),J=1,M) END IF ELSE IF (INFO.GT.N .AND. INFO.LE.2*N) THEN I = INFO - N WRITE (NOUT,99996) 'The leading minor of order ', I, + ' of B is not positive definite' ELSE IF (M.GT.MMAX) THEN WRITE (NOUT,99995) 'M greater than MMAX, M =', M, + ', MMAX =', MMAX ELSE WRITE (NOUT,99999) 'Failure in ZHBGVX. INFO =', INFO END IF ELSE WRITE (NOUT,*) WRITE (NOUT,*) 'NMAX too small' END IF STOP * 99999 FORMAT (1X,A,I5) 99998 FORMAT (3X,(8F8.4)) 99997 FORMAT (3X,(8I8)) 99996 FORMAT (1X,A,I4,A) 99995 FORMAT (1X,A,I5,A,I5) END