![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CERRSYX 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 CERRSY( 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 *> CERRSY tests the error exits for the COMPLEX routines 00025 *> for symmetric indefinite matrices. 00026 *> 00027 *> Note that this file is used only when the XBLAS are available, 00028 *> otherwise cerrsy.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 complex_lin 00057 * 00058 * ===================================================================== 00059 SUBROUTINE CERRSY( 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 REAL ANRM, RCOND, BERR 00082 * .. 00083 * .. Local Arrays .. 00084 INTEGER IP( NMAX ) 00085 REAL R( NMAX ), R1( NMAX ), R2( NMAX ), 00086 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ), 00087 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 00088 COMPLEX 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, CSPCON, CSPRFS, CSPTRF, CSPTRI, 00097 $ CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI, 00098 $ CSYTRI2, CSYTRS, CSYRFSX 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 CMPLX, REAL 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 ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00123 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00124 10 CONTINUE 00125 B( J ) = 0. 00126 R1( J ) = 0. 00127 R2( J ) = 0. 00128 W( J ) = 0. 00129 X( J ) = 0. 00130 S( J ) = 0. 00131 IP( J ) = J 00132 20 CONTINUE 00133 ANRM = 1.0 00134 OK = .TRUE. 00135 * 00136 * Test error exits of the routines that use the diagonal pivoting 00137 * factorization of a symmetric indefinite matrix. 00138 * 00139 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00140 * 00141 * CSYTRF 00142 * 00143 SRNAMT = 'CSYTRF' 00144 INFOT = 1 00145 CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00146 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00147 INFOT = 2 00148 CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00149 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00150 INFOT = 4 00151 CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00152 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00153 * 00154 * CSYTF2 00155 * 00156 SRNAMT = 'CSYTF2' 00157 INFOT = 1 00158 CALL CSYTF2( '/', 0, A, 1, IP, INFO ) 00159 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00160 INFOT = 2 00161 CALL CSYTF2( 'U', -1, A, 1, IP, INFO ) 00162 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00163 INFOT = 4 00164 CALL CSYTF2( 'U', 2, A, 1, IP, INFO ) 00165 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00166 * 00167 * CSYTRI 00168 * 00169 SRNAMT = 'CSYTRI' 00170 INFOT = 1 00171 CALL CSYTRI( '/', 0, A, 1, IP, W, INFO ) 00172 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00173 INFOT = 2 00174 CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00175 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00176 INFOT = 4 00177 CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00178 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00179 * 00180 * CSYTRI2 00181 * 00182 SRNAMT = 'CSYTRI2' 00183 INFOT = 1 00184 CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00185 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00186 INFOT = 2 00187 CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00188 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00189 INFOT = 4 00190 CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00191 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00192 * 00193 * CSYTRS 00194 * 00195 SRNAMT = 'CSYTRS' 00196 INFOT = 1 00197 CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00198 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00199 INFOT = 2 00200 CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00201 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00202 INFOT = 3 00203 CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00204 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00205 INFOT = 5 00206 CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00207 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00208 INFOT = 8 00209 CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00210 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00211 * 00212 * CSYRFS 00213 * 00214 SRNAMT = 'CSYRFS' 00215 INFOT = 1 00216 CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00217 $ R, INFO ) 00218 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00219 INFOT = 2 00220 CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00221 $ W, R, INFO ) 00222 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00223 INFOT = 3 00224 CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00225 $ W, R, INFO ) 00226 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00227 INFOT = 5 00228 CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00229 $ R, INFO ) 00230 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00231 INFOT = 7 00232 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00233 $ R, INFO ) 00234 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00235 INFOT = 10 00236 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00237 $ R, INFO ) 00238 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00239 INFOT = 12 00240 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00241 $ R, INFO ) 00242 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00243 * 00244 * CSYRFSX 00245 * 00246 N_ERR_BNDS = 3 00247 NPARAMS = 0 00248 SRNAMT = 'CSYRFSX' 00249 INFOT = 1 00250 CALL CSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00251 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00252 $ PARAMS, W, R, INFO ) 00253 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00254 INFOT = 2 00255 CALL CSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00256 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00257 $ PARAMS, W, R, INFO ) 00258 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00259 EQ = 'N' 00260 INFOT = 3 00261 CALL CSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 00262 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00263 $ PARAMS, W, R, INFO ) 00264 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00265 INFOT = 4 00266 CALL CSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 00267 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00268 $ PARAMS, W, R, INFO ) 00269 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00270 INFOT = 6 00271 CALL CSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 00272 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00273 $ PARAMS, W, R, INFO ) 00274 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00275 INFOT = 8 00276 CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 00277 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00278 $ PARAMS, W, R, INFO ) 00279 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00280 INFOT = 12 00281 CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 00282 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00283 $ PARAMS, W, R, INFO ) 00284 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00285 INFOT = 14 00286 CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 00287 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 00288 $ PARAMS, W, R, INFO ) 00289 CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK ) 00290 * 00291 * CSYCON 00292 * 00293 SRNAMT = 'CSYCON' 00294 INFOT = 1 00295 CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00296 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00297 INFOT = 2 00298 CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00299 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00300 INFOT = 4 00301 CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00302 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00303 INFOT = 6 00304 CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00305 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00306 * 00307 * Test error exits of the routines that use the diagonal pivoting 00308 * factorization of a symmetric indefinite packed matrix. 00309 * 00310 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00311 * 00312 * CSPTRF 00313 * 00314 SRNAMT = 'CSPTRF' 00315 INFOT = 1 00316 CALL CSPTRF( '/', 0, A, IP, INFO ) 00317 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 00318 INFOT = 2 00319 CALL CSPTRF( 'U', -1, A, IP, INFO ) 00320 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 00321 * 00322 * CSPTRI 00323 * 00324 SRNAMT = 'CSPTRI' 00325 INFOT = 1 00326 CALL CSPTRI( '/', 0, A, IP, W, INFO ) 00327 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 00328 INFOT = 2 00329 CALL CSPTRI( 'U', -1, A, IP, W, INFO ) 00330 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 00331 * 00332 * CSPTRS 00333 * 00334 SRNAMT = 'CSPTRS' 00335 INFOT = 1 00336 CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00337 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00338 INFOT = 2 00339 CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00340 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00341 INFOT = 3 00342 CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00343 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00344 INFOT = 7 00345 CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00346 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00347 * 00348 * CSPRFS 00349 * 00350 SRNAMT = 'CSPRFS' 00351 INFOT = 1 00352 CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00353 $ INFO ) 00354 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00355 INFOT = 2 00356 CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00357 $ INFO ) 00358 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00359 INFOT = 3 00360 CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00361 $ INFO ) 00362 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00363 INFOT = 8 00364 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00365 $ INFO ) 00366 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00367 INFOT = 10 00368 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00369 $ INFO ) 00370 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00371 * 00372 * CSPCON 00373 * 00374 SRNAMT = 'CSPCON' 00375 INFOT = 1 00376 CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00377 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00378 INFOT = 2 00379 CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00380 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00381 INFOT = 5 00382 CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00383 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00384 END IF 00385 * 00386 * Print a summary line. 00387 * 00388 CALL ALAESM( PATH, OK, NOUT ) 00389 * 00390 RETURN 00391 * 00392 * End of CERRSY 00393 * 00394 END