1PROGRAM LA_ZGGEVX_ET_EXAMPLE 2! 3! -- LAPACK95 interface driver routine (version 3.0) -- 4! UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK 5! September, 2000 6! 7! .. USE STATEMENTS 8 USE LA_PRECISION, ONLY: WP => DP 9 USE F95_LAPACK, ONLY: LA_GGEVX 10! .. IMPLICIT STATEMENT .. 11 IMPLICIT NONE 12! .. PARAMETERS .. 13 CHARACTER(LEN=*), PARAMETER :: FMT = '(4(1X,1H(,F7.3,1H,,F7.3,1H):))' 14 INTEGER, PARAMETER :: NIN=5, NOUT=6 15! .. LOCAL SCALARS .. 16 CHARACTER(LEN=1) :: BALANC 17 INTEGER :: I, INFO, N, ILO, IHI 18 REAL(WP) :: ABNRM, BBNRM 19! .. LOCAL ARRAYS .. 20 REAL(WP), ALLOCATABLE :: AA(:,:), BB(:,:) 21 COMPLEX(WP), ALLOCATABLE :: A(:,:), B(:,:), VL(:,:), & 22& VR(:,:), ALPHA(:), BETA(:), DUMMY(:,:) 23 REAL(WP), ALLOCATABLE :: RCONDE(:), RCONDV(:), LSCALE(:), RSCALE(:) 24! .. EXECUTABLE STATEMENTS .. 25 WRITE (NOUT,*) 'ZGGEVX ET_Example Program Results.' 26 READ ( NIN, * ) ! SKIP HEADING IN DATA FILE 27 READ ( NIN, * ) N 28 PRINT *, 'N = ', N 29 ALLOCATE ( A(N,N), AA(N,N), ALPHA(N), BETA(N), & 30& VL(N,N), VR(N,N), B(N,N), BB(N,N) ) 31 ALLOCATE(RCONDE(N), RCONDV(N), LSCALE(N), RSCALE(N)) 32! 33 READ (NIN, *) AA, BB 34 A=AA; B=BB 35 WRITE(NOUT,*) 'The matrix A:' 36 DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(I,:); ENDDO 37 WRITE(NOUT,*) 'The matrix B:' 38 DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) B(I,:); ENDDO 39! 40 WRITE ( NOUT, * )'---------------------------------------------------------' 41 WRITE ( NOUT, * ) 42 WRITE ( NOUT, * )'Details of LA_ZGGEVX LAPACK Subroutine Results.' 43 WRITE ( NOUT, * ) 44! 45 BALANC = 'N' 46 WRITE(NOUT,*) 47 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=N, ILO, IHI, & 48 & LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' 49 A=AA 50 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) 51 WRITE(NOUT,*) 'INFO = ', INFO 52 WRITE(NOUT,*) ' ALPHA:' 53 WRITE(NOUT,FMT) ALPHA 54 WRITE(NOUT,*) ' Beta:' 55 WRITE(NOUT,FMT) BETA 56 WRITE(NOUT,*) 'VL:' 57 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO 58 WRITE(NOUT,*) 'VR:' 59 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO 60 WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI 61 WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM 62 WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE 63 WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE 64 WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE 65 WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV 66! 67 BALANC = 'P' 68 WRITE(NOUT,*) 69 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=P, ILO, IHI, & 70 & LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' 71 A=AA 72 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) 73 WRITE(NOUT,*) 'INFO = ', INFO 74 WRITE(NOUT,*) ' ALPHA:' 75 WRITE(NOUT,FMT) ALPHA 76 WRITE(NOUT,*) ' Beta:' 77 WRITE(NOUT,FMT) BETA 78 WRITE(NOUT,*) 'VL:' 79 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO 80 WRITE(NOUT,*) 'VR:' 81 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO 82 WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI 83 WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM 84 WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE 85 WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE 86 WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE 87 WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV 88! 89 BALANC = 'S' 90 WRITE(NOUT,*) 91 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=S, ILO, IHI, & 92 & LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' 93 A=AA 94 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) 95 WRITE(NOUT,*) 'INFO = ', INFO 96 WRITE(NOUT,*) ' ALPHA:' 97 WRITE(NOUT,FMT) ALPHA 98 WRITE(NOUT,*) ' Beta:' 99 WRITE(NOUT,FMT) BETA 100 WRITE(NOUT,*) 'VL:' 101 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO 102 WRITE(NOUT,*) 'VR:' 103 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO 104 WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI 105 WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM 106 WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE 107 WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE 108 WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE 109 WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV 110! 111 BALANC = 'B' 112 WRITE(NOUT,*) 113 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR,BALANC=B,& 114 & ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )' 115 A=AA 116 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO ) 117 WRITE(NOUT,*) 'INFO = ', INFO 118 WRITE(NOUT,*) ' ALPHA:' 119 WRITE(NOUT,FMT) ALPHA 120 WRITE(NOUT,*) ' Beta:' 121 WRITE(NOUT,FMT) BETA 122 WRITE(NOUT,*) 'VL:' 123 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO 124 WRITE(NOUT,*) 'VR:' 125 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO 126 WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI 127 WRITE (NOUT,*) 'ABNRM = ', ABNRM; WRITE (NOUT,*) 'BBNRM = ', BBNRM 128 WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE 129 WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE 130 WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE 131 WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV 132! 133 WRITE(NOUT,*) 134 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, INFO=INFO )' 135 A=AA 136 CALL LA_GGEVX( A, B, ALPHA, BETA, INFO=INFO ) 137 WRITE(NOUT,*) 'INFO = ', INFO 138 WRITE(NOUT,*) 'A:' 139 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(:,I); END DO 140 WRITE(NOUT,*) 'B:' 141 DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) B(:,I); END DO 142 WRITE(NOUT,*) ' ALPHA:' 143 WRITE(NOUT,FMT) ALPHA 144 WRITE(NOUT,*) ' Beta:' 145 WRITE(NOUT,FMT) BETA 146!STARTING THE ERROR RESULT TESTINGS 147 WRITE(NOUT,*) 148 WRITE(NOUT,*) 'CALL LA_GGEVX( DUMMY, B, ALPHA, BETA, INFO=INFO )' 149 A=AA 150 CALL LA_GGEVX( DUMMY, B, ALPHA, BETA, INFO=INFO ) 151 WRITE(NOUT,*) 'INFO = ', INFO 152! 153 WRITE(NOUT,*) 154 WRITE(NOUT,*) 'CALL LA_GGEVX( A, DUMMY, ALPHA, BETA, INFO=INFO )' 155 A=AA 156 CALL LA_GGEVX( A, DUMMY, ALPHA, BETA, INFO=INFO ) 157 WRITE(NOUT,*) 'INFO = ', INFO 158! ERROR 3 159 WRITE(NOUT,*) 160 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA(1:N-1), BETA, INFO=INFO )' 161 A=AA 162 CALL LA_GGEVX( A, B, ALPHA(1:N-1), BETA, INFO=INFO ) 163 WRITE(NOUT,*) 'INFO = ', INFO 164! 165 WRITE(NOUT,*) 166 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA=BETA(1:N-1), INFO=INFO )' 167 A=AA 168 CALL LA_GGEVX( A, B, ALPHA, BETA=BETA(1:N-1), INFO=INFO ) 169 WRITE(NOUT,*) 'INFO = ', INFO 170!ERROR 6 171 WRITE(NOUT,*) 172 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL(:,1:N-1), INFO=INFO )' 173 A=AA 174 CALL LA_GGEVX( A, B, ALPHA, BETA, VL(:,1:N-1), INFO=INFO ) 175 WRITE(NOUT,*) 'INFO = ', INFO 176! 177 WRITE(NOUT,*) 178 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL(1:N-1,:), INFO=INFO )' 179 A=AA 180 CALL LA_GGEVX( A, B, ALPHA, BETA, VL(1:N-1,:), INFO=INFO ) 181 WRITE(NOUT,*) 'INFO = ', INFO 182!ERROR 7 183 WRITE(NOUT,*) 184 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B,ALPHA, BETA, VR=VR(1:N-1,:), INFO=INFO )' 185 A=AA 186 CALL LA_GGEVX( A, B, ALPHA, BETA, VR=VR(1:N-1,:), INFO=INFO ) 187 WRITE(NOUT,*) 'INFO = ', INFO 188! 189 WRITE(NOUT,*) 190 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VR=VR(:,1:N-1), INFO = INFO )' 191 A=AA 192 CALL LA_GGEVX( A, B, ALPHA, BETA, VR=VR(:,1:N-1), INFO = INFO ) 193 WRITE(NOUT,*) 'INFO = ', INFO 194!ERROR 8 195 BALANC = 'T' 196 WRITE(NOUT,*) 197 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=T, INFO = INFO)' 198 A=AA 199 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='T', INFO = INFO) 200 WRITE(NOUT,*) 'INFO = ', INFO 201! ERROR 11 202 BALANC = 'T' 203 WRITE(NOUT,*) 204 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, LSCALE=LSCALE(1:N-1), INFO = INFO)' 205 A=AA 206 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', LSCALE=LSCALE(1:N-1), INFO = INFO) 207 WRITE(NOUT,*) 'INFO = ', INFO 208! ERROR 12 209 BALANC = 'T' 210 WRITE(NOUT,*) 211 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, RSCALE=RSCALE(1:N-1), INFO = INFO)' 212 A=AA 213 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1),INFO = INFO) 214 WRITE(NOUT,*) 'INFO = ', INFO 215! ERROR 15 216 BALANC = 'T' 217 WRITE(NOUT,*) 218 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, & 219 & RSCALE=RSCALE(1:N-1), RCONDE=RCONDE(1:N-1), INFO = INFO)' 220 A=AA 221 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1), RCONDE=RCONDE(1:N-1), INFO = INFO) 222 WRITE(NOUT,*) 'INFO = ', INFO 223! ERROR 16 224 BALANC = 'T' 225 WRITE(NOUT,*) 226 WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, RSCALE=RSCALE(1:N-1), & 227 & RCONDV=RCONDV(1:N-1), INFO = INFO)' 228 A=AA 229 CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1), RCONDV=RCONDV(1:N-1), INFO = INFO) 230 WRITE(NOUT,*) 'INFO = ', INFO 231END PROGRAM LA_ZGGEVX_ET_EXAMPLE 232