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