* F08GGF Example Program Text * Mark 16 Release. NAG Copyright 1992. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, LDC PARAMETER (NMAX=8,LDC=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 AP(NMAX*(NMAX+1)/2), C(LDC,NMAX), D(NMAX), + E(NMAX), TAU(NMAX), W(NMAX), WORK(5*NMAX) INTEGER IBLOCK(NMAX), IFAILV(NMAX), ISPLIT(NMAX), + IWORK(3*NMAX) * .. External Subroutines .. EXTERNAL DOPMTR, DSPTRD, DSTEBZ, DSTEIN, X04CAF * .. Executable Statements .. WRITE (NOUT,*) 'F08GGF 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,*) ((AP(I+J*(J-1)/2),J=I,N),I=1,N) ELSE IF (UPLO.EQ.'L') THEN READ (NIN,*) ((AP(I+(2*N-J)*(J-1)/2),J=1,I),I=1,N) END IF * * Reduce A to tridiagonal form T = (Q**T)*A*Q * CALL DSPTRD(UPLO,N,AP,D,E,TAU,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 C * CALL DSTEIN(N,D,E,M,W,IBLOCK,ISPLIT,C,LDC,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 DOPMTR('Left',UPLO,'No transpose',N,M,AP,TAU,C,LDC, + WORK,INFO) * * Print eigenvectors * WRITE (NOUT,*) IFAIL = 0 * CALL X04CAF('General',' ',N,M,C,LDC,'Eigenvectors',IFAIL) * END IF END IF END IF * 99999 FORMAT (3X,(9F8.4)) END