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