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