|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRSY( 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 * ZERRSY tests the error exits for the COMPLEX*16 routines 00016 * for symmetric indefinite matrices. 00017 * 00018 * Note that this file is used only when the XBLAS are available, 00019 * otherwise zerrsy.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 DOUBLE PRECISION ANRM, RCOND, BERR 00041 * .. 00042 * .. Local Arrays .. 00043 INTEGER IP( NMAX ) 00044 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ), 00045 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ), 00046 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 00047 COMPLEX*16 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, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI, 00056 $ ZSPTRS, ZSYCON, ZSYRFS, ZSYTF2, ZSYTRF, ZSYTRI, 00057 $ ZSYTRI2, ZSYTRS, ZSYRFSX 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 DBLE, DCMPLX 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 ) = DCMPLX( 1.D0 / DBLE( I+J ), 00082 $ -1.D0 / DBLE( I+J ) ) 00083 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00084 $ -1.D0 / DBLE( I+J ) ) 00085 10 CONTINUE 00086 B( J ) = 0.D0 00087 R1( J ) = 0.D0 00088 R2( J ) = 0.D0 00089 W( J ) = 0.D0 00090 X( J ) = 0.D0 00091 S( J ) = 0.D0 00092 IP( J ) = J 00093 20 CONTINUE 00094 ANRM = 1.0D0 00095 OK = .TRUE. 00096 * 00097 * Test error exits of the routines that use the diagonal pivoting 00098 * factorization of a symmetric indefinite matrix. 00099 * 00100 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00101 * 00102 * ZSYTRF 00103 * 00104 SRNAMT = 'ZSYTRF' 00105 INFOT = 1 00106 CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00107 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00108 INFOT = 2 00109 CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00110 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00111 INFOT = 4 00112 CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00113 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00114 * 00115 * ZSYTF2 00116 * 00117 SRNAMT = 'ZSYTF2' 00118 INFOT = 1 00119 CALL ZSYTF2( '/', 0, A, 1, IP, INFO ) 00120 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00121 INFOT = 2 00122 CALL ZSYTF2( 'U', -1, A, 1, IP, INFO ) 00123 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00124 INFOT = 4 00125 CALL ZSYTF2( 'U', 2, A, 1, IP, INFO ) 00126 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00127 * 00128 * ZSYTRI 00129 * 00130 SRNAMT = 'ZSYTRI' 00131 INFOT = 1 00132 CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO ) 00133 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00134 INFOT = 2 00135 CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00136 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00137 INFOT = 4 00138 CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00139 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00140 * 00141 * ZSYTRI2 00142 * 00143 SRNAMT = 'ZSYTRI2' 00144 INFOT = 1 00145 CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00146 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00147 INFOT = 2 00148 CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00149 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00150 INFOT = 4 00151 CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00152 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00153 * 00154 * ZSYTRS 00155 * 00156 SRNAMT = 'ZSYTRS' 00157 INFOT = 1 00158 CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00159 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00160 INFOT = 2 00161 CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00162 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00163 INFOT = 3 00164 CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00165 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00166 INFOT = 5 00167 CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00168 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00169 INFOT = 8 00170 CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00171 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00172 * 00173 * ZSYRFS 00174 * 00175 SRNAMT = 'ZSYRFS' 00176 INFOT = 1 00177 CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00178 $ R, INFO ) 00179 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00180 INFOT = 2 00181 CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00182 $ W, R, INFO ) 00183 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00184 INFOT = 3 00185 CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00186 $ W, R, INFO ) 00187 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00188 INFOT = 5 00189 CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00190 $ R, INFO ) 00191 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00192 INFOT = 7 00193 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00194 $ R, INFO ) 00195 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00196 INFOT = 10 00197 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00198 $ R, INFO ) 00199 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00200 INFOT = 12 00201 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00202 $ R, INFO ) 00203 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00204 * 00205 * ZSYRFSX 00206 * 00207 N_ERR_BNDS = 3 00208 NPARAMS = 0 00209 SRNAMT = 'ZSYRFSX' 00210 INFOT = 1 00211 CALL ZSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00212 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00213 $ PARAMS, W, R, INFO ) 00214 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00215 INFOT = 2 00216 CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00217 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00218 $ PARAMS, W, R, INFO ) 00219 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00220 EQ = 'N' 00221 INFOT = 3 00222 CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00223 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00224 $ PARAMS, W, R, INFO ) 00225 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00226 INFOT = 4 00227 CALL ZSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 00228 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00229 $ PARAMS, W, R, INFO ) 00230 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00231 INFOT = 6 00232 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 00233 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00234 $ PARAMS, W, R, INFO ) 00235 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00236 INFOT = 8 00237 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 00238 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00239 $ PARAMS, W, R, INFO ) 00240 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00241 INFOT = 11 00242 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 00243 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00244 $ PARAMS, W, R, INFO ) 00245 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00246 INFOT = 13 00247 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 00248 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00249 $ PARAMS, W, R, INFO ) 00250 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00251 * 00252 * ZSYCON 00253 * 00254 SRNAMT = 'ZSYCON' 00255 INFOT = 1 00256 CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00257 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00258 INFOT = 2 00259 CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00260 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00261 INFOT = 4 00262 CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00263 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00264 INFOT = 6 00265 CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00266 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00267 * 00268 * Test error exits of the routines that use the diagonal pivoting 00269 * factorization of a symmetric indefinite packed matrix. 00270 * 00271 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00272 * 00273 * ZSPTRF 00274 * 00275 SRNAMT = 'ZSPTRF' 00276 INFOT = 1 00277 CALL ZSPTRF( '/', 0, A, IP, INFO ) 00278 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00279 INFOT = 2 00280 CALL ZSPTRF( 'U', -1, A, IP, INFO ) 00281 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00282 * 00283 * ZSPTRI 00284 * 00285 SRNAMT = 'ZSPTRI' 00286 INFOT = 1 00287 CALL ZSPTRI( '/', 0, A, IP, W, INFO ) 00288 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00289 INFOT = 2 00290 CALL ZSPTRI( 'U', -1, A, IP, W, INFO ) 00291 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00292 * 00293 * ZSPTRS 00294 * 00295 SRNAMT = 'ZSPTRS' 00296 INFOT = 1 00297 CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00298 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00299 INFOT = 2 00300 CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00301 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00302 INFOT = 3 00303 CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00304 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00305 INFOT = 7 00306 CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00307 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00308 * 00309 * ZSPRFS 00310 * 00311 SRNAMT = 'ZSPRFS' 00312 INFOT = 1 00313 CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00314 $ INFO ) 00315 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00316 INFOT = 2 00317 CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00318 $ INFO ) 00319 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00320 INFOT = 3 00321 CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00322 $ INFO ) 00323 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00324 INFOT = 8 00325 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00326 $ INFO ) 00327 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00328 INFOT = 10 00329 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00330 $ INFO ) 00331 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00332 * 00333 * ZSPCON 00334 * 00335 SRNAMT = 'ZSPCON' 00336 INFOT = 1 00337 CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00338 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00339 INFOT = 2 00340 CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00341 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00342 INFOT = 5 00343 CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00344 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00345 END IF 00346 * 00347 * Print a summary line. 00348 * 00349 CALL ALAESM( PATH, OK, NOUT ) 00350 * 00351 RETURN 00352 * 00353 * End of ZERRSY 00354 * 00355 END
1.7.3 
