![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERRPO 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SERRPO( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> SERRPO tests the error exits for the REAL routines 00025 *> for symmetric positive definite matrices. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup single_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE SERRPO( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX 00072 PARAMETER ( NMAX = 4 ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, INFO, J 00077 REAL ANRM, RCOND 00078 * .. 00079 * .. Local Arrays .. 00080 INTEGER IW( NMAX ) 00081 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00082 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ) 00083 * .. 00084 * .. External Functions .. 00085 LOGICAL LSAMEN 00086 EXTERNAL LSAMEN 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL ALAESM, CHKXER, SPBCON, SPBEQU, SPBRFS, SPBTF2, 00090 $ SPBTRF, SPBTRS, SPOCON, SPOEQU, SPORFS, SPOTF2, 00091 $ SPOTRF, SPOTRI, SPOTRS, SPPCON, SPPEQU, SPPRFS, 00092 $ SPPTRF, SPPTRI, SPPTRS 00093 * .. 00094 * .. Scalars in Common .. 00095 LOGICAL LERR, OK 00096 CHARACTER*32 SRNAMT 00097 INTEGER INFOT, NOUT 00098 * .. 00099 * .. Common blocks .. 00100 COMMON / INFOC / INFOT, NOUT, OK, LERR 00101 COMMON / SRNAMC / SRNAMT 00102 * .. 00103 * .. Intrinsic Functions .. 00104 INTRINSIC REAL 00105 * .. 00106 * .. Executable Statements .. 00107 * 00108 NOUT = NUNIT 00109 WRITE( NOUT, FMT = * ) 00110 C2 = PATH( 2: 3 ) 00111 * 00112 * Set the variables to innocuous values. 00113 * 00114 DO 20 J = 1, NMAX 00115 DO 10 I = 1, NMAX 00116 A( I, J ) = 1. / REAL( I+J ) 00117 AF( I, J ) = 1. / REAL( I+J ) 00118 10 CONTINUE 00119 B( J ) = 0. 00120 R1( J ) = 0. 00121 R2( J ) = 0. 00122 W( J ) = 0. 00123 X( J ) = 0. 00124 IW( J ) = J 00125 20 CONTINUE 00126 OK = .TRUE. 00127 * 00128 IF( LSAMEN( 2, C2, 'PO' ) ) THEN 00129 * 00130 * Test error exits of the routines that use the Cholesky 00131 * decomposition of a symmetric positive definite matrix. 00132 * 00133 * SPOTRF 00134 * 00135 SRNAMT = 'SPOTRF' 00136 INFOT = 1 00137 CALL SPOTRF( '/', 0, A, 1, INFO ) 00138 CALL CHKXER( 'SPOTRF', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL SPOTRF( 'U', -1, A, 1, INFO ) 00141 CALL CHKXER( 'SPOTRF', INFOT, NOUT, LERR, OK ) 00142 INFOT = 4 00143 CALL SPOTRF( 'U', 2, A, 1, INFO ) 00144 CALL CHKXER( 'SPOTRF', INFOT, NOUT, LERR, OK ) 00145 * 00146 * SPOTF2 00147 * 00148 SRNAMT = 'SPOTF2' 00149 INFOT = 1 00150 CALL SPOTF2( '/', 0, A, 1, INFO ) 00151 CALL CHKXER( 'SPOTF2', INFOT, NOUT, LERR, OK ) 00152 INFOT = 2 00153 CALL SPOTF2( 'U', -1, A, 1, INFO ) 00154 CALL CHKXER( 'SPOTF2', INFOT, NOUT, LERR, OK ) 00155 INFOT = 4 00156 CALL SPOTF2( 'U', 2, A, 1, INFO ) 00157 CALL CHKXER( 'SPOTF2', INFOT, NOUT, LERR, OK ) 00158 * 00159 * SPOTRI 00160 * 00161 SRNAMT = 'SPOTRI' 00162 INFOT = 1 00163 CALL SPOTRI( '/', 0, A, 1, INFO ) 00164 CALL CHKXER( 'SPOTRI', INFOT, NOUT, LERR, OK ) 00165 INFOT = 2 00166 CALL SPOTRI( 'U', -1, A, 1, INFO ) 00167 CALL CHKXER( 'SPOTRI', INFOT, NOUT, LERR, OK ) 00168 INFOT = 4 00169 CALL SPOTRI( 'U', 2, A, 1, INFO ) 00170 CALL CHKXER( 'SPOTRI', INFOT, NOUT, LERR, OK ) 00171 * 00172 * SPOTRS 00173 * 00174 SRNAMT = 'SPOTRS' 00175 INFOT = 1 00176 CALL SPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) 00177 CALL CHKXER( 'SPOTRS', INFOT, NOUT, LERR, OK ) 00178 INFOT = 2 00179 CALL SPOTRS( 'U', -1, 0, A, 1, B, 1, INFO ) 00180 CALL CHKXER( 'SPOTRS', INFOT, NOUT, LERR, OK ) 00181 INFOT = 3 00182 CALL SPOTRS( 'U', 0, -1, A, 1, B, 1, INFO ) 00183 CALL CHKXER( 'SPOTRS', INFOT, NOUT, LERR, OK ) 00184 INFOT = 5 00185 CALL SPOTRS( 'U', 2, 1, A, 1, B, 2, INFO ) 00186 CALL CHKXER( 'SPOTRS', INFOT, NOUT, LERR, OK ) 00187 INFOT = 7 00188 CALL SPOTRS( 'U', 2, 1, A, 2, B, 1, INFO ) 00189 CALL CHKXER( 'SPOTRS', INFOT, NOUT, LERR, OK ) 00190 * 00191 * SPORFS 00192 * 00193 SRNAMT = 'SPORFS' 00194 INFOT = 1 00195 CALL SPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, IW, 00196 $ INFO ) 00197 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00198 INFOT = 2 00199 CALL SPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00200 $ IW, INFO ) 00201 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00202 INFOT = 3 00203 CALL SPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00204 $ IW, INFO ) 00205 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00206 INFOT = 5 00207 CALL SPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, IW, 00208 $ INFO ) 00209 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00210 INFOT = 7 00211 CALL SPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, IW, 00212 $ INFO ) 00213 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00214 INFOT = 9 00215 CALL SPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, IW, 00216 $ INFO ) 00217 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00218 INFOT = 11 00219 CALL SPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, IW, 00220 $ INFO ) 00221 CALL CHKXER( 'SPORFS', INFOT, NOUT, LERR, OK ) 00222 * 00223 * SPOCON 00224 * 00225 SRNAMT = 'SPOCON' 00226 INFOT = 1 00227 CALL SPOCON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00228 CALL CHKXER( 'SPOCON', INFOT, NOUT, LERR, OK ) 00229 INFOT = 2 00230 CALL SPOCON( 'U', -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00231 CALL CHKXER( 'SPOCON', INFOT, NOUT, LERR, OK ) 00232 INFOT = 4 00233 CALL SPOCON( 'U', 2, A, 1, ANRM, RCOND, W, IW, INFO ) 00234 CALL CHKXER( 'SPOCON', INFOT, NOUT, LERR, OK ) 00235 * 00236 * SPOEQU 00237 * 00238 SRNAMT = 'SPOEQU' 00239 INFOT = 1 00240 CALL SPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO ) 00241 CALL CHKXER( 'SPOEQU', INFOT, NOUT, LERR, OK ) 00242 INFOT = 3 00243 CALL SPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO ) 00244 CALL CHKXER( 'SPOEQU', INFOT, NOUT, LERR, OK ) 00245 * 00246 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN 00247 * 00248 * Test error exits of the routines that use the Cholesky 00249 * decomposition of a symmetric positive definite packed matrix. 00250 * 00251 * SPPTRF 00252 * 00253 SRNAMT = 'SPPTRF' 00254 INFOT = 1 00255 CALL SPPTRF( '/', 0, A, INFO ) 00256 CALL CHKXER( 'SPPTRF', INFOT, NOUT, LERR, OK ) 00257 INFOT = 2 00258 CALL SPPTRF( 'U', -1, A, INFO ) 00259 CALL CHKXER( 'SPPTRF', INFOT, NOUT, LERR, OK ) 00260 * 00261 * SPPTRI 00262 * 00263 SRNAMT = 'SPPTRI' 00264 INFOT = 1 00265 CALL SPPTRI( '/', 0, A, INFO ) 00266 CALL CHKXER( 'SPPTRI', INFOT, NOUT, LERR, OK ) 00267 INFOT = 2 00268 CALL SPPTRI( 'U', -1, A, INFO ) 00269 CALL CHKXER( 'SPPTRI', INFOT, NOUT, LERR, OK ) 00270 * 00271 * SPPTRS 00272 * 00273 SRNAMT = 'SPPTRS' 00274 INFOT = 1 00275 CALL SPPTRS( '/', 0, 0, A, B, 1, INFO ) 00276 CALL CHKXER( 'SPPTRS', INFOT, NOUT, LERR, OK ) 00277 INFOT = 2 00278 CALL SPPTRS( 'U', -1, 0, A, B, 1, INFO ) 00279 CALL CHKXER( 'SPPTRS', INFOT, NOUT, LERR, OK ) 00280 INFOT = 3 00281 CALL SPPTRS( 'U', 0, -1, A, B, 1, INFO ) 00282 CALL CHKXER( 'SPPTRS', INFOT, NOUT, LERR, OK ) 00283 INFOT = 6 00284 CALL SPPTRS( 'U', 2, 1, A, B, 1, INFO ) 00285 CALL CHKXER( 'SPPTRS', INFOT, NOUT, LERR, OK ) 00286 * 00287 * SPPRFS 00288 * 00289 SRNAMT = 'SPPRFS' 00290 INFOT = 1 00291 CALL SPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, IW, 00292 $ INFO ) 00293 CALL CHKXER( 'SPPRFS', INFOT, NOUT, LERR, OK ) 00294 INFOT = 2 00295 CALL SPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, IW, 00296 $ INFO ) 00297 CALL CHKXER( 'SPPRFS', INFOT, NOUT, LERR, OK ) 00298 INFOT = 3 00299 CALL SPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, IW, 00300 $ INFO ) 00301 CALL CHKXER( 'SPPRFS', INFOT, NOUT, LERR, OK ) 00302 INFOT = 7 00303 CALL SPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, IW, 00304 $ INFO ) 00305 CALL CHKXER( 'SPPRFS', INFOT, NOUT, LERR, OK ) 00306 INFOT = 9 00307 CALL SPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, IW, 00308 $ INFO ) 00309 CALL CHKXER( 'SPPRFS', INFOT, NOUT, LERR, OK ) 00310 * 00311 * SPPCON 00312 * 00313 SRNAMT = 'SPPCON' 00314 INFOT = 1 00315 CALL SPPCON( '/', 0, A, ANRM, RCOND, W, IW, INFO ) 00316 CALL CHKXER( 'SPPCON', INFOT, NOUT, LERR, OK ) 00317 INFOT = 2 00318 CALL SPPCON( 'U', -1, A, ANRM, RCOND, W, IW, INFO ) 00319 CALL CHKXER( 'SPPCON', INFOT, NOUT, LERR, OK ) 00320 * 00321 * SPPEQU 00322 * 00323 SRNAMT = 'SPPEQU' 00324 INFOT = 1 00325 CALL SPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO ) 00326 CALL CHKXER( 'SPPEQU', INFOT, NOUT, LERR, OK ) 00327 INFOT = 2 00328 CALL SPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO ) 00329 CALL CHKXER( 'SPPEQU', INFOT, NOUT, LERR, OK ) 00330 * 00331 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 00332 * 00333 * Test error exits of the routines that use the Cholesky 00334 * decomposition of a symmetric positive definite band matrix. 00335 * 00336 * SPBTRF 00337 * 00338 SRNAMT = 'SPBTRF' 00339 INFOT = 1 00340 CALL SPBTRF( '/', 0, 0, A, 1, INFO ) 00341 CALL CHKXER( 'SPBTRF', INFOT, NOUT, LERR, OK ) 00342 INFOT = 2 00343 CALL SPBTRF( 'U', -1, 0, A, 1, INFO ) 00344 CALL CHKXER( 'SPBTRF', INFOT, NOUT, LERR, OK ) 00345 INFOT = 3 00346 CALL SPBTRF( 'U', 1, -1, A, 1, INFO ) 00347 CALL CHKXER( 'SPBTRF', INFOT, NOUT, LERR, OK ) 00348 INFOT = 5 00349 CALL SPBTRF( 'U', 2, 1, A, 1, INFO ) 00350 CALL CHKXER( 'SPBTRF', INFOT, NOUT, LERR, OK ) 00351 * 00352 * SPBTF2 00353 * 00354 SRNAMT = 'SPBTF2' 00355 INFOT = 1 00356 CALL SPBTF2( '/', 0, 0, A, 1, INFO ) 00357 CALL CHKXER( 'SPBTF2', INFOT, NOUT, LERR, OK ) 00358 INFOT = 2 00359 CALL SPBTF2( 'U', -1, 0, A, 1, INFO ) 00360 CALL CHKXER( 'SPBTF2', INFOT, NOUT, LERR, OK ) 00361 INFOT = 3 00362 CALL SPBTF2( 'U', 1, -1, A, 1, INFO ) 00363 CALL CHKXER( 'SPBTF2', INFOT, NOUT, LERR, OK ) 00364 INFOT = 5 00365 CALL SPBTF2( 'U', 2, 1, A, 1, INFO ) 00366 CALL CHKXER( 'SPBTF2', INFOT, NOUT, LERR, OK ) 00367 * 00368 * SPBTRS 00369 * 00370 SRNAMT = 'SPBTRS' 00371 INFOT = 1 00372 CALL SPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO ) 00373 CALL CHKXER( 'SPBTRS', INFOT, NOUT, LERR, OK ) 00374 INFOT = 2 00375 CALL SPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO ) 00376 CALL CHKXER( 'SPBTRS', INFOT, NOUT, LERR, OK ) 00377 INFOT = 3 00378 CALL SPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO ) 00379 CALL CHKXER( 'SPBTRS', INFOT, NOUT, LERR, OK ) 00380 INFOT = 4 00381 CALL SPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO ) 00382 CALL CHKXER( 'SPBTRS', INFOT, NOUT, LERR, OK ) 00383 INFOT = 6 00384 CALL SPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO ) 00385 CALL CHKXER( 'SPBTRS', INFOT, NOUT, LERR, OK ) 00386 INFOT = 8 00387 CALL SPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO ) 00388 CALL CHKXER( 'SPBTRS', INFOT, NOUT, LERR, OK ) 00389 * 00390 * SPBRFS 00391 * 00392 SRNAMT = 'SPBRFS' 00393 INFOT = 1 00394 CALL SPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00395 $ IW, INFO ) 00396 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00397 INFOT = 2 00398 CALL SPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00399 $ IW, INFO ) 00400 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00401 INFOT = 3 00402 CALL SPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00403 $ IW, INFO ) 00404 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00405 INFOT = 4 00406 CALL SPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 00407 $ IW, INFO ) 00408 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00409 INFOT = 6 00410 CALL SPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, 00411 $ IW, INFO ) 00412 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00413 INFOT = 8 00414 CALL SPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, 00415 $ IW, INFO ) 00416 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00417 INFOT = 10 00418 CALL SPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W, 00419 $ IW, INFO ) 00420 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00421 INFOT = 12 00422 CALL SPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W, 00423 $ IW, INFO ) 00424 CALL CHKXER( 'SPBRFS', INFOT, NOUT, LERR, OK ) 00425 * 00426 * SPBCON 00427 * 00428 SRNAMT = 'SPBCON' 00429 INFOT = 1 00430 CALL SPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00431 CALL CHKXER( 'SPBCON', INFOT, NOUT, LERR, OK ) 00432 INFOT = 2 00433 CALL SPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00434 CALL CHKXER( 'SPBCON', INFOT, NOUT, LERR, OK ) 00435 INFOT = 3 00436 CALL SPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00437 CALL CHKXER( 'SPBCON', INFOT, NOUT, LERR, OK ) 00438 INFOT = 5 00439 CALL SPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, IW, INFO ) 00440 CALL CHKXER( 'SPBCON', INFOT, NOUT, LERR, OK ) 00441 * 00442 * SPBEQU 00443 * 00444 SRNAMT = 'SPBEQU' 00445 INFOT = 1 00446 CALL SPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO ) 00447 CALL CHKXER( 'SPBEQU', INFOT, NOUT, LERR, OK ) 00448 INFOT = 2 00449 CALL SPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO ) 00450 CALL CHKXER( 'SPBEQU', INFOT, NOUT, LERR, OK ) 00451 INFOT = 3 00452 CALL SPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO ) 00453 CALL CHKXER( 'SPBEQU', INFOT, NOUT, LERR, OK ) 00454 INFOT = 5 00455 CALL SPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO ) 00456 CALL CHKXER( 'SPBEQU', INFOT, NOUT, LERR, OK ) 00457 END IF 00458 * 00459 * Print a summary line. 00460 * 00461 CALL ALAESM( PATH, OK, NOUT ) 00462 * 00463 RETURN 00464 * 00465 * End of SERRPO 00466 * 00467 END