 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE CERRGE( 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 * CERRGE tests the error exits for the COMPLEX 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 REAL ANRM, CCOND, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 00041 COMPLEX 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, CGBCON, CGBEQU, CGBRFS, CGBTF2, CGBTRF, 00050 $ CGBTRS, CGECON, CGEEQU, CGERFS, CGETF2, CGETRF, 00051 $ CGETRI, CGETRS, CHKXER 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 CMPLX, REAL 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 ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00076 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00077 10 CONTINUE 00078 B( J ) = 0. 00079 R1( J ) = 0. 00080 R2( J ) = 0. 00081 W( J ) = 0. 00082 X( J ) = 0. 00083 IP( J ) = J 00084 20 CONTINUE 00085 OK = .TRUE. 00086 * 00087 * Test error exits of the routines that use the LU decomposition 00088 * of a general matrix. 00089 * 00090 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00091 * 00092 * CGETRF 00093 * 00094 SRNAMT = 'CGETRF' 00095 INFOT = 1 00096 CALL CGETRF( -1, 0, A, 1, IP, INFO ) 00097 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 00098 INFOT = 2 00099 CALL CGETRF( 0, -1, A, 1, IP, INFO ) 00100 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 00101 INFOT = 4 00102 CALL CGETRF( 2, 1, A, 1, IP, INFO ) 00103 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 00104 * 00105 * CGETF2 00106 * 00107 SRNAMT = 'CGETF2' 00108 INFOT = 1 00109 CALL CGETF2( -1, 0, A, 1, IP, INFO ) 00110 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 00111 INFOT = 2 00112 CALL CGETF2( 0, -1, A, 1, IP, INFO ) 00113 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 00114 INFOT = 4 00115 CALL CGETF2( 2, 1, A, 1, IP, INFO ) 00116 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 00117 * 00118 * CGETRI 00119 * 00120 SRNAMT = 'CGETRI' 00121 INFOT = 1 00122 CALL CGETRI( -1, A, 1, IP, W, 1, INFO ) 00123 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 00124 INFOT = 3 00125 CALL CGETRI( 2, A, 1, IP, W, 2, INFO ) 00126 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 00127 INFOT = 6 00128 CALL CGETRI( 2, A, 2, IP, W, 1, INFO ) 00129 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 00130 * 00131 * CGETRS 00132 * 00133 SRNAMT = 'CGETRS' 00134 INFOT = 1 00135 CALL CGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00136 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 00137 INFOT = 2 00138 CALL CGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 00139 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 00140 INFOT = 3 00141 CALL CGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 00142 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 00143 INFOT = 5 00144 CALL CGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 00145 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 00146 INFOT = 8 00147 CALL CGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 00148 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 00149 * 00150 * CGERFS 00151 * 00152 SRNAMT = 'CGERFS' 00153 INFOT = 1 00154 CALL CGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00155 $ R, INFO ) 00156 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00157 INFOT = 2 00158 CALL CGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00159 $ W, R, INFO ) 00160 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00161 INFOT = 3 00162 CALL CGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00163 $ W, R, INFO ) 00164 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00165 INFOT = 5 00166 CALL CGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00167 $ R, INFO ) 00168 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00169 INFOT = 7 00170 CALL CGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00171 $ R, INFO ) 00172 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00173 INFOT = 10 00174 CALL CGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00175 $ R, INFO ) 00176 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00177 INFOT = 12 00178 CALL CGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00179 $ R, INFO ) 00180 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 00181 * 00182 * CGECON 00183 * 00184 SRNAMT = 'CGECON' 00185 INFOT = 1 00186 CALL CGECON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 00187 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 00188 INFOT = 2 00189 CALL CGECON( '1', -1, A, 1, ANRM, RCOND, W, R, INFO ) 00190 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 00191 INFOT = 4 00192 CALL CGECON( '1', 2, A, 1, ANRM, RCOND, W, R, INFO ) 00193 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 00194 * 00195 * CGEEQU 00196 * 00197 SRNAMT = 'CGEEQU' 00198 INFOT = 1 00199 CALL CGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00200 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 00201 INFOT = 2 00202 CALL CGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00203 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 00204 INFOT = 4 00205 CALL CGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00206 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 00207 * 00208 * Test error exits of the routines that use the LU decomposition 00209 * of a general band matrix. 00210 * 00211 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00212 * 00213 * CGBTRF 00214 * 00215 SRNAMT = 'CGBTRF' 00216 INFOT = 1 00217 CALL CGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 00218 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 00219 INFOT = 2 00220 CALL CGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 00221 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 00222 INFOT = 3 00223 CALL CGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 00224 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 00225 INFOT = 4 00226 CALL CGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 00227 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 00228 INFOT = 6 00229 CALL CGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 00230 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 00231 * 00232 * CGBTF2 00233 * 00234 SRNAMT = 'CGBTF2' 00235 INFOT = 1 00236 CALL CGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 00237 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 00238 INFOT = 2 00239 CALL CGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 00240 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 00241 INFOT = 3 00242 CALL CGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 00243 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 00244 INFOT = 4 00245 CALL CGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 00246 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 00247 INFOT = 6 00248 CALL CGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 00249 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 00250 * 00251 * CGBTRS 00252 * 00253 SRNAMT = 'CGBTRS' 00254 INFOT = 1 00255 CALL CGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00256 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00257 INFOT = 2 00258 CALL CGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00259 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00260 INFOT = 3 00261 CALL CGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 00262 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00263 INFOT = 4 00264 CALL CGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 00265 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00266 INFOT = 5 00267 CALL CGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 00268 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00269 INFOT = 7 00270 CALL CGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 00271 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00272 INFOT = 10 00273 CALL CGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00274 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 00275 * 00276 * CGBRFS 00277 * 00278 SRNAMT = 'CGBRFS' 00279 INFOT = 1 00280 CALL CGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00281 $ R2, W, R, INFO ) 00282 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00283 INFOT = 2 00284 CALL CGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00285 $ R2, W, R, INFO ) 00286 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00287 INFOT = 3 00288 CALL CGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00289 $ R2, W, R, INFO ) 00290 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00291 INFOT = 4 00292 CALL CGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00293 $ R2, W, R, INFO ) 00294 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00295 INFOT = 5 00296 CALL CGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00297 $ R2, W, R, INFO ) 00298 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00299 INFOT = 7 00300 CALL CGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 00301 $ R2, W, R, INFO ) 00302 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00303 INFOT = 9 00304 CALL CGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 00305 $ R2, W, R, INFO ) 00306 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00307 INFOT = 12 00308 CALL CGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 00309 $ R2, W, R, INFO ) 00310 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00311 INFOT = 14 00312 CALL CGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 00313 $ R2, W, R, INFO ) 00314 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 00315 * 00316 * CGBCON 00317 * 00318 SRNAMT = 'CGBCON' 00319 INFOT = 1 00320 CALL CGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00321 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 00322 INFOT = 2 00323 CALL CGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00324 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 00325 INFOT = 3 00326 CALL CGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00327 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 00328 INFOT = 4 00329 CALL CGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00330 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 00331 INFOT = 6 00332 CALL CGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, R, INFO ) 00333 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 00334 * 00335 * CGBEQU 00336 * 00337 SRNAMT = 'CGBEQU' 00338 INFOT = 1 00339 CALL CGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00340 $ INFO ) 00341 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 00342 INFOT = 2 00343 CALL CGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00344 $ INFO ) 00345 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 00346 INFOT = 3 00347 CALL CGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00348 $ INFO ) 00349 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 00350 INFOT = 4 00351 CALL CGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00352 $ INFO ) 00353 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 00354 INFOT = 6 00355 CALL CGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00356 $ INFO ) 00357 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 00358 END IF 00359 * 00360 * Print a summary line. 00361 * 00362 CALL ALAESM( PATH, OK, NOUT ) 00363 * 00364 RETURN 00365 * 00366 * End of CERRGE 00367 * 00368 END
1.7.3 
