@extract -b incpath.inc
@extract -b @(incd)/type.inc type=@(@type)
@ROUT sygv
 @type sreal dreal
PROGRAM LA_@(pre)SYGV_ET_EXAMPLE
 @type sherm dherm
PROGRAM LA_@(pre)HEGV_ET_EXAMPLE
 @type !
@extract -b @(incd)/header.inc -case0
!  .. Use Statements
   USE LA_PRECISION, ONLY: WP => @(upr)P
 @type sreal dreal
   USE F90_LAPACK, ONLY: LA_SYGV
 @type sherm dherm
   USE F90_LAPACK, ONLY: LA_HEGV
 @type !
!  .. Implicit Statement ..
   IMPLICIT NONE
!  .. Parameters ..
 @type sreal dreal
      CHARACTER(LEN=*), PARAMETER :: FMT = '(8(1X,F10.3))'
 @type scplx dcplx sherm dherm
      CHARACTER(LEN=*), PARAMETER :: FMT = '(4(1X,1H(,F7.3,1H,,F7.3,1H):))'
 @type !
   INTEGER, PARAMETER :: NIN=5, NOUT=6
!  .. Local Scalars ..
   INTEGER :: I, J, INFO, N 
!  .. Local Arrays ..
   REAL(WP), ALLOCATABLE :: AA(:,:), BB(:,:), W(:)
   @(type)(WP), ALLOCATABLE :: A(:,:), B(:,:)
!  .. Executable Statements ..
 @type sreal dreal
   WRITE(NOUT,*) '@(pre)SYGV ET_Example Program Results.'
 @type sherm dherm
   WRITE(NOUT,*) '@(pre)HEGV ET_Example Program Results.'
 @type !
   READ(NIN,*) ! Skip heading in data file
   READ(NIN,*) N
   ALLOCATE ( A(N,N), B(N,N), W(N), AA(N,N), BB(N,N) )
      DO I = 1, N
        READ(NIN,*) (AA(I, J), J = 1, N)
      ENDDO
      DO I = 1, N
        READ(NIN,*) (BB(I, J), J = 1, N)
      ENDDO
      A=AA; B=BB
      WRITE(NOUT,*) 'The matrix A:'
      DO I = 1, N
        WRITE(NOUT,FMT) A(I,:)
      ENDDO
      WRITE(NOUT,*) 'The matrix B:'
      DO I = 1, N
        WRITE(NOUT,FMT) B(I,:)
      ENDDO
!
   WRITE(NOUT,*) '---------------------------------------------------------'
   WRITE(NOUT,*)
 @type sreal dreal
   WRITE ( NOUT, * )'Details of LA_@(pre)SYGV LAPACK Subroutine Results.'
   WRITE(NOUT,*)
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) 'CALL LA_SYGV(A, B, W, INFO=INFO)'
   WRITE(NOUT,*) 'LA_SYGV computes all the eigenvalues of a real'
   WRITE(NOUT,*) 'symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*x = lambda*B*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (upper triangular)'
   WRITE(NOUT,*) '   B - the original matrix (upper triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - destroyed matrix A'
   WRITE(NOUT,*) '   B - the triangular factor U from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_SYGV(A,B,W,INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_SYGV(A, B, W, JOBZ='V', INFO=INFO)"
   WRITE(NOUT,*) 'LA_SYGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*x = lambda*B*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (upper triangular)'
   WRITE(NOUT,*) '   B - the original matrix (upper triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*B*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor U from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_SYGV(A,B,W,JOBZ='V',INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_SYGV(A, B, W, JOBZ='V', UPLO='L', INFO=INFO)"
   WRITE(NOUT,*) 'LA_SYGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*x = lambda*B*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (lower triangular)'
   WRITE(NOUT,*) '   B - the original matrix (lower triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*B*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor L from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_SYGV(A,B,W,JOBZ='V',UPLO='L',INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_SYGV(A, B, W, 2, 'V', 'L', INFO)"
   WRITE(NOUT,*) 'LA_SYGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*B*x = lambda*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (lower triangular)'
   WRITE(NOUT,*) '   B - the original matrix (lower triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*B*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor L from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_SYGV(A,B,W,2,'V','L',INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_SYGV(A, B, W, 3, 'V', INFO=INFO)"
   WRITE(NOUT,*) 'LA_SYGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'B*A*x = lambda*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (upper triangular)'
   WRITE(NOUT,*) '   B - the original matrix (upper triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*inv(B)*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor U from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_SYGV(A,B,W,3,'V',INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
END PROGRAM LA_@(pre)SYGV_ET_EXAMPLE
 @type sherm dherm
   WRITE ( NOUT, * )'Details of LA_@(pre)HEGV LAPACK Subroutine Results.'
   WRITE(NOUT,*)
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) 'CALL LA_HEGV(A, B, W, INFO=INFO)'
   WRITE(NOUT,*) 'LA_HEGV computes all the eigenvalues of a real'
   WRITE(NOUT,*) 'symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*x = lambda*B*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (upper triangular)'
   WRITE(NOUT,*) '   B - the original matrix (upper triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - destroyed matrix A'
   WRITE(NOUT,*) '   B - the triangular factor U from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_HEGV(A,B,W,INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_HEGV(A, B, W, JOBZ='V', INFO=INFO)"
   WRITE(NOUT,*) 'LA_HEGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*x = lambda*B*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (upper triangular)'
   WRITE(NOUT,*) '   B - the original matrix (upper triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*B*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor U from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_HEGV(A,B,W,JOBZ='V',INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_HEGV(A, B, W, JOBZ='V', UPLO='L', INFO=INFO)"
   WRITE(NOUT,*) 'LA_HEGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*x = lambda*B*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (lower triangular)'
   WRITE(NOUT,*) '   B - the original matrix (lower triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*B*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor L from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_HEGV(A,B,W,JOBZ='V',UPLO='L',INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_HEGV(A, B, W, 2, 'V', 'L', INFO)"
   WRITE(NOUT,*) 'LA_HEGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'A*B*x = lambda*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (lower triangular)'
   WRITE(NOUT,*) '   B - the original matrix (lower triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*B*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor L from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_HEGV(A,B,W,2,'V','L',INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
   WRITE(NOUT,*)
   WRITE(NOUT,*) "CALL LA_HEGV(A, B, W, 3, 'V', INFO=INFO)"
   WRITE(NOUT,*) 'LA_HEGV computes all the eigenvalues and eigenvectors'
   WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem'
   WRITE(NOUT,*) 'B*A*x = lambda*x'
   WRITE(NOUT,*) 'ON ENTRY: A, B'
   WRITE(NOUT,*) '   A - the original matrix (upper triangular)'
   WRITE(NOUT,*) '   B - the original matrix (upper triangular)'
   WRITE(NOUT,*) 'ON EXIT: A, B, W'
   WRITE(NOUT,*) '   A - the eigenvectors normalized as follows:'
   WRITE(NOUT,*) '       Z**T*inv(B)*Z = I'
   WRITE(NOUT,*) '   B - the triangular factor U from the Cholesky'
   WRITE(NOUT,*) '       factorization'
   WRITE(NOUT,*) '   W - the eigenvalues in ascending order'
   A=AA
   B=BB
   CALL LA_HEGV(A,B,W,3,'V',INFO=INFO)
   WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGV:'
   WRITE(NOUT,FMT) W(:)
   WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGV:'
   DO I = 1, N
      WRITE(NOUT,FMT) A(I,:)
   END DO
   WRITE(NOUT,*) 'INFO = ',INFO
!
END PROGRAM LA_@(pre)HEGV_ET_EXAMPLE
 @type !
