|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CERRPO( 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 * CERRPO tests the error exits for the COMPLEX routines 00016 * for Hermitian positive definite 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, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 00040 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00041 $ W( 2*NMAX ), X( NMAX ) 00042 * .. 00043 * .. External Functions .. 00044 LOGICAL LSAMEN 00045 EXTERNAL LSAMEN 00046 * .. 00047 * .. External Subroutines .. 00048 EXTERNAL ALAESM, CHKXER, CPBCON, CPBEQU, CPBRFS, CPBTF2, 00049 $ CPBTRF, CPBTRS, CPOCON, CPOEQU, CPORFS, CPOTF2, 00050 $ CPOTRF, CPOTRI, CPOTRS, CPPCON, CPPEQU, CPPRFS, 00051 $ CPPTRF, CPPTRI, CPPTRS 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 20 CONTINUE 00084 ANRM = 1. 00085 OK = .TRUE. 00086 * 00087 * Test error exits of the routines that use the Cholesky 00088 * decomposition of a Hermitian positive definite matrix. 00089 * 00090 IF( LSAMEN( 2, C2, 'PO' ) ) THEN 00091 * 00092 * CPOTRF 00093 * 00094 SRNAMT = 'CPOTRF' 00095 INFOT = 1 00096 CALL CPOTRF( '/', 0, A, 1, INFO ) 00097 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK ) 00098 INFOT = 2 00099 CALL CPOTRF( 'U', -1, A, 1, INFO ) 00100 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK ) 00101 INFOT = 4 00102 CALL CPOTRF( 'U', 2, A, 1, INFO ) 00103 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK ) 00104 * 00105 * CPOTF2 00106 * 00107 SRNAMT = 'CPOTF2' 00108 INFOT = 1 00109 CALL CPOTF2( '/', 0, A, 1, INFO ) 00110 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK ) 00111 INFOT = 2 00112 CALL CPOTF2( 'U', -1, A, 1, INFO ) 00113 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK ) 00114 INFOT = 4 00115 CALL CPOTF2( 'U', 2, A, 1, INFO ) 00116 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK ) 00117 * 00118 * CPOTRI 00119 * 00120 SRNAMT = 'CPOTRI' 00121 INFOT = 1 00122 CALL CPOTRI( '/', 0, A, 1, INFO ) 00123 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK ) 00124 INFOT = 2 00125 CALL CPOTRI( 'U', -1, A, 1, INFO ) 00126 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK ) 00127 INFOT = 4 00128 CALL CPOTRI( 'U', 2, A, 1, INFO ) 00129 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK ) 00130 * 00131 * CPOTRS 00132 * 00133 SRNAMT = 'CPOTRS' 00134 INFOT = 1 00135 CALL CPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) 00136 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 00137 INFOT = 2 00138 CALL CPOTRS( 'U', -1, 0, A, 1, B, 1, INFO ) 00139 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 00140 INFOT = 3 00141 CALL CPOTRS( 'U', 0, -1, A, 1, B, 1, INFO ) 00142 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 00143 INFOT = 5 00144 CALL CPOTRS( 'U', 2, 1, A, 1, B, 2, INFO ) 00145 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 00146 INFOT = 7 00147 CALL CPOTRS( 'U', 2, 1, A, 2, B, 1, INFO ) 00148 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 00149 * 00150 * CPORFS 00151 * 00152 SRNAMT = 'CPORFS' 00153 INFOT = 1 00154 CALL CPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R, 00155 $ INFO ) 00156 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00157 INFOT = 2 00158 CALL CPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R, 00159 $ INFO ) 00160 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00161 INFOT = 3 00162 CALL CPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R, 00163 $ INFO ) 00164 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00165 INFOT = 5 00166 CALL CPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R, 00167 $ INFO ) 00168 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00169 INFOT = 7 00170 CALL CPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R, 00171 $ INFO ) 00172 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00173 INFOT = 9 00174 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R, 00175 $ INFO ) 00176 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00177 INFOT = 11 00178 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R, 00179 $ INFO ) 00180 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 00181 * 00182 * CPOCON 00183 * 00184 SRNAMT = 'CPOCON' 00185 INFOT = 1 00186 CALL CPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 00187 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 00188 INFOT = 2 00189 CALL CPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO ) 00190 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 00191 INFOT = 4 00192 CALL CPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO ) 00193 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 00194 INFOT = 5 00195 CALL CPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO ) 00196 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 00197 * 00198 * CPOEQU 00199 * 00200 SRNAMT = 'CPOEQU' 00201 INFOT = 1 00202 CALL CPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO ) 00203 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK ) 00204 INFOT = 3 00205 CALL CPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO ) 00206 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK ) 00207 * 00208 * Test error exits of the routines that use the Cholesky 00209 * decomposition of a Hermitian positive definite packed matrix. 00210 * 00211 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN 00212 * 00213 * CPPTRF 00214 * 00215 SRNAMT = 'CPPTRF' 00216 INFOT = 1 00217 CALL CPPTRF( '/', 0, A, INFO ) 00218 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK ) 00219 INFOT = 2 00220 CALL CPPTRF( 'U', -1, A, INFO ) 00221 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK ) 00222 * 00223 * CPPTRI 00224 * 00225 SRNAMT = 'CPPTRI' 00226 INFOT = 1 00227 CALL CPPTRI( '/', 0, A, INFO ) 00228 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK ) 00229 INFOT = 2 00230 CALL CPPTRI( 'U', -1, A, INFO ) 00231 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK ) 00232 * 00233 * CPPTRS 00234 * 00235 SRNAMT = 'CPPTRS' 00236 INFOT = 1 00237 CALL CPPTRS( '/', 0, 0, A, B, 1, INFO ) 00238 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 00239 INFOT = 2 00240 CALL CPPTRS( 'U', -1, 0, A, B, 1, INFO ) 00241 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 00242 INFOT = 3 00243 CALL CPPTRS( 'U', 0, -1, A, B, 1, INFO ) 00244 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 00245 INFOT = 6 00246 CALL CPPTRS( 'U', 2, 1, A, B, 1, INFO ) 00247 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 00248 * 00249 * CPPRFS 00250 * 00251 SRNAMT = 'CPPRFS' 00252 INFOT = 1 00253 CALL CPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO ) 00254 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 00255 INFOT = 2 00256 CALL CPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R, 00257 $ INFO ) 00258 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 00259 INFOT = 3 00260 CALL CPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R, 00261 $ INFO ) 00262 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 00263 INFOT = 7 00264 CALL CPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO ) 00265 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 00266 INFOT = 9 00267 CALL CPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO ) 00268 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 00269 * 00270 * CPPCON 00271 * 00272 SRNAMT = 'CPPCON' 00273 INFOT = 1 00274 CALL CPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO ) 00275 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK ) 00276 INFOT = 2 00277 CALL CPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO ) 00278 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK ) 00279 INFOT = 4 00280 CALL CPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO ) 00281 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK ) 00282 * 00283 * CPPEQU 00284 * 00285 SRNAMT = 'CPPEQU' 00286 INFOT = 1 00287 CALL CPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO ) 00288 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK ) 00289 INFOT = 2 00290 CALL CPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO ) 00291 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK ) 00292 * 00293 * Test error exits of the routines that use the Cholesky 00294 * decomposition of a Hermitian positive definite band matrix. 00295 * 00296 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 00297 * 00298 * CPBTRF 00299 * 00300 SRNAMT = 'CPBTRF' 00301 INFOT = 1 00302 CALL CPBTRF( '/', 0, 0, A, 1, INFO ) 00303 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 00304 INFOT = 2 00305 CALL CPBTRF( 'U', -1, 0, A, 1, INFO ) 00306 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 00307 INFOT = 3 00308 CALL CPBTRF( 'U', 1, -1, A, 1, INFO ) 00309 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 00310 INFOT = 5 00311 CALL CPBTRF( 'U', 2, 1, A, 1, INFO ) 00312 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 00313 * 00314 * CPBTF2 00315 * 00316 SRNAMT = 'CPBTF2' 00317 INFOT = 1 00318 CALL CPBTF2( '/', 0, 0, A, 1, INFO ) 00319 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 00320 INFOT = 2 00321 CALL CPBTF2( 'U', -1, 0, A, 1, INFO ) 00322 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 00323 INFOT = 3 00324 CALL CPBTF2( 'U', 1, -1, A, 1, INFO ) 00325 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 00326 INFOT = 5 00327 CALL CPBTF2( 'U', 2, 1, A, 1, INFO ) 00328 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 00329 * 00330 * CPBTRS 00331 * 00332 SRNAMT = 'CPBTRS' 00333 INFOT = 1 00334 CALL CPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO ) 00335 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 00336 INFOT = 2 00337 CALL CPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO ) 00338 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 00339 INFOT = 3 00340 CALL CPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO ) 00341 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 00342 INFOT = 4 00343 CALL CPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO ) 00344 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 00345 INFOT = 6 00346 CALL CPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO ) 00347 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 00348 INFOT = 8 00349 CALL CPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO ) 00350 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 00351 * 00352 * CPBRFS 00353 * 00354 SRNAMT = 'CPBRFS' 00355 INFOT = 1 00356 CALL CPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00357 $ R, INFO ) 00358 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00359 INFOT = 2 00360 CALL CPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00361 $ R, INFO ) 00362 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00363 INFOT = 3 00364 CALL CPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00365 $ R, INFO ) 00366 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00367 INFOT = 4 00368 CALL CPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00369 $ R, INFO ) 00370 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00371 INFOT = 6 00372 CALL CPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, 00373 $ R, INFO ) 00374 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00375 INFOT = 8 00376 CALL CPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, 00377 $ R, INFO ) 00378 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00379 INFOT = 10 00380 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W, 00381 $ R, INFO ) 00382 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00383 INFOT = 12 00384 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W, 00385 $ R, INFO ) 00386 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 00387 * 00388 * CPBCON 00389 * 00390 SRNAMT = 'CPBCON' 00391 INFOT = 1 00392 CALL CPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO ) 00393 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 00394 INFOT = 2 00395 CALL CPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO ) 00396 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 00397 INFOT = 3 00398 CALL CPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO ) 00399 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 00400 INFOT = 5 00401 CALL CPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO ) 00402 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 00403 INFOT = 6 00404 CALL CPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO ) 00405 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 00406 * 00407 * CPBEQU 00408 * 00409 SRNAMT = 'CPBEQU' 00410 INFOT = 1 00411 CALL CPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO ) 00412 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 00413 INFOT = 2 00414 CALL CPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO ) 00415 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 00416 INFOT = 3 00417 CALL CPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO ) 00418 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 00419 INFOT = 5 00420 CALL CPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO ) 00421 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 00422 END IF 00423 * 00424 * Print a summary line. 00425 * 00426 CALL ALAESM( PATH, OK, NOUT ) 00427 * 00428 RETURN 00429 * 00430 * End of CERRPO 00431 * 00432 END
1.7.3 
