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