PROGRAM f08ucfe ! F08UCF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : dsbgvd, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 CHARACTER (1), PARAMETER :: uplo = 'U' ! .. Local Scalars .. INTEGER :: i, info, j, ka, kb, ldab, ldbb, & liwork, lwork, n ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: ab(:,:), bb(:,:), w(:), work(:) REAL (KIND=nag_wp) :: dummy(1,1) INTEGER, ALLOCATABLE :: iwork(:) ! .. Intrinsic Functions .. INTRINSIC max, min ! .. Executable Statements .. WRITE (nout,*) 'F08UCF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) READ (nin,*) n, ka, kb ldab = ka + 1 ldbb = kb + 1 liwork = 1 lwork = 3*n ALLOCATE (ab(ldab,n),bb(ldbb,n),w(n),work(lwork),iwork(liwork)) ! Read the upper or lower triangular parts of the matrices A and ! B from data file IF (uplo=='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=='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 ! The NAG name equivalent of dsbgvd is f08ucf CALL dsbgvd('No vectors',uplo,n,ka,kb,ab,ldab,bb,ldbb,w,dummy,1,work, & lwork,iwork,liwork,info) IF (info==0) THEN ! Print solution WRITE (nout,*) 'Eigenvalues' WRITE (nout,99999) w(1:n) ELSE IF (info>n .AND. info<=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 DSBGVD. INFO =', info END IF 99999 FORMAT (3X,(6F11.4)) 99998 FORMAT (1X,A,I4,A) 99997 FORMAT (1X,A,I4) END PROGRAM f08ucfe