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