PROGRAM f08unfe ! F08UNF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : nag_wp, zhbgv ! .. 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, n ! .. Local Arrays .. COMPLEX (KIND=nag_wp), ALLOCATABLE :: ab(:,:), bb(:,:), work(:) COMPLEX (KIND=nag_wp) :: dummy(1,1) REAL (KIND=nag_wp), ALLOCATABLE :: rwork(:), w(:) ! .. Intrinsic Functions .. INTRINSIC max, min ! .. Executable Statements .. WRITE (nout,*) 'F08UNF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) READ (nin,*) n, ka, kb ldab = ka + 1 ldbb = kb + 1 ALLOCATE (ab(ldab,n),bb(ldbb,n),work(n),rwork(3*n),w(n)) ! 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 Hermitian band eigenvalue problem ! A*x = lambda*B*x ! The NAG name equivalent of zhbgv is f08unf CALL zhbgv('No vectors',uplo,n,ka,kb,ab,ldab,bb,ldbb,w,dummy,1,work, & rwork,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 ZHBGV. INFO =', info END IF 99999 FORMAT (3X,(6F11.4)) 99998 FORMAT (1X,A,I4,A) 99997 FORMAT (1X,A,I4) END PROGRAM f08unfe