![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERRSYX 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 ZERRSY( 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 *> ZERRSY tests the error exits for the COMPLEX*16 routines 00025 *> for symmetric indefinite matrices. 00026 *> 00027 *> Note that this file is used only when the XBLAS are available, 00028 *> otherwise zerrsy.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 ZERRSY( 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 * .. Parameters .. 00074 INTEGER NMAX 00075 PARAMETER ( NMAX = 4 ) 00076 * .. 00077 * .. Local Scalars .. 00078 CHARACTER EQ 00079 CHARACTER*2 C2 00080 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS 00081 DOUBLE PRECISION ANRM, RCOND, BERR 00082 * .. 00083 * .. Local Arrays .. 00084 INTEGER IP( NMAX ) 00085 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ), 00086 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ), 00087 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 00088 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00089 $ W( 2*NMAX ), X( NMAX ) 00090 * .. 00091 * .. External Functions .. 00092 LOGICAL LSAMEN 00093 EXTERNAL LSAMEN 00094 * .. 00095 * .. External Subroutines .. 00096 EXTERNAL ALAESM, CHKXER, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI, 00097 $ ZSPTRS, ZSYCON, ZSYRFS, ZSYTF2, ZSYTRF, ZSYTRI, 00098 $ ZSYTRI2, ZSYTRS, ZSYRFSX 00099 * .. 00100 * .. Scalars in Common .. 00101 LOGICAL LERR, OK 00102 CHARACTER*32 SRNAMT 00103 INTEGER INFOT, NOUT 00104 * .. 00105 * .. Common blocks .. 00106 COMMON / INFOC / INFOT, NOUT, OK, LERR 00107 COMMON / SRNAMC / SRNAMT 00108 * .. 00109 * .. Intrinsic Functions .. 00110 INTRINSIC DBLE, DCMPLX 00111 * .. 00112 * .. Executable Statements .. 00113 * 00114 NOUT = NUNIT 00115 WRITE( NOUT, FMT = * ) 00116 C2 = PATH( 2: 3 ) 00117 * 00118 * Set the variables to innocuous values. 00119 * 00120 DO 20 J = 1, NMAX 00121 DO 10 I = 1, NMAX 00122 A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00123 $ -1.D0 / DBLE( I+J ) ) 00124 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00125 $ -1.D0 / DBLE( I+J ) ) 00126 10 CONTINUE 00127 B( J ) = 0.D0 00128 R1( J ) = 0.D0 00129 R2( J ) = 0.D0 00130 W( J ) = 0.D0 00131 X( J ) = 0.D0 00132 S( J ) = 0.D0 00133 IP( J ) = J 00134 20 CONTINUE 00135 ANRM = 1.0D0 00136 OK = .TRUE. 00137 * 00138 * Test error exits of the routines that use the diagonal pivoting 00139 * factorization of a symmetric indefinite matrix. 00140 * 00141 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00142 * 00143 * ZSYTRF 00144 * 00145 SRNAMT = 'ZSYTRF' 00146 INFOT = 1 00147 CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00148 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00149 INFOT = 2 00150 CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00151 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00152 INFOT = 4 00153 CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00154 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00155 * 00156 * ZSYTF2 00157 * 00158 SRNAMT = 'ZSYTF2' 00159 INFOT = 1 00160 CALL ZSYTF2( '/', 0, A, 1, IP, INFO ) 00161 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00162 INFOT = 2 00163 CALL ZSYTF2( 'U', -1, A, 1, IP, INFO ) 00164 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00165 INFOT = 4 00166 CALL ZSYTF2( 'U', 2, A, 1, IP, INFO ) 00167 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00168 * 00169 * ZSYTRI 00170 * 00171 SRNAMT = 'ZSYTRI' 00172 INFOT = 1 00173 CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO ) 00174 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00175 INFOT = 2 00176 CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00177 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00178 INFOT = 4 00179 CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00180 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00181 * 00182 * ZSYTRI2 00183 * 00184 SRNAMT = 'ZSYTRI2' 00185 INFOT = 1 00186 CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00187 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00188 INFOT = 2 00189 CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00190 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00191 INFOT = 4 00192 CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00193 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00194 * 00195 * ZSYTRS 00196 * 00197 SRNAMT = 'ZSYTRS' 00198 INFOT = 1 00199 CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00200 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00201 INFOT = 2 00202 CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00203 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00204 INFOT = 3 00205 CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00206 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00207 INFOT = 5 00208 CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00209 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00210 INFOT = 8 00211 CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00212 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00213 * 00214 * ZSYRFS 00215 * 00216 SRNAMT = 'ZSYRFS' 00217 INFOT = 1 00218 CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00219 $ R, INFO ) 00220 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00221 INFOT = 2 00222 CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00223 $ W, R, INFO ) 00224 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00225 INFOT = 3 00226 CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00227 $ W, R, INFO ) 00228 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00229 INFOT = 5 00230 CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00231 $ R, INFO ) 00232 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00233 INFOT = 7 00234 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00235 $ R, INFO ) 00236 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00237 INFOT = 10 00238 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00239 $ R, INFO ) 00240 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00241 INFOT = 12 00242 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00243 $ R, INFO ) 00244 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00245 * 00246 * ZSYRFSX 00247 * 00248 N_ERR_BNDS = 3 00249 NPARAMS = 0 00250 SRNAMT = 'ZSYRFSX' 00251 INFOT = 1 00252 CALL ZSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00253 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00254 $ PARAMS, W, R, INFO ) 00255 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00256 INFOT = 2 00257 CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00258 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00259 $ PARAMS, W, R, INFO ) 00260 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00261 EQ = 'N' 00262 INFOT = 3 00263 CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00264 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00265 $ PARAMS, W, R, INFO ) 00266 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00267 INFOT = 4 00268 CALL ZSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 00269 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00270 $ PARAMS, W, R, INFO ) 00271 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00272 INFOT = 6 00273 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 00274 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00275 $ PARAMS, W, R, INFO ) 00276 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00277 INFOT = 8 00278 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 00279 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00280 $ PARAMS, W, R, INFO ) 00281 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00282 INFOT = 12 00283 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 00284 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00285 $ PARAMS, W, R, INFO ) 00286 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00287 INFOT = 14 00288 CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 00289 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00290 $ PARAMS, W, R, INFO ) 00291 CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK ) 00292 * 00293 * ZSYCON 00294 * 00295 SRNAMT = 'ZSYCON' 00296 INFOT = 1 00297 CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00298 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00299 INFOT = 2 00300 CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00301 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00302 INFOT = 4 00303 CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00304 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00305 INFOT = 6 00306 CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00307 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00308 * 00309 * Test error exits of the routines that use the diagonal pivoting 00310 * factorization of a symmetric indefinite packed matrix. 00311 * 00312 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00313 * 00314 * ZSPTRF 00315 * 00316 SRNAMT = 'ZSPTRF' 00317 INFOT = 1 00318 CALL ZSPTRF( '/', 0, A, IP, INFO ) 00319 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00320 INFOT = 2 00321 CALL ZSPTRF( 'U', -1, A, IP, INFO ) 00322 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00323 * 00324 * ZSPTRI 00325 * 00326 SRNAMT = 'ZSPTRI' 00327 INFOT = 1 00328 CALL ZSPTRI( '/', 0, A, IP, W, INFO ) 00329 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00330 INFOT = 2 00331 CALL ZSPTRI( 'U', -1, A, IP, W, INFO ) 00332 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00333 * 00334 * ZSPTRS 00335 * 00336 SRNAMT = 'ZSPTRS' 00337 INFOT = 1 00338 CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00339 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00340 INFOT = 2 00341 CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00342 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00343 INFOT = 3 00344 CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00345 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00346 INFOT = 7 00347 CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00348 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00349 * 00350 * ZSPRFS 00351 * 00352 SRNAMT = 'ZSPRFS' 00353 INFOT = 1 00354 CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00355 $ INFO ) 00356 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00357 INFOT = 2 00358 CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00359 $ INFO ) 00360 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00361 INFOT = 3 00362 CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00363 $ INFO ) 00364 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00365 INFOT = 8 00366 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00367 $ INFO ) 00368 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00369 INFOT = 10 00370 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00371 $ INFO ) 00372 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00373 * 00374 * ZSPCON 00375 * 00376 SRNAMT = 'ZSPCON' 00377 INFOT = 1 00378 CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00379 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00380 INFOT = 2 00381 CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00382 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00383 INFOT = 5 00384 CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00385 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00386 END IF 00387 * 00388 * Print a summary line. 00389 * 00390 CALL ALAESM( PATH, OK, NOUT ) 00391 * 00392 RETURN 00393 * 00394 * End of ZERRSY 00395 * 00396 END