|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE DERRPO( 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 * DERRPO tests the error exits for the DOUBLE PRECISION 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 DOUBLE PRECISION ANRM, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IW( NMAX ) 00040 DOUBLE PRECISION 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, DPBCON, DPBEQU, DPBRFS, DPBTF2, 00049 $ DPBTRF, DPBTRS, DPOCON, DPOEQU, DPORFS, DPOTF2, 00050 $ DPOTRF, DPOTRI, DPOTRS, DPPCON, DPPEQU, DPPRFS, 00051 $ DPPTRF, DPPTRI, DPPTRS 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 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.D0 / DBLE( I+J ) 00076 AF( I, J ) = 1.D0 / DBLE( I+J ) 00077 10 CONTINUE 00078 B( J ) = 0.D0 00079 R1( J ) = 0.D0 00080 R2( J ) = 0.D0 00081 W( J ) = 0.D0 00082 X( J ) = 0.D0 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 * DPOTRF 00093 * 00094 SRNAMT = 'DPOTRF' 00095 INFOT = 1 00096 CALL DPOTRF( '/', 0, A, 1, INFO ) 00097 CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK ) 00098 INFOT = 2 00099 CALL DPOTRF( 'U', -1, A, 1, INFO ) 00100 CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK ) 00101 INFOT = 4 00102 CALL DPOTRF( 'U', 2, A, 1, INFO ) 00103 CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK ) 00104 * 00105 * DPOTF2 00106 * 00107 SRNAMT = 'DPOTF2' 00108 INFOT = 1 00109 CALL DPOTF2( '/', 0, A, 1, INFO ) 00110 CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK ) 00111 INFOT = 2 00112 CALL DPOTF2( 'U', -1, A, 1, INFO ) 00113 CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK ) 00114 INFOT = 4 00115 CALL DPOTF2( 'U', 2, A, 1, INFO ) 00116 CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK ) 00117 * 00118 * DPOTRI 00119 * 00120 SRNAMT = 'DPOTRI' 00121 INFOT = 1 00122 CALL DPOTRI( '/', 0, A, 1, INFO ) 00123 CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK ) 00124 INFOT = 2 00125 CALL DPOTRI( 'U', -1, A, 1, INFO ) 00126 CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK ) 00127 INFOT = 4 00128 CALL DPOTRI( 'U', 2, A, 1, INFO ) 00129 CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK ) 00130 * 00131 * DPOTRS 00132 * 00133 SRNAMT = 'DPOTRS' 00134 INFOT = 1 00135 CALL DPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) 00136 CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK ) 00137 INFOT = 2 00138 CALL DPOTRS( 'U', -1, 0, A, 1, B, 1, INFO ) 00139 CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK ) 00140 INFOT = 3 00141 CALL DPOTRS( 'U', 0, -1, A, 1, B, 1, INFO ) 00142 CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK ) 00143 INFOT = 5 00144 CALL DPOTRS( 'U', 2, 1, A, 1, B, 2, INFO ) 00145 CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK ) 00146 INFOT = 7 00147 CALL DPOTRS( 'U', 2, 1, A, 2, B, 1, INFO ) 00148 CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK ) 00149 * 00150 * DPORFS 00151 * 00152 SRNAMT = 'DPORFS' 00153 INFOT = 1 00154 CALL DPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, IW, 00155 $ INFO ) 00156 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00157 INFOT = 2 00158 CALL DPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00159 $ IW, INFO ) 00160 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00161 INFOT = 3 00162 CALL DPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00163 $ IW, INFO ) 00164 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00165 INFOT = 5 00166 CALL DPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, IW, 00167 $ INFO ) 00168 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00169 INFOT = 7 00170 CALL DPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, IW, 00171 $ INFO ) 00172 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00173 INFOT = 9 00174 CALL DPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, IW, 00175 $ INFO ) 00176 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00177 INFOT = 11 00178 CALL DPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, IW, 00179 $ INFO ) 00180 CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK ) 00181 * 00182 * DPOCON 00183 * 00184 SRNAMT = 'DPOCON' 00185 INFOT = 1 00186 CALL DPOCON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00187 CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK ) 00188 INFOT = 2 00189 CALL DPOCON( 'U', -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00190 CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK ) 00191 INFOT = 4 00192 CALL DPOCON( 'U', 2, A, 1, ANRM, RCOND, W, IW, INFO ) 00193 CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK ) 00194 * 00195 * DPOEQU 00196 * 00197 SRNAMT = 'DPOEQU' 00198 INFOT = 1 00199 CALL DPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO ) 00200 CALL CHKXER( 'DPOEQU', INFOT, NOUT, LERR, OK ) 00201 INFOT = 3 00202 CALL DPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO ) 00203 CALL CHKXER( 'DPOEQU', 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 * DPPTRF 00211 * 00212 SRNAMT = 'DPPTRF' 00213 INFOT = 1 00214 CALL DPPTRF( '/', 0, A, INFO ) 00215 CALL CHKXER( 'DPPTRF', INFOT, NOUT, LERR, OK ) 00216 INFOT = 2 00217 CALL DPPTRF( 'U', -1, A, INFO ) 00218 CALL CHKXER( 'DPPTRF', INFOT, NOUT, LERR, OK ) 00219 * 00220 * DPPTRI 00221 * 00222 SRNAMT = 'DPPTRI' 00223 INFOT = 1 00224 CALL DPPTRI( '/', 0, A, INFO ) 00225 CALL CHKXER( 'DPPTRI', INFOT, NOUT, LERR, OK ) 00226 INFOT = 2 00227 CALL DPPTRI( 'U', -1, A, INFO ) 00228 CALL CHKXER( 'DPPTRI', INFOT, NOUT, LERR, OK ) 00229 * 00230 * DPPTRS 00231 * 00232 SRNAMT = 'DPPTRS' 00233 INFOT = 1 00234 CALL DPPTRS( '/', 0, 0, A, B, 1, INFO ) 00235 CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK ) 00236 INFOT = 2 00237 CALL DPPTRS( 'U', -1, 0, A, B, 1, INFO ) 00238 CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK ) 00239 INFOT = 3 00240 CALL DPPTRS( 'U', 0, -1, A, B, 1, INFO ) 00241 CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK ) 00242 INFOT = 6 00243 CALL DPPTRS( 'U', 2, 1, A, B, 1, INFO ) 00244 CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK ) 00245 * 00246 * DPPRFS 00247 * 00248 SRNAMT = 'DPPRFS' 00249 INFOT = 1 00250 CALL DPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, IW, 00251 $ INFO ) 00252 CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK ) 00253 INFOT = 2 00254 CALL DPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, IW, 00255 $ INFO ) 00256 CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK ) 00257 INFOT = 3 00258 CALL DPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, IW, 00259 $ INFO ) 00260 CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK ) 00261 INFOT = 7 00262 CALL DPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, IW, 00263 $ INFO ) 00264 CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK ) 00265 INFOT = 9 00266 CALL DPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, IW, 00267 $ INFO ) 00268 CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK ) 00269 * 00270 * DPPCON 00271 * 00272 SRNAMT = 'DPPCON' 00273 INFOT = 1 00274 CALL DPPCON( '/', 0, A, ANRM, RCOND, W, IW, INFO ) 00275 CALL CHKXER( 'DPPCON', INFOT, NOUT, LERR, OK ) 00276 INFOT = 2 00277 CALL DPPCON( 'U', -1, A, ANRM, RCOND, W, IW, INFO ) 00278 CALL CHKXER( 'DPPCON', INFOT, NOUT, LERR, OK ) 00279 * 00280 * DPPEQU 00281 * 00282 SRNAMT = 'DPPEQU' 00283 INFOT = 1 00284 CALL DPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO ) 00285 CALL CHKXER( 'DPPEQU', INFOT, NOUT, LERR, OK ) 00286 INFOT = 2 00287 CALL DPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO ) 00288 CALL CHKXER( 'DPPEQU', 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 * DPBTRF 00296 * 00297 SRNAMT = 'DPBTRF' 00298 INFOT = 1 00299 CALL DPBTRF( '/', 0, 0, A, 1, INFO ) 00300 CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK ) 00301 INFOT = 2 00302 CALL DPBTRF( 'U', -1, 0, A, 1, INFO ) 00303 CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK ) 00304 INFOT = 3 00305 CALL DPBTRF( 'U', 1, -1, A, 1, INFO ) 00306 CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK ) 00307 INFOT = 5 00308 CALL DPBTRF( 'U', 2, 1, A, 1, INFO ) 00309 CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK ) 00310 * 00311 * DPBTF2 00312 * 00313 SRNAMT = 'DPBTF2' 00314 INFOT = 1 00315 CALL DPBTF2( '/', 0, 0, A, 1, INFO ) 00316 CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK ) 00317 INFOT = 2 00318 CALL DPBTF2( 'U', -1, 0, A, 1, INFO ) 00319 CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK ) 00320 INFOT = 3 00321 CALL DPBTF2( 'U', 1, -1, A, 1, INFO ) 00322 CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK ) 00323 INFOT = 5 00324 CALL DPBTF2( 'U', 2, 1, A, 1, INFO ) 00325 CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK ) 00326 * 00327 * DPBTRS 00328 * 00329 SRNAMT = 'DPBTRS' 00330 INFOT = 1 00331 CALL DPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO ) 00332 CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK ) 00333 INFOT = 2 00334 CALL DPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO ) 00335 CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK ) 00336 INFOT = 3 00337 CALL DPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO ) 00338 CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK ) 00339 INFOT = 4 00340 CALL DPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO ) 00341 CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK ) 00342 INFOT = 6 00343 CALL DPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO ) 00344 CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK ) 00345 INFOT = 8 00346 CALL DPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO ) 00347 CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK ) 00348 * 00349 * DPBRFS 00350 * 00351 SRNAMT = 'DPBRFS' 00352 INFOT = 1 00353 CALL DPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00354 $ IW, INFO ) 00355 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00356 INFOT = 2 00357 CALL DPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00358 $ IW, INFO ) 00359 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00360 INFOT = 3 00361 CALL DPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00362 $ IW, INFO ) 00363 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00364 INFOT = 4 00365 CALL DPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00366 $ IW, INFO ) 00367 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00368 INFOT = 6 00369 CALL DPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, 00370 $ IW, INFO ) 00371 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00372 INFOT = 8 00373 CALL DPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, 00374 $ IW, INFO ) 00375 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00376 INFOT = 10 00377 CALL DPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W, 00378 $ IW, INFO ) 00379 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00380 INFOT = 12 00381 CALL DPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W, 00382 $ IW, INFO ) 00383 CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK ) 00384 * 00385 * DPBCON 00386 * 00387 SRNAMT = 'DPBCON' 00388 INFOT = 1 00389 CALL DPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00390 CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK ) 00391 INFOT = 2 00392 CALL DPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00393 CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK ) 00394 INFOT = 3 00395 CALL DPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00396 CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK ) 00397 INFOT = 5 00398 CALL DPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, IW, INFO ) 00399 CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK ) 00400 * 00401 * DPBEQU 00402 * 00403 SRNAMT = 'DPBEQU' 00404 INFOT = 1 00405 CALL DPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO ) 00406 CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK ) 00407 INFOT = 2 00408 CALL DPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO ) 00409 CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK ) 00410 INFOT = 3 00411 CALL DPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO ) 00412 CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK ) 00413 INFOT = 5 00414 CALL DPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO ) 00415 CALL CHKXER( 'DPBEQU', 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 DERRPO 00425 * 00426 END
1.7.3 
