|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRGE( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * ZERRGE tests the error exits for the COMPLEX*16 routines 00016 * for general matrices. 00017 * 00018 * Arguments 00019 * ========= 00020 * 00021 * PATH (input) CHARACTER*3 00022 * The LAPACK path name for the routines to be tested. 00023 * 00024 * NUNIT (input) INTEGER 00025 * The unit number for output. 00026 * 00027 * ===================================================================== 00028 * 00029 * .. Parameters .. 00030 INTEGER NMAX 00031 PARAMETER ( NMAX = 4 ) 00032 * .. 00033 * .. Local Scalars .. 00034 CHARACTER*2 C2 00035 INTEGER I, INFO, J 00036 DOUBLE PRECISION ANRM, CCOND, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) 00041 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00042 $ W( 2*NMAX ), X( NMAX ) 00043 * .. 00044 * .. External Functions .. 00045 LOGICAL LSAMEN 00046 EXTERNAL LSAMEN 00047 * .. 00048 * .. External Subroutines .. 00049 EXTERNAL ALAESM, CHKXER, ZGBCON, ZGBEQU, ZGBRFS, ZGBTF2, 00050 $ ZGBTRF, ZGBTRS, ZGECON, ZGEEQU, ZGERFS, ZGETF2, 00051 $ ZGETRF, ZGETRI, ZGETRS 00052 * .. 00053 * .. Scalars in Common .. 00054 LOGICAL LERR, OK 00055 CHARACTER*32 SRNAMT 00056 INTEGER INFOT, NOUT 00057 * .. 00058 * .. Common blocks .. 00059 COMMON / INFOC / INFOT, NOUT, OK, LERR 00060 COMMON / SRNAMC / SRNAMT 00061 * .. 00062 * .. Intrinsic Functions .. 00063 INTRINSIC DBLE, DCMPLX 00064 * .. 00065 * .. Executable Statements .. 00066 * 00067 NOUT = NUNIT 00068 WRITE( NOUT, FMT = * ) 00069 C2 = PATH( 2: 3 ) 00070 * 00071 * Set the variables to innocuous values. 00072 * 00073 DO 20 J = 1, NMAX 00074 DO 10 I = 1, NMAX 00075 A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00076 $ -1.D0 / DBLE( I+J ) ) 00077 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00078 $ -1.D0 / DBLE( I+J ) ) 00079 10 CONTINUE 00080 B( J ) = 0.D0 00081 R1( J ) = 0.D0 00082 R2( J ) = 0.D0 00083 W( J ) = 0.D0 00084 X( J ) = 0.D0 00085 IP( J ) = J 00086 20 CONTINUE 00087 OK = .TRUE. 00088 * 00089 * Test error exits of the routines that use the LU decomposition 00090 * of a general matrix. 00091 * 00092 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00093 * 00094 * ZGETRF 00095 * 00096 SRNAMT = 'ZGETRF' 00097 INFOT = 1 00098 CALL ZGETRF( -1, 0, A, 1, IP, INFO ) 00099 CALL CHKXER( 'ZGETRF', INFOT, NOUT, LERR, OK ) 00100 INFOT = 2 00101 CALL ZGETRF( 0, -1, A, 1, IP, INFO ) 00102 CALL CHKXER( 'ZGETRF', INFOT, NOUT, LERR, OK ) 00103 INFOT = 4 00104 CALL ZGETRF( 2, 1, A, 1, IP, INFO ) 00105 CALL CHKXER( 'ZGETRF', INFOT, NOUT, LERR, OK ) 00106 * 00107 * ZGETF2 00108 * 00109 SRNAMT = 'ZGETF2' 00110 INFOT = 1 00111 CALL ZGETF2( -1, 0, A, 1, IP, INFO ) 00112 CALL CHKXER( 'ZGETF2', INFOT, NOUT, LERR, OK ) 00113 INFOT = 2 00114 CALL ZGETF2( 0, -1, A, 1, IP, INFO ) 00115 CALL CHKXER( 'ZGETF2', INFOT, NOUT, LERR, OK ) 00116 INFOT = 4 00117 CALL ZGETF2( 2, 1, A, 1, IP, INFO ) 00118 CALL CHKXER( 'ZGETF2', INFOT, NOUT, LERR, OK ) 00119 * 00120 * ZGETRI 00121 * 00122 SRNAMT = 'ZGETRI' 00123 INFOT = 1 00124 CALL ZGETRI( -1, A, 1, IP, W, 1, INFO ) 00125 CALL CHKXER( 'ZGETRI', INFOT, NOUT, LERR, OK ) 00126 INFOT = 3 00127 CALL ZGETRI( 2, A, 1, IP, W, 2, INFO ) 00128 CALL CHKXER( 'ZGETRI', INFOT, NOUT, LERR, OK ) 00129 INFOT = 6 00130 CALL ZGETRI( 2, A, 2, IP, W, 1, INFO ) 00131 CALL CHKXER( 'ZGETRI', INFOT, NOUT, LERR, OK ) 00132 * 00133 * ZGETRS 00134 * 00135 SRNAMT = 'ZGETRS' 00136 INFOT = 1 00137 CALL ZGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00138 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL ZGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 00141 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00142 INFOT = 3 00143 CALL ZGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 00144 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00145 INFOT = 5 00146 CALL ZGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 00147 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00148 INFOT = 8 00149 CALL ZGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 00150 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00151 * 00152 * ZGERFS 00153 * 00154 SRNAMT = 'ZGERFS' 00155 INFOT = 1 00156 CALL ZGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00157 $ R, INFO ) 00158 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00159 INFOT = 2 00160 CALL ZGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00161 $ W, R, INFO ) 00162 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00163 INFOT = 3 00164 CALL ZGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00165 $ W, R, INFO ) 00166 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00167 INFOT = 5 00168 CALL ZGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00169 $ R, INFO ) 00170 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00171 INFOT = 7 00172 CALL ZGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00173 $ R, INFO ) 00174 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00175 INFOT = 10 00176 CALL ZGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00177 $ R, INFO ) 00178 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00179 INFOT = 12 00180 CALL ZGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00181 $ R, INFO ) 00182 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00183 * 00184 * ZGECON 00185 * 00186 SRNAMT = 'ZGECON' 00187 INFOT = 1 00188 CALL ZGECON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 00189 CALL CHKXER( 'ZGECON', INFOT, NOUT, LERR, OK ) 00190 INFOT = 2 00191 CALL ZGECON( '1', -1, A, 1, ANRM, RCOND, W, R, INFO ) 00192 CALL CHKXER( 'ZGECON', INFOT, NOUT, LERR, OK ) 00193 INFOT = 4 00194 CALL ZGECON( '1', 2, A, 1, ANRM, RCOND, W, R, INFO ) 00195 CALL CHKXER( 'ZGECON', INFOT, NOUT, LERR, OK ) 00196 * 00197 * ZGEEQU 00198 * 00199 SRNAMT = 'ZGEEQU' 00200 INFOT = 1 00201 CALL ZGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00202 CALL CHKXER( 'ZGEEQU', INFOT, NOUT, LERR, OK ) 00203 INFOT = 2 00204 CALL ZGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00205 CALL CHKXER( 'ZGEEQU', INFOT, NOUT, LERR, OK ) 00206 INFOT = 4 00207 CALL ZGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00208 CALL CHKXER( 'ZGEEQU', INFOT, NOUT, LERR, OK ) 00209 * 00210 * Test error exits of the routines that use the LU decomposition 00211 * of a general band matrix. 00212 * 00213 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00214 * 00215 * ZGBTRF 00216 * 00217 SRNAMT = 'ZGBTRF' 00218 INFOT = 1 00219 CALL ZGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 00220 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00221 INFOT = 2 00222 CALL ZGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 00223 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00224 INFOT = 3 00225 CALL ZGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 00226 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00227 INFOT = 4 00228 CALL ZGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 00229 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00230 INFOT = 6 00231 CALL ZGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 00232 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00233 * 00234 * ZGBTF2 00235 * 00236 SRNAMT = 'ZGBTF2' 00237 INFOT = 1 00238 CALL ZGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 00239 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00240 INFOT = 2 00241 CALL ZGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 00242 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00243 INFOT = 3 00244 CALL ZGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 00245 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00246 INFOT = 4 00247 CALL ZGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 00248 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00249 INFOT = 6 00250 CALL ZGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 00251 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00252 * 00253 * ZGBTRS 00254 * 00255 SRNAMT = 'ZGBTRS' 00256 INFOT = 1 00257 CALL ZGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00258 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00259 INFOT = 2 00260 CALL ZGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00261 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00262 INFOT = 3 00263 CALL ZGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 00264 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00265 INFOT = 4 00266 CALL ZGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 00267 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00268 INFOT = 5 00269 CALL ZGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 00270 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00271 INFOT = 7 00272 CALL ZGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 00273 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00274 INFOT = 10 00275 CALL ZGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00276 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00277 * 00278 * ZGBRFS 00279 * 00280 SRNAMT = 'ZGBRFS' 00281 INFOT = 1 00282 CALL ZGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00283 $ R2, W, R, INFO ) 00284 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00285 INFOT = 2 00286 CALL ZGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00287 $ R2, W, R, INFO ) 00288 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00289 INFOT = 3 00290 CALL ZGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00291 $ R2, W, R, INFO ) 00292 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00293 INFOT = 4 00294 CALL ZGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00295 $ R2, W, R, INFO ) 00296 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00297 INFOT = 5 00298 CALL ZGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00299 $ R2, W, R, INFO ) 00300 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00301 INFOT = 7 00302 CALL ZGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 00303 $ R2, W, R, INFO ) 00304 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00305 INFOT = 9 00306 CALL ZGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 00307 $ R2, W, R, INFO ) 00308 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00309 INFOT = 12 00310 CALL ZGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 00311 $ R2, W, R, INFO ) 00312 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00313 INFOT = 14 00314 CALL ZGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 00315 $ R2, W, R, INFO ) 00316 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00317 * 00318 * ZGBCON 00319 * 00320 SRNAMT = 'ZGBCON' 00321 INFOT = 1 00322 CALL ZGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00323 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00324 INFOT = 2 00325 CALL ZGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00326 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00327 INFOT = 3 00328 CALL ZGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00329 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00330 INFOT = 4 00331 CALL ZGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00332 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00333 INFOT = 6 00334 CALL ZGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, R, INFO ) 00335 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00336 * 00337 * ZGBEQU 00338 * 00339 SRNAMT = 'ZGBEQU' 00340 INFOT = 1 00341 CALL ZGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00342 $ INFO ) 00343 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00344 INFOT = 2 00345 CALL ZGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00346 $ INFO ) 00347 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00348 INFOT = 3 00349 CALL ZGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00350 $ INFO ) 00351 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00352 INFOT = 4 00353 CALL ZGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00354 $ INFO ) 00355 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00356 INFOT = 6 00357 CALL ZGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00358 $ INFO ) 00359 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00360 END IF 00361 * 00362 * Print a summary line. 00363 * 00364 CALL ALAESM( PATH, OK, NOUT ) 00365 * 00366 RETURN 00367 * 00368 * End of ZERRGE 00369 * 00370 END
1.7.3 
