![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERRHE 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZERRHE( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> ZERRHE tests the error exits for the COMPLEX*16 routines 00025 *> for Hermitian indefinite matrices. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup complex16_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE ZERRHE( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * 00071 * .. Parameters .. 00072 INTEGER NMAX 00073 PARAMETER ( NMAX = 4 ) 00074 * .. 00075 * .. Local Scalars .. 00076 CHARACTER*2 C2 00077 INTEGER I, INFO, J 00078 DOUBLE PRECISION ANRM, RCOND 00079 * .. 00080 * .. Local Arrays .. 00081 INTEGER IP( NMAX ) 00082 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) 00083 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00084 $ W( 2*NMAX ), X( NMAX ) 00085 * .. 00086 * .. External Functions .. 00087 LOGICAL LSAMEN 00088 EXTERNAL LSAMEN 00089 * .. 00090 * .. External Subroutines .. 00091 EXTERNAL ALAESM, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF, 00092 $ ZHETRI, ZHETRI2, ZHETRS, ZHPCON, ZHPRFS, 00093 $ ZHPTRF, ZHPTRI, ZHPTRS 00094 * .. 00095 * .. Scalars in Common .. 00096 LOGICAL LERR, OK 00097 CHARACTER*32 SRNAMT 00098 INTEGER INFOT, NOUT 00099 * .. 00100 * .. Common blocks .. 00101 COMMON / INFOC / INFOT, NOUT, OK, LERR 00102 COMMON / SRNAMC / SRNAMT 00103 * .. 00104 * .. Intrinsic Functions .. 00105 INTRINSIC DBLE, DCMPLX 00106 * .. 00107 * .. Executable Statements .. 00108 * 00109 NOUT = NUNIT 00110 WRITE( NOUT, FMT = * ) 00111 C2 = PATH( 2: 3 ) 00112 * 00113 * Set the variables to innocuous values. 00114 * 00115 DO 20 J = 1, NMAX 00116 DO 10 I = 1, NMAX 00117 A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00118 $ -1.D0 / DBLE( I+J ) ) 00119 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00120 $ -1.D0 / DBLE( I+J ) ) 00121 10 CONTINUE 00122 B( J ) = 0.D0 00123 R1( J ) = 0.D0 00124 R2( J ) = 0.D0 00125 W( J ) = 0.D0 00126 X( J ) = 0.D0 00127 IP( J ) = J 00128 20 CONTINUE 00129 ANRM = 1.0D0 00130 OK = .TRUE. 00131 * 00132 * Test error exits of the routines that use the diagonal pivoting 00133 * factorization of a Hermitian indefinite matrix. 00134 * 00135 IF( LSAMEN( 2, C2, 'HE' ) ) THEN 00136 * 00137 * ZHETRF 00138 * 00139 SRNAMT = 'ZHETRF' 00140 INFOT = 1 00141 CALL ZHETRF( '/', 0, A, 1, IP, W, 1, INFO ) 00142 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL ZHETRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00145 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 00146 INFOT = 4 00147 CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00148 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 00149 * 00150 * ZHETF2 00151 * 00152 SRNAMT = 'ZHETF2' 00153 INFOT = 1 00154 CALL ZHETF2( '/', 0, A, 1, IP, INFO ) 00155 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 00156 INFOT = 2 00157 CALL ZHETF2( 'U', -1, A, 1, IP, INFO ) 00158 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 00159 INFOT = 4 00160 CALL ZHETF2( 'U', 2, A, 1, IP, INFO ) 00161 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 00162 * 00163 * ZHETRI 00164 * 00165 SRNAMT = 'ZHETRI' 00166 INFOT = 1 00167 CALL ZHETRI( '/', 0, A, 1, IP, W, INFO ) 00168 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 00169 INFOT = 2 00170 CALL ZHETRI( 'U', -1, A, 1, IP, W, INFO ) 00171 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 00172 INFOT = 4 00173 CALL ZHETRI( 'U', 2, A, 1, IP, W, INFO ) 00174 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 00175 * 00176 * ZHETRI2 00177 * 00178 SRNAMT = 'ZHETRI2' 00179 INFOT = 1 00180 CALL ZHETRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00181 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 00182 INFOT = 2 00183 CALL ZHETRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00184 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 00185 INFOT = 4 00186 CALL ZHETRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00187 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 00188 * 00189 * ZHETRS 00190 * 00191 SRNAMT = 'ZHETRS' 00192 INFOT = 1 00193 CALL ZHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00194 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00195 INFOT = 2 00196 CALL ZHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00197 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00198 INFOT = 3 00199 CALL ZHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00200 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00201 INFOT = 5 00202 CALL ZHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00203 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00204 INFOT = 8 00205 CALL ZHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00206 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 00207 * 00208 * ZHERFS 00209 * 00210 SRNAMT = 'ZHERFS' 00211 INFOT = 1 00212 CALL ZHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00213 $ R, INFO ) 00214 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00215 INFOT = 2 00216 CALL ZHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00217 $ W, R, INFO ) 00218 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00219 INFOT = 3 00220 CALL ZHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00221 $ W, R, INFO ) 00222 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00223 INFOT = 5 00224 CALL ZHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00225 $ R, INFO ) 00226 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00227 INFOT = 7 00228 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00229 $ R, INFO ) 00230 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00231 INFOT = 10 00232 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00233 $ R, INFO ) 00234 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00235 INFOT = 12 00236 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00237 $ R, INFO ) 00238 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 00239 * 00240 * ZHECON 00241 * 00242 SRNAMT = 'ZHECON' 00243 INFOT = 1 00244 CALL ZHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00245 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00246 INFOT = 2 00247 CALL ZHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00248 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00249 INFOT = 4 00250 CALL ZHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00251 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00252 INFOT = 6 00253 CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00254 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 00255 * 00256 * Test error exits of the routines that use the diagonal pivoting 00257 * factorization of a Hermitian indefinite packed matrix. 00258 * 00259 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN 00260 * 00261 * ZHPTRF 00262 * 00263 SRNAMT = 'ZHPTRF' 00264 INFOT = 1 00265 CALL ZHPTRF( '/', 0, A, IP, INFO ) 00266 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 00267 INFOT = 2 00268 CALL ZHPTRF( 'U', -1, A, IP, INFO ) 00269 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 00270 * 00271 * ZHPTRI 00272 * 00273 SRNAMT = 'ZHPTRI' 00274 INFOT = 1 00275 CALL ZHPTRI( '/', 0, A, IP, W, INFO ) 00276 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 00277 INFOT = 2 00278 CALL ZHPTRI( 'U', -1, A, IP, W, INFO ) 00279 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 00280 * 00281 * ZHPTRS 00282 * 00283 SRNAMT = 'ZHPTRS' 00284 INFOT = 1 00285 CALL ZHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00286 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00287 INFOT = 2 00288 CALL ZHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00289 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00290 INFOT = 3 00291 CALL ZHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00292 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00293 INFOT = 7 00294 CALL ZHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00295 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 00296 * 00297 * ZHPRFS 00298 * 00299 SRNAMT = 'ZHPRFS' 00300 INFOT = 1 00301 CALL ZHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00302 $ INFO ) 00303 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00304 INFOT = 2 00305 CALL ZHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00306 $ INFO ) 00307 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00308 INFOT = 3 00309 CALL ZHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00310 $ INFO ) 00311 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00312 INFOT = 8 00313 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00314 $ INFO ) 00315 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00316 INFOT = 10 00317 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00318 $ INFO ) 00319 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 00320 * 00321 * ZHPCON 00322 * 00323 SRNAMT = 'ZHPCON' 00324 INFOT = 1 00325 CALL ZHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00326 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00327 INFOT = 2 00328 CALL ZHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00329 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00330 INFOT = 5 00331 CALL ZHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00332 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 00333 END IF 00334 * 00335 * Print a summary line. 00336 * 00337 CALL ALAESM( PATH, OK, NOUT ) 00338 * 00339 RETURN 00340 * 00341 * End of ZERRHE 00342 * 00343 END