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