* F08UAF Example Program Text * Mark 21. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, KAMAX, KBMAX PARAMETER (NMAX=20,KAMAX=5,KBMAX=5) INTEGER LDAB, LDBB PARAMETER (LDAB=KAMAX+1,LDBB=KBMAX+1) CHARACTER UPLO PARAMETER (UPLO='U') * .. Local Scalars .. INTEGER I, INFO, J, KA, KB, N * .. Local Arrays .. DOUBLE PRECISION AB(LDAB,NMAX), BB(LDBB,NMAX), DUMMY(1,1), + W(NMAX), WORK(3*NMAX) * .. External Subroutines .. EXTERNAL DSBGV * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Executable Statements .. WRITE (NOUT,*) 'F08UAF 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 upper or lower triangular parts of the matrices A and * B from data file * 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 * * Solve the generalized symmetric band eigenvalue problem * A*x = lambda*B*x * CALL DSBGV('No vectors',UPLO,N,KA,KB,AB,LDAB,BB,LDBB,W,DUMMY,1, + WORK,INFO) * IF (INFO.EQ.0) THEN * * Print solution * WRITE (NOUT,*) 'Eigenvalues' WRITE (NOUT,99999) (W(J),J=1,N) ELSE IF (INFO.GT.N .AND. INFO.LE.2*N) THEN I = INFO - N WRITE (NOUT,99998) 'The leading minor of order ', I, + ' of B is not positive definite' ELSE WRITE (NOUT,99997) 'Failure in DSBGV. INFO =', INFO END IF ELSE WRITE (NOUT,*) 'NMAX too small' END IF STOP * 99999 FORMAT (3X,(6F11.4)) 99998 FORMAT (1X,A,I4,A) 99997 FORMAT (1X,A,I4) END