 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SERRSY( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.2) -- 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 * SERRSY tests the error exits for the REAL routines 00016 * for symmetric indefinite matrices. 00017 * 00018 * Note that this file is used only when the XBLAS are available, 00019 * otherwise serrsy.f defines this subroutine. 00020 * 00021 * Arguments 00022 * ========= 00023 * 00024 * PATH (input) CHARACTER*3 00025 * The LAPACK path name for the routines to be tested. 00026 * 00027 * NUNIT (input) INTEGER 00028 * The unit number for output. 00029 * 00030 * ===================================================================== 00031 * 00032 * .. Parameters .. 00033 INTEGER NMAX 00034 PARAMETER ( NMAX = 4 ) 00035 * .. 00036 * .. Local Scalars .. 00037 CHARACTER EQ 00038 CHARACTER*2 C2 00039 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS 00040 REAL ANRM, RCOND, BERR 00041 * .. 00042 * .. Local Arrays .. 00043 INTEGER IP( NMAX ), IW( NMAX ) 00044 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00045 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ), 00046 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ), 00047 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 00048 * .. 00049 * .. External Functions .. 00050 LOGICAL LSAMEN 00051 EXTERNAL LSAMEN 00052 * .. 00053 * .. External Subroutines .. 00054 EXTERNAL ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI, 00055 $ SSPTRS, SSYCON, SSYRFS, SSYTF2, SSYTRF, SSYTRI, 00056 $ SSYTRI2, SSYTRS, SSYRFSX 00057 * .. 00058 * .. Scalars in Common .. 00059 LOGICAL LERR, OK 00060 CHARACTER*32 SRNAMT 00061 INTEGER INFOT, NOUT 00062 * .. 00063 * .. Common blocks .. 00064 COMMON / INFOC / INFOT, NOUT, OK, LERR 00065 COMMON / SRNAMC / SRNAMT 00066 * .. 00067 * .. Intrinsic Functions .. 00068 INTRINSIC REAL 00069 * .. 00070 * .. Executable Statements .. 00071 * 00072 NOUT = NUNIT 00073 WRITE( NOUT, FMT = * ) 00074 C2 = PATH( 2: 3 ) 00075 * 00076 * Set the variables to innocuous values. 00077 * 00078 DO 20 J = 1, NMAX 00079 DO 10 I = 1, NMAX 00080 A( I, J ) = 1. / REAL( I+J ) 00081 AF( I, J ) = 1. / REAL( I+J ) 00082 10 CONTINUE 00083 B( J ) = 0. 00084 R1( J ) = 0. 00085 R2( J ) = 0. 00086 W( J ) = 0. 00087 X( J ) = 0. 00088 S( J ) = 0. 00089 IP( J ) = J 00090 IW( J ) = J 00091 20 CONTINUE 00092 ANRM = 1.0 00093 RCOND = 1.0 00094 OK = .TRUE. 00095 * 00096 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00097 * 00098 * Test error exits of the routines that use the Bunch-Kaufman 00099 * factorization of a symmetric indefinite matrix. 00100 * 00101 * SSYTRF 00102 * 00103 SRNAMT = 'SSYTRF' 00104 INFOT = 1 00105 CALL SSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00106 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK ) 00107 INFOT = 2 00108 CALL SSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00109 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK ) 00110 INFOT = 4 00111 CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00112 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK ) 00113 * 00114 * SSYTF2 00115 * 00116 SRNAMT = 'SSYTF2' 00117 INFOT = 1 00118 CALL SSYTF2( '/', 0, A, 1, IP, INFO ) 00119 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK ) 00120 INFOT = 2 00121 CALL SSYTF2( 'U', -1, A, 1, IP, INFO ) 00122 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK ) 00123 INFOT = 4 00124 CALL SSYTF2( 'U', 2, A, 1, IP, INFO ) 00125 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK ) 00126 * 00127 * SSYTRI 00128 * 00129 SRNAMT = 'SSYTRI' 00130 INFOT = 1 00131 CALL SSYTRI( '/', 0, A, 1, IP, W, INFO ) 00132 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK ) 00133 INFOT = 2 00134 CALL SSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00135 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK ) 00136 INFOT = 4 00137 CALL SSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00138 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK ) 00139 * 00140 * SSYTRI2 00141 * 00142 SRNAMT = 'SSYTRI2' 00143 INFOT = 1 00144 CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO ) 00145 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK ) 00146 INFOT = 2 00147 CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO ) 00148 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK ) 00149 INFOT = 4 00150 CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO ) 00151 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK ) 00152 * 00153 * SSYTRS 00154 * 00155 SRNAMT = 'SSYTRS' 00156 INFOT = 1 00157 CALL SSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00158 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK ) 00159 INFOT = 2 00160 CALL SSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00161 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK ) 00162 INFOT = 3 00163 CALL SSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00164 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK ) 00165 INFOT = 5 00166 CALL SSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00167 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK ) 00168 INFOT = 8 00169 CALL SSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00170 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK ) 00171 * 00172 * SSYRFS 00173 * 00174 SRNAMT = 'SSYRFS' 00175 INFOT = 1 00176 CALL SSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00177 $ IW, INFO ) 00178 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00179 INFOT = 2 00180 CALL SSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00181 $ W, IW, INFO ) 00182 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00183 INFOT = 3 00184 CALL SSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00185 $ W, IW, INFO ) 00186 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00187 INFOT = 5 00188 CALL SSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00189 $ IW, INFO ) 00190 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00191 INFOT = 7 00192 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00193 $ IW, INFO ) 00194 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00195 INFOT = 10 00196 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00197 $ IW, INFO ) 00198 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00199 INFOT = 12 00200 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00201 $ IW, INFO ) 00202 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK ) 00203 * 00204 * SSYRFSX 00205 * 00206 N_ERR_BNDS = 3 00207 NPARAMS = 0 00208 SRNAMT = 'SSYRFSX' 00209 INFOT = 1 00210 CALL SSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00211 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00212 $ PARAMS, W, IW, INFO ) 00213 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00214 INFOT = 2 00215 CALL SSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00216 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00217 $ PARAMS, W, IW, INFO ) 00218 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00219 EQ = 'N' 00220 INFOT = 3 00221 CALL SSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00222 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00223 $ PARAMS, W, IW, INFO ) 00224 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00225 INFOT = 4 00226 CALL SSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 00227 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00228 $ PARAMS, W, IW, INFO ) 00229 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00230 INFOT = 6 00231 CALL SSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 00232 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00233 $ PARAMS, W, IW, INFO ) 00234 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00235 INFOT = 8 00236 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 00237 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00238 $ PARAMS, W, IW, INFO ) 00239 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00240 INFOT = 11 00241 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 00242 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00243 $ PARAMS, W, IW, INFO ) 00244 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00245 INFOT = 13 00246 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 00247 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00248 $ PARAMS, W, IW, INFO ) 00249 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK ) 00250 * 00251 * SSYCON 00252 * 00253 SRNAMT = 'SSYCON' 00254 INFOT = 1 00255 CALL SSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00256 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK ) 00257 INFOT = 2 00258 CALL SSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00259 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK ) 00260 INFOT = 4 00261 CALL SSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00262 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK ) 00263 INFOT = 6 00264 CALL SSYCON( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO ) 00265 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK ) 00266 * 00267 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00268 * 00269 * Test error exits of the routines that use the Bunch-Kaufman 00270 * factorization of a symmetric indefinite packed matrix. 00271 * 00272 * SSPTRF 00273 * 00274 SRNAMT = 'SSPTRF' 00275 INFOT = 1 00276 CALL SSPTRF( '/', 0, A, IP, INFO ) 00277 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK ) 00278 INFOT = 2 00279 CALL SSPTRF( 'U', -1, A, IP, INFO ) 00280 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK ) 00281 * 00282 * SSPTRI 00283 * 00284 SRNAMT = 'SSPTRI' 00285 INFOT = 1 00286 CALL SSPTRI( '/', 0, A, IP, W, INFO ) 00287 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK ) 00288 INFOT = 2 00289 CALL SSPTRI( 'U', -1, A, IP, W, INFO ) 00290 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK ) 00291 * 00292 * SSPTRS 00293 * 00294 SRNAMT = 'SSPTRS' 00295 INFOT = 1 00296 CALL SSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00297 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK ) 00298 INFOT = 2 00299 CALL SSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00300 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK ) 00301 INFOT = 3 00302 CALL SSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00303 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK ) 00304 INFOT = 7 00305 CALL SSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00306 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK ) 00307 * 00308 * SSPRFS 00309 * 00310 SRNAMT = 'SSPRFS' 00311 INFOT = 1 00312 CALL SSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW, 00313 $ INFO ) 00314 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK ) 00315 INFOT = 2 00316 CALL SSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW, 00317 $ INFO ) 00318 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK ) 00319 INFOT = 3 00320 CALL SSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW, 00321 $ INFO ) 00322 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK ) 00323 INFOT = 8 00324 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW, 00325 $ INFO ) 00326 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK ) 00327 INFOT = 10 00328 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW, 00329 $ INFO ) 00330 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK ) 00331 * 00332 * SSPCON 00333 * 00334 SRNAMT = 'SSPCON' 00335 INFOT = 1 00336 CALL SSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO ) 00337 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK ) 00338 INFOT = 2 00339 CALL SSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO ) 00340 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK ) 00341 INFOT = 5 00342 CALL SSPCON( 'U', 1, A, IP, -1.0, RCOND, W, IW, INFO ) 00343 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK ) 00344 END IF 00345 * 00346 * Print a summary line. 00347 * 00348 CALL ALAESM( PATH, OK, NOUT ) 00349 * 00350 RETURN 00351 * 00352 * End of SERRSY 00353 * 00354 END
1.7.3 
