|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CERRHE( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 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 * CERRHE tests the error exits for the COMPLEX routines 00016 * for Hermitian indefinite matrices. 00017 * 00018 * Arguments 00019 * ========= 00020 * 00021 * PATH (input) CHARACTER*3 00022 * The LAPACK path name for the routines to be tested. 00023 * 00024 * NUNIT (input) INTEGER 00025 * The unit number for output. 00026 * 00027 * ===================================================================== 00028 * 00029 * 00030 * .. Parameters .. 00031 INTEGER NMAX 00032 PARAMETER ( NMAX = 4 ) 00033 * .. 00034 * .. Local Scalars .. 00035 CHARACTER*2 C2 00036 INTEGER I, INFO, J 00037 REAL ANRM, RCOND 00038 * .. 00039 * .. Local Arrays .. 00040 INTEGER IP( NMAX ) 00041 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 00042 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00043 $ W( 2*NMAX ), X( NMAX ) 00044 * .. 00045 * .. External Functions .. 00046 LOGICAL LSAMEN 00047 EXTERNAL LSAMEN 00048 * .. 00049 * .. External Subroutines .. 00050 EXTERNAL ALAESM, CHECON, CHERFS, CHETF2, CHETRF, CHETRI, 00051 $ CHETRS, CHKXER, CHPCON, CHPRFS, CHPTRF, CHPTRI, 00052 $ CHPTRS 00053 * .. 00054 * .. Scalars in Common .. 00055 LOGICAL LERR, OK 00056 CHARACTER*32 SRNAMT 00057 INTEGER INFOT, NOUT 00058 * .. 00059 * .. Common blocks .. 00060 COMMON / INFOC / INFOT, NOUT, OK, LERR 00061 COMMON / SRNAMC / SRNAMT 00062 * .. 00063 * .. Intrinsic Functions .. 00064 INTRINSIC CMPLX, REAL 00065 * .. 00066 * .. Executable Statements .. 00067 * 00068 NOUT = NUNIT 00069 WRITE( NOUT, FMT = * ) 00070 C2 = PATH( 2: 3 ) 00071 * 00072 * Set the variables to innocuous values. 00073 * 00074 DO 20 J = 1, NMAX 00075 DO 10 I = 1, NMAX 00076 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00077 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00078 10 CONTINUE 00079 B( J ) = 0. 00080 R1( J ) = 0. 00081 R2( J ) = 0. 00082 W( J ) = 0. 00083 X( J ) = 0. 00084 IP( J ) = J 00085 20 CONTINUE 00086 ANRM = 1.0 00087 OK = .TRUE. 00088 * 00089 * Test error exits of the routines that use the diagonal pivoting 00090 * factorization of a Hermitian indefinite matrix. 00091 * 00092 IF( LSAMEN( 2, C2, 'HE' ) ) THEN 00093 * 00094 * CHETRF 00095 * 00096 SRNAMT = 'CHETRF' 00097 INFOT = 1 00098 CALL CHETRF( '/', 0, A, 1, IP, W, 1, INFO ) 00099 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 00100 INFOT = 2 00101 CALL CHETRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00102 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 00103 INFOT = 4 00104 CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00105 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 00106 * 00107 * CHETF2 00108 * 00109 SRNAMT = 'CHETF2' 00110 INFOT = 1 00111 CALL CHETF2( '/', 0, A, 1, IP, INFO ) 00112 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 00113 INFOT = 2 00114 CALL CHETF2( 'U', -1, A, 1, IP, INFO ) 00115 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 00116 INFOT = 4 00117 CALL CHETF2( 'U', 2, A, 1, IP, INFO ) 00118 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 00119 * 00120 * CHETRI 00121 * 00122 SRNAMT = 'CHETRI' 00123 INFOT = 1 00124 CALL CHETRI( '/', 0, A, 1, IP, W, INFO ) 00125 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 00126 INFOT = 2 00127 CALL CHETRI( 'U', -1, A, 1, IP, W, INFO ) 00128 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 00129 INFOT = 4 00130 CALL CHETRI( 'U', 2, A, 1, IP, W, INFO ) 00131 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 00132 * 00133 * CHETRS 00134 * 00135 SRNAMT = 'CHETRS' 00136 INFOT = 1 00137 CALL CHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00138 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL CHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00141 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 00142 INFOT = 3 00143 CALL CHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00144 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 00145 INFOT = 5 00146 CALL CHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00147 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 00148 INFOT = 8 00149 CALL CHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00150 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 00151 * 00152 * CHERFS 00153 * 00154 SRNAMT = 'CHERFS' 00155 INFOT = 1 00156 CALL CHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00157 $ R, INFO ) 00158 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00159 INFOT = 2 00160 CALL CHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00161 $ W, R, INFO ) 00162 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00163 INFOT = 3 00164 CALL CHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00165 $ W, R, INFO ) 00166 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00167 INFOT = 5 00168 CALL CHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00169 $ R, INFO ) 00170 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00171 INFOT = 7 00172 CALL CHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00173 $ R, INFO ) 00174 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00175 INFOT = 10 00176 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00177 $ R, INFO ) 00178 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00179 INFOT = 12 00180 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00181 $ R, INFO ) 00182 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 00183 * 00184 * CHECON 00185 * 00186 SRNAMT = 'CHECON' 00187 INFOT = 1 00188 CALL CHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00189 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 00190 INFOT = 2 00191 CALL CHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00192 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 00193 INFOT = 4 00194 CALL CHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00195 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 00196 INFOT = 6 00197 CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00198 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 00199 * 00200 * Test error exits of the routines that use the diagonal pivoting 00201 * factorization of a Hermitian indefinite packed matrix. 00202 * 00203 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN 00204 * 00205 * CHPTRF 00206 * 00207 SRNAMT = 'CHPTRF' 00208 INFOT = 1 00209 CALL CHPTRF( '/', 0, A, IP, INFO ) 00210 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK ) 00211 INFOT = 2 00212 CALL CHPTRF( 'U', -1, A, IP, INFO ) 00213 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK ) 00214 * 00215 * CHPTRI 00216 * 00217 SRNAMT = 'CHPTRI' 00218 INFOT = 1 00219 CALL CHPTRI( '/', 0, A, IP, W, INFO ) 00220 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK ) 00221 INFOT = 2 00222 CALL CHPTRI( 'U', -1, A, IP, W, INFO ) 00223 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK ) 00224 * 00225 * CHPTRS 00226 * 00227 SRNAMT = 'CHPTRS' 00228 INFOT = 1 00229 CALL CHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00230 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 00231 INFOT = 2 00232 CALL CHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00233 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 00234 INFOT = 3 00235 CALL CHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00236 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 00237 INFOT = 7 00238 CALL CHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00239 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 00240 * 00241 * CHPRFS 00242 * 00243 SRNAMT = 'CHPRFS' 00244 INFOT = 1 00245 CALL CHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00246 $ INFO ) 00247 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 00248 INFOT = 2 00249 CALL CHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00250 $ INFO ) 00251 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 00252 INFOT = 3 00253 CALL CHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00254 $ INFO ) 00255 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 00256 INFOT = 8 00257 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00258 $ INFO ) 00259 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 00260 INFOT = 10 00261 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00262 $ INFO ) 00263 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 00264 * 00265 * CHPCON 00266 * 00267 SRNAMT = 'CHPCON' 00268 INFOT = 1 00269 CALL CHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00270 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 00271 INFOT = 2 00272 CALL CHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00273 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 00274 INFOT = 5 00275 CALL CHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00276 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 00277 END IF 00278 * 00279 * Print a summary line. 00280 * 00281 CALL ALAESM( PATH, OK, NOUT ) 00282 * 00283 RETURN 00284 * 00285 * End of CERRHE 00286 * 00287 END
1.7.3 
