|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRHE( 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 * 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, ZHETRS, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRI, 00052 $ 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 * ZHETRS 00136 * 00137 SRNAMT = 'ZHETRS' 00138 INFOT = 1 00139 CALL ZHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00140 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL ZHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00143 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00144 INFOT = 3 00145 CALL ZHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00146 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00147 INFOT = 5 00148 CALL ZHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00149 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00150 INFOT = 8 00151 CALL ZHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00152 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00153 * 00154 * ZHERFS 00155 * 00156 SRNAMT = 'ZHERFS' 00157 INFOT = 1 00158 CALL ZHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00159 $ R, INFO ) 00160 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00161 INFOT = 2 00162 CALL ZHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00163 $ W, R, INFO ) 00164 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00165 INFOT = 3 00166 CALL ZHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00167 $ W, R, INFO ) 00168 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00169 INFOT = 5 00170 CALL ZHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00171 $ R, INFO ) 00172 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00173 INFOT = 7 00174 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00175 $ R, INFO ) 00176 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00177 INFOT = 10 00178 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00179 $ R, INFO ) 00180 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00181 INFOT = 12 00182 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00183 $ R, INFO ) 00184 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00185 * 00186 * ZHECON 00187 * 00188 SRNAMT = 'ZHECON' 00189 INFOT = 1 00190 CALL ZHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00191 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00192 INFOT = 2 00193 CALL ZHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00194 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00195 INFOT = 4 00196 CALL ZHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00197 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00198 INFOT = 6 00199 CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00200 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00201 * 00202 * Test error exits of the routines that use the diagonal pivoting 00203 * factorization of a Hermitian indefinite packed matrix. 00204 * 00205 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN 00206 * 00207 * ZHPTRF 00208 * 00209 SRNAMT = 'ZHPTRF' 00210 INFOT = 1 00211 CALL ZHPTRF( '/', 0, A, IP, INFO ) 00212 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 00213 INFOT = 2 00214 CALL ZHPTRF( 'U', -1, A, IP, INFO ) 00215 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 00216 * 00217 * ZHPTRI 00218 * 00219 SRNAMT = 'ZHPTRI' 00220 INFOT = 1 00221 CALL ZHPTRI( '/', 0, A, IP, W, INFO ) 00222 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 00223 INFOT = 2 00224 CALL ZHPTRI( 'U', -1, A, IP, W, INFO ) 00225 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 00226 * 00227 * ZHPTRS 00228 * 00229 SRNAMT = 'ZHPTRS' 00230 INFOT = 1 00231 CALL ZHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00232 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00233 INFOT = 2 00234 CALL ZHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00235 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00236 INFOT = 3 00237 CALL ZHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00238 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00239 INFOT = 7 00240 CALL ZHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00241 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00242 * 00243 * ZHPRFS 00244 * 00245 SRNAMT = 'ZHPRFS' 00246 INFOT = 1 00247 CALL ZHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00248 $ INFO ) 00249 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00250 INFOT = 2 00251 CALL ZHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00252 $ INFO ) 00253 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00254 INFOT = 3 00255 CALL ZHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00256 $ INFO ) 00257 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00258 INFOT = 8 00259 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00260 $ INFO ) 00261 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00262 INFOT = 10 00263 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00264 $ INFO ) 00265 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00266 * 00267 * ZHPCON 00268 * 00269 SRNAMT = 'ZHPCON' 00270 INFOT = 1 00271 CALL ZHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00272 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00273 INFOT = 2 00274 CALL ZHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00275 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00276 INFOT = 5 00277 CALL ZHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00278 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00279 END IF 00280 * 00281 * Print a summary line. 00282 * 00283 CALL ALAESM( PATH, OK, NOUT ) 00284 * 00285 RETURN 00286 * 00287 * End of ZERRHE 00288 * 00289 END
1.7.3 
