* F08FUF Example Program Text * Mark 16 Release. NAG Copyright 1992. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, LDA, LDC, LWORK PARAMETER (NMAX=8,LDA=NMAX,LDC=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 .. COMPLEX *16 A(LDA,NMAX), C(LDC,NMAX), TAU(NMAX), WORK(LWORK) DOUBLE PRECISION D(NMAX), E(NMAX), RWORK(5*NMAX), W(NMAX) INTEGER IBLOCK(NMAX), IFAILV(NMAX), ISPLIT(NMAX), + IWORK(3*NMAX) CHARACTER CLABS(1), RLABS(1) * .. External Subroutines .. EXTERNAL DSTEBZ, X04DBF, ZHETRD, ZSTEIN, ZUNMTR * .. Executable Statements .. WRITE (NOUT,*) 'F08FUF 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**H)*A*Q * CALL ZHETRD(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,RWORK,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 C * CALL ZSTEIN(N,D,E,M,W,IBLOCK,ISPLIT,C,LDC,RWORK,IWORK, + IFAILV,INFO) * IF (INFO.GT.0) THEN WRITE (NOUT,*) 'Failure to converge.' ELSE * * Calculate the eigenvectors of A = Q * (eigenvectors of T) * CALL ZUNMTR('Left',UPLO,'No transpose',N,M,A,LDA,TAU,C, + LDC,WORK,LWORK,INFO) * * Print eigenvectors * WRITE (NOUT,*) IFAIL = 0 * CALL X04DBF('General',' ',N,M,C,LDC,'Bracketed','F7.4', + 'Eigenvectors','Integer',RLABS,'Integer', + CLABS,80,0,IFAIL) * END IF END IF END IF * 99999 FORMAT (8X,4(F7.4,11X,:)) END