 |
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 * 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 DOUBLE PRECISION ANRM, RCOND 00038 * .. 00039 * .. Local Arrays .. 00040 INTEGER IP( NMAX ) 00041 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) 00042 COMPLEX*16 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, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF, 00051 $ ZHETRI, ZHETRI2, ZHETRS, ZHPCON, ZHPRFS, 00052 $ ZHPTRF, ZHPTRI, ZHPTRS 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 DBLE, DCMPLX 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 ) = DCMPLX( 1.D0 / DBLE( I+J ), 00077 $ -1.D0 / DBLE( I+J ) ) 00078 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00079 $ -1.D0 / DBLE( I+J ) ) 00080 10 CONTINUE 00081 B( J ) = 0.D0 00082 R1( J ) = 0.D0 00083 R2( J ) = 0.D0 00084 W( J ) = 0.D0 00085 X( J ) = 0.D0 00086 IP( J ) = J 00087 20 CONTINUE 00088 ANRM = 1.0D0 00089 OK = .TRUE. 00090 * 00091 * Test error exits of the routines that use the diagonal pivoting 00092 * factorization of a Hermitian indefinite matrix. 00093 * 00094 IF( LSAMEN( 2, C2, 'HE' ) ) THEN 00095 * 00096 * ZHETRF 00097 * 00098 SRNAMT = 'ZHETRF' 00099 INFOT = 1 00100 CALL ZHETRF( '/', 0, A, 1, IP, W, 1, INFO ) 00101 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 00102 INFOT = 2 00103 CALL ZHETRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00104 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 00105 INFOT = 4 00106 CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00107 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 00108 * 00109 * ZHETF2 00110 * 00111 SRNAMT = 'ZHETF2' 00112 INFOT = 1 00113 CALL ZHETF2( '/', 0, A, 1, IP, INFO ) 00114 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 00115 INFOT = 2 00116 CALL ZHETF2( 'U', -1, A, 1, IP, INFO ) 00117 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 00118 INFOT = 4 00119 CALL ZHETF2( 'U', 2, A, 1, IP, INFO ) 00120 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 00121 * 00122 * ZHETRI 00123 * 00124 SRNAMT = 'ZHETRI' 00125 INFOT = 1 00126 CALL ZHETRI( '/', 0, A, 1, IP, W, INFO ) 00127 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 00128 INFOT = 2 00129 CALL ZHETRI( 'U', -1, A, 1, IP, W, INFO ) 00130 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 00131 INFOT = 4 00132 CALL ZHETRI( 'U', 2, A, 1, IP, W, INFO ) 00133 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 00134 * 00135 * ZHETRI2 00136 * 00137 SRNAMT = 'ZHETRI2' 00138 INFOT = 1 00139 CALL ZHETRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00140 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL ZHETRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00143 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 00144 INFOT = 4 00145 CALL ZHETRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00146 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 00147 * 00148 * ZHETRS 00149 * 00150 SRNAMT = 'ZHETRS' 00151 INFOT = 1 00152 CALL ZHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00153 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00154 INFOT = 2 00155 CALL ZHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00156 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00157 INFOT = 3 00158 CALL ZHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00159 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00160 INFOT = 5 00161 CALL ZHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00162 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00163 INFOT = 8 00164 CALL ZHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00165 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00166 * 00167 * ZHERFS 00168 * 00169 SRNAMT = 'ZHERFS' 00170 INFOT = 1 00171 CALL ZHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00172 $ R, INFO ) 00173 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00174 INFOT = 2 00175 CALL ZHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00176 $ W, R, INFO ) 00177 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00178 INFOT = 3 00179 CALL ZHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00180 $ W, R, INFO ) 00181 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00182 INFOT = 5 00183 CALL ZHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00184 $ R, INFO ) 00185 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00186 INFOT = 7 00187 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00188 $ R, INFO ) 00189 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00190 INFOT = 10 00191 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00192 $ R, INFO ) 00193 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00194 INFOT = 12 00195 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00196 $ R, INFO ) 00197 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00198 * 00199 * ZHECON 00200 * 00201 SRNAMT = 'ZHECON' 00202 INFOT = 1 00203 CALL ZHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00204 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00205 INFOT = 2 00206 CALL ZHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00207 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00208 INFOT = 4 00209 CALL ZHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00210 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00211 INFOT = 6 00212 CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00213 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00214 * 00215 * Test error exits of the routines that use the diagonal pivoting 00216 * factorization of a Hermitian indefinite packed matrix. 00217 * 00218 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN 00219 * 00220 * ZHPTRF 00221 * 00222 SRNAMT = 'ZHPTRF' 00223 INFOT = 1 00224 CALL ZHPTRF( '/', 0, A, IP, INFO ) 00225 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 00226 INFOT = 2 00227 CALL ZHPTRF( 'U', -1, A, IP, INFO ) 00228 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 00229 * 00230 * ZHPTRI 00231 * 00232 SRNAMT = 'ZHPTRI' 00233 INFOT = 1 00234 CALL ZHPTRI( '/', 0, A, IP, W, INFO ) 00235 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 00236 INFOT = 2 00237 CALL ZHPTRI( 'U', -1, A, IP, W, INFO ) 00238 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 00239 * 00240 * ZHPTRS 00241 * 00242 SRNAMT = 'ZHPTRS' 00243 INFOT = 1 00244 CALL ZHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00245 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00246 INFOT = 2 00247 CALL ZHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00248 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00249 INFOT = 3 00250 CALL ZHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00251 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00252 INFOT = 7 00253 CALL ZHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00254 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00255 * 00256 * ZHPRFS 00257 * 00258 SRNAMT = 'ZHPRFS' 00259 INFOT = 1 00260 CALL ZHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00261 $ INFO ) 00262 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00263 INFOT = 2 00264 CALL ZHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00265 $ INFO ) 00266 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00267 INFOT = 3 00268 CALL ZHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00269 $ INFO ) 00270 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00271 INFOT = 8 00272 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00273 $ INFO ) 00274 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00275 INFOT = 10 00276 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00277 $ INFO ) 00278 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00279 * 00280 * ZHPCON 00281 * 00282 SRNAMT = 'ZHPCON' 00283 INFOT = 1 00284 CALL ZHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00285 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00286 INFOT = 2 00287 CALL ZHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00288 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00289 INFOT = 5 00290 CALL ZHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00291 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00292 END IF 00293 * 00294 * Print a summary line. 00295 * 00296 CALL ALAESM( PATH, OK, NOUT ) 00297 * 00298 RETURN 00299 * 00300 * End of ZERRHE 00301 * 00302 END
1.7.3 
