PROGRAM LA_SGGEVX_ET_EXAMPLE ! ! -- LAPACK95 interface driver routine (version 3.0) -- ! UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK ! September, 2000 ! ! .. USE STATEMENTS USE LA_PRECISION, ONLY: WP => SP USE F95_LAPACK, ONLY: LA_GGEVX ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. PARAMETERS .. CHARACTER(LEN=*), PARAMETER :: FMT = '(8(1X,F10.3))' INTEGER, PARAMETER :: NIN=5, NOUT=6 ! .. LOCAL SCALARS .. CHARACTER(LEN=1) :: BALANC INTEGER :: I, INFO, N, ILO, IHI REAL(WP) :: ABNRM, BBNRM ! .. LOCAL ARRAYS .. REAL(WP), ALLOCATABLE :: AA(:,:), BB(:,:) REAL(WP), ALLOCATABLE :: A(:,:), B(:,:), VL(:,:), & & VR(:,:), ALPHAR(:), ALPHAI(:), BETA(:), DUMMY(:,:) REAL(WP), ALLOCATABLE :: RCONDE(:), RCONDV(:), LSCALE(:), RSCALE(:) ! .. EXECUTABLE STATEMENTS .. WRITE (NOUT,*) 'SGGEVX ET_Example Program Results.' READ ( NIN, * ) ! SKIP HEADING IN DATA FILE READ ( NIN, * ) N PRINT *, 'N = ', N ALLOCATE ( A(N,N), AA(N,N), ALPHAR(N), ALPHAI(N), BETA(N), & & VL(N,N), VR(N,N), B(N,N), BB(N,N) ) ALLOCATE(RCONDE(N), RCONDV(N), LSCALE(N), RSCALE(N)) ! READ (NIN, *) AA, BB A=AA; B=BB WRITE(NOUT,*) 'The matrix A:' DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(I,:); ENDDO WRITE(NOUT,*) 'The matrix B:' DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) B(I,:); ENDDO ! WRITE ( NOUT, * )'---------------------------------------------------------' WRITE ( NOUT, * ) WRITE ( NOUT, * )'Details of LA_SGGEVX LAPACK Subroutine Results.' WRITE ( NOUT, * ) ! BALANC = 'N' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=N, ILO, IHI, & & LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) WRITE(NOUT,*) 'INFO = ', INFO WRITE(NOUT,*) ' Alphar:' WRITE(NOUT,FMT) ALPHAR WRITE(NOUT,*) ' Alphai:' WRITE(NOUT,FMT) ALPHAI WRITE(NOUT,*) ' Beta:' WRITE(NOUT,FMT) BETA WRITE(NOUT,*) 'VL:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO WRITE(NOUT,*) 'VR:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV ! BALANC = 'P' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=P, ILO, IHI, & & LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) WRITE(NOUT,*) 'INFO = ', INFO WRITE(NOUT,*) ' Alphar:' WRITE(NOUT,FMT) ALPHAR WRITE(NOUT,*) ' Alphai:' WRITE(NOUT,FMT) ALPHAI WRITE(NOUT,*) ' Beta:' WRITE(NOUT,FMT) BETA WRITE(NOUT,*) 'VL:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO WRITE(NOUT,*) 'VR:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV ! BALANC = 'S' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=S, ILO, IHI, & & LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) WRITE(NOUT,*) 'INFO = ', INFO WRITE(NOUT,*) ' Alphar:' WRITE(NOUT,FMT) ALPHAR WRITE(NOUT,*) ' Alphai:' WRITE(NOUT,FMT) ALPHAI WRITE(NOUT,*) ' Beta:' WRITE(NOUT,FMT) BETA WRITE(NOUT,*) 'VL:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO WRITE(NOUT,*) 'VR:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV ! BALANC = 'B' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR,BALANC=B,& & ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) WRITE(NOUT,*) 'INFO = ', INFO WRITE(NOUT,*) ' Alphar:' WRITE(NOUT,FMT) ALPHAR WRITE(NOUT,*) ' Alphai:' WRITE(NOUT,FMT) ALPHAI WRITE(NOUT,*) ' Beta:' WRITE(NOUT,FMT) BETA WRITE(NOUT,*) 'VL:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO WRITE(NOUT,*) 'VR:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO WRITE(NOUT,*) 'A:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(:,I); END DO WRITE(NOUT,*) 'B:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) B(:,I); END DO WRITE(NOUT,*) ' Alphar:' WRITE(NOUT,FMT) ALPHAR WRITE(NOUT,*) ' Alphai:' WRITE(NOUT,FMT) ALPHAI WRITE(NOUT,*) ' Beta:' WRITE(NOUT,FMT) BETA !STARTING THE ERROR RESULT TESTINGS WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( DUMMY, B, ALPHAR, ALPHAI, BETA, INFO=INFO )' A=AA CALL LA_GGEVX( DUMMY, B, ALPHAR, ALPHAI, BETA, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, DUMMY, ALPHAR, ALPHAI, BETA, INFO=INFO )' A=AA CALL LA_GGEVX( A, DUMMY, ALPHAR, ALPHAI, BETA, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! ERROR 3 WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR(1:N-1), ALPHAI, BETA, INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR(1:N-1), ALPHAI, BETA, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI(1:N-1), BETA, INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI(1:N-1), BETA, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA(1:N-1), INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA(1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO !ERROR 6 WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL(:,1:N-1), INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL(:,1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL(1:N-1,:), INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL(1:N-1,:), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO !ERROR 7 WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VR=VR(1:N-1,:), INFO=INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VR=VR(1:N-1,:), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VR=VR(:,1:N-1), INFO = INFO )' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VR=VR(:,1:N-1), INFO = INFO ) WRITE(NOUT,*) 'INFO = ', INFO !ERROR 8 BALANC = 'T' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=T, INFO = INFO)' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC='T', INFO = INFO) WRITE(NOUT,*) 'INFO = ', INFO ! ERROR 11 BALANC = 'T' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=B, LSCALE=LSCALE(1:N-1), INFO = INFO)' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC='B', LSCALE=LSCALE(1:N-1), INFO = INFO) WRITE(NOUT,*) 'INFO = ', INFO ! ERROR 12 BALANC = 'T' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=B, RSCALE=RSCALE(1:N-1), INFO = INFO)' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1),INFO = INFO) WRITE(NOUT,*) 'INFO = ', INFO ! ERROR 15 BALANC = 'T' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=B, & & RSCALE=RSCALE(1:N-1), RCONDE=RCONDE(1:N-1), INFO = INFO)' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1), RCONDE=RCONDE(1:N-1), INFO = INFO) WRITE(NOUT,*) 'INFO = ', INFO ! ERROR 16 BALANC = 'T' WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC=B, RSCALE=RSCALE(1:N-1), & & RCONDV=RCONDV(1:N-1), INFO = INFO)' A=AA CALL LA_GGEVX( A, B, ALPHAR, ALPHAI, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1), RCONDV=RCONDV(1:N-1), INFO = INFO) WRITE(NOUT,*) 'INFO = ', INFO END PROGRAM LA_SGGEVX_ET_EXAMPLE