@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 !