@extract -b incpath.inc @extract -b @(incd)/type.inc type=@(@type) @ROUT geevx PROGRAM LA_@(pre)GEEVX_ET_EXAMPLE @extract -b @(incd)/header.inc -case0 ! .. Use Statements USE LA_PRECISION, ONLY: WP => @(upr)P USE F90_LAPACK, ONLY: LA_GEEVX ! .. 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, INFO, N, ILO, IHI REAL(WP) :: ABNRM ! .. Local Arrays .. REAL(WP), ALLOCATABLE :: AA(:,:), SCALE(:), RCONDE(:), RCONDV(:) @type sreal dreal REAL(WP), ALLOCATABLE :: A(:,:), WR(:), WI(:), VL(:,:), VR(:,:), DUMMY(:,:) @type scplx dcplx COMPLEX(WP), ALLOCATABLE :: A(:,:), W(:), VL(:,:), VR(:,:), DUMMY(:,:) @type ! ! .. Executable Statements .. WRITE (NOUT,*) '@(pre)GEEVX ET_Example Program Results.' READ ( NIN, * ) ! Skip heading in data file READ ( NIN, * ) N PRINT *, 'N = ', N @type sreal dreal ALLOCATE ( A(N,N), AA(N,N), WR(N), WI(N), VL(N,N), VR(N,N), SCALE(N), & RCONDE(N), RCONDV(N) ) @type scplx dcplx ALLOCATE ( A(N,N), AA(N,N), W(N), VL(N,N), VR(N,N), SCALE(N), RCONDE(N), & RCONDV(N) ) @type ! ! READ (NIN, *) AA A=AA WRITE(NOUT,*) 'The matrix A:' DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(I,:); ENDDO ! WRITE ( NOUT, * )'---------------------------------------------------------' WRITE ( NOUT, * ) @type sreal dreal WRITE ( NOUT, * )'Details of LA_@(pre)GEEVX LAPACK Subroutine Results.' WRITE ( NOUT, * ) ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VL, VR, BALANC, &' WRITE(NOUT,*) ' ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, INFO )' A=AA CALL LA_GEEVX( A, WR, WI, VL, VR, 'N', ILO, IHI, SCALE, & ABNRM, RCONDE, RCONDV, INFO ) WRITE(NOUT,*) ' ILO, IHI, INFO:', ILO, IHI, INFO WRITE(NOUT,*) ' SCALE, ABNRM, RCONDE, RCONDV:' WRITE(NOUT,*) SCALE, ABNRM, RCONDE, RCONDV WRITE(NOUT,*) ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI WRITE(NOUT,*) 'Eigenvectors ( VL and VR ):' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VL )' A=AA CALL LA_GEEVX( A, WR, WI, VL ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI WRITE(NOUT,*) 'Eigenvectors ( Only VL ):' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VR )' A=AA CALL LA_GEEVX( A, WR, WI, VR ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI WRITE(NOUT,*) 'Eigenvectors ( Only VR ):' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, BALANC=''P'', INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, BALANC='P', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, BALANC=''S'', INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, BALANC='S', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, BALANC=''B'', INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, BALANC='B', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, BALANC=''1'', INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, BALANC='1', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) WR WRITE(NOUT,FMT) WI ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( DUMMY, WR, WI, VL, VR, INFO=INFO )' A=AA CALL LA_GEEVX( DUMMY, WR, WI, VL, VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR(1:N-1), WI, VL, VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, WR(1:N-1), WI, VL, VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI(1:N-1), VL, VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI(1:N-1), VL, VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VL(1:N-1,:), VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, VL(1:N-1,:), VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VL(:,1:N-1), VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, VL(:,1:N-1), VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VL, VR(1:N-1,:), INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, VL, VR(1:N-1,:), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, WR, WI, VL, VR(:,1:N-1), INFO=INFO )' A=AA CALL LA_GEEVX( A, WR, WI, VL, VR(:,1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! END PROGRAM LA_@(pre)GEEVX_ET_EXAMPLE @type scplx dcplx WRITE ( NOUT, * )'Details of LA_@(pre)GEEVX LAPACK Subroutine Results.' WRITE ( NOUT, * ) ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VL, VR, BALANC, &' WRITE(NOUT,*) ' ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, INFO )' A=AA CALL LA_GEEVX( A, W, VL, VR, 'N', ILO, IHI, SCALE, & ABNRM, RCONDE, RCONDV, INFO ) WRITE(NOUT,*) ' ILO, IHI, INFO:', ILO, IHI, INFO WRITE(NOUT,*) ' SCALE, ABNRM, RCONDE, RCONDV:' WRITE(NOUT,*) SCALE, ABNRM, RCONDE, RCONDV WRITE(NOUT,*) ' Eigenvalues:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'Eigenvectors ( VL and VR ):' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VL )' A=AA CALL LA_GEEVX( A, W, VL ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'Eigenvectors ( Only VL ):' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VR )' A=AA CALL LA_GEEVX( A, W, VR ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'Eigenvectors ( Only VR ):' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, INFO=INFO )' A=AA CALL LA_GEEVX( A, W, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, BALANC=''P'', INFO=INFO )' A=AA CALL LA_GEEVX( A, W, BALANC='P', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, BALANC=''S'', INFO=INFO )' A=AA CALL LA_GEEVX( A, W, BALANC='S', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, BALANC=''B'', INFO=INFO )' A=AA CALL LA_GEEVX( A, W, BALANC='B', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, BALANC=''1'', INFO=INFO )' A=AA CALL LA_GEEVX( A, W, BALANC='1', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' Eigenvalues:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( DUMMY, W, VL, VR, INFO=INFO )' A=AA CALL LA_GEEVX( DUMMY, W, VL, VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W(1:N-1), VL, VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, W(1:N-1), VL, VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W(1:N-1), VL, VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, W(1:N-1), VL, VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VL(1:N-1,:), VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, W, VL(1:N-1,:), VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VL(:,1:N-1), VR, INFO=INFO )' A=AA CALL LA_GEEVX( A, W, VL(:,1:N-1), VR, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VL, VR(1:N-1,:), INFO=INFO )' A=AA CALL LA_GEEVX( A, W, VL, VR(1:N-1,:), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GEEVX( A, W, VL, VR(:,1:N-1), INFO=INFO )' A=AA CALL LA_GEEVX( A, W, VL, VR(:,1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! END PROGRAM LA_@(pre)GEEVX_ET_EXAMPLE @type !