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