* F08FGF Example Program Text * Mark 16 Release. NAG Copyright 1992. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, LDA, LDZ, LWORK PARAMETER (NMAX=8,LDA=NMAX,LDZ=NMAX,LWORK=64*NMAX) DOUBLE PRECISION ZERO PARAMETER (ZERO=0.0D0) * .. Local Scalars .. DOUBLE PRECISION VL, VU INTEGER I, IFAIL, INFO, J, M, N, NSPLIT CHARACTER UPLO * .. Local Arrays .. DOUBLE PRECISION A(LDA,NMAX), D(NMAX), E(NMAX), TAU(NMAX), + W(NMAX), WORK(LWORK), Z(LDZ,NMAX) INTEGER IBLOCK(NMAX), IFAILV(NMAX), ISPLIT(NMAX), + IWORK(NMAX) * .. External Subroutines .. EXTERNAL DORMTR, DSTEBZ, DSTEIN, DSYTRD, X04CAF * .. Executable Statements .. WRITE (NOUT,*) 'F08FGF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read A from data file * READ (NIN,*) UPLO IF (UPLO.EQ.'U') THEN READ (NIN,*) ((A(I,J),J=I,N),I=1,N) ELSE IF (UPLO.EQ.'L') THEN READ (NIN,*) ((A(I,J),J=1,I),I=1,N) END IF * * Reduce A to tridiagonal form T = (Q**T)*A*Q * CALL DSYTRD(UPLO,N,A,LDA,D,E,TAU,WORK,LWORK,INFO) * * Calculate the two smallest eigenvalues of T (same as A) * CALL DSTEBZ('I','B',N,VL,VU,1,2,ZERO,D,E,M,NSPLIT,W,IBLOCK, + ISPLIT,WORK,IWORK,INFO) * WRITE (NOUT,*) IF (INFO.GT.0) THEN WRITE (NOUT,*) 'Failure to converge.' ELSE WRITE (NOUT,*) 'Eigenvalues' WRITE (NOUT,99999) (W(I),I=1,M) * * Calculate the eigenvectors of T, storing the result in Z * CALL DSTEIN(N,D,E,M,W,IBLOCK,ISPLIT,Z,LDZ,WORK,IWORK,IFAILV, + INFO) * IF (INFO.GT.0) THEN WRITE (NOUT,*) 'Failure to converge.' ELSE * * Calculate the eigenvectors of A = Q * (eigenvectors of T) * CALL DORMTR('Left',UPLO,'No transpose',N,M,A,LDA,TAU,Z, + LDZ,WORK,LWORK,INFO) * * Print eigenvectors * WRITE (NOUT,*) IFAIL = 0 * CALL X04CAF('General',' ',N,M,Z,LDZ,'Eigenvectors',IFAIL) * END IF END IF END IF STOP * 99999 FORMAT (3X,(9F8.4)) END