![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CERRSY 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 *> \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 April 2012 00052 * 00053 *> \ingroup complex_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE CERRSY( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.1) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * April 2012 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX 00072 PARAMETER ( NMAX = 4 ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, INFO, J 00077 REAL ANRM, RCOND 00078 * .. 00079 * .. Local Arrays .. 00080 INTEGER IP( NMAX ) 00081 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 00082 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00083 $ W( 2*NMAX ), X( NMAX ) 00084 * .. 00085 * .. External Functions .. 00086 LOGICAL LSAMEN 00087 EXTERNAL LSAMEN 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI, 00091 $ CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI, 00092 $ CSYTRI2, CSYTRS 00093 * .. 00094 * .. Scalars in Common .. 00095 LOGICAL LERR, OK 00096 CHARACTER*32 SRNAMT 00097 INTEGER INFOT, NOUT 00098 * .. 00099 * .. Common blocks .. 00100 COMMON / INFOC / INFOT, NOUT, OK, LERR 00101 COMMON / SRNAMC / SRNAMT 00102 * .. 00103 * .. Intrinsic Functions .. 00104 INTRINSIC CMPLX, REAL 00105 * .. 00106 * .. Executable Statements .. 00107 * 00108 NOUT = NUNIT 00109 WRITE( NOUT, FMT = * ) 00110 C2 = PATH( 2: 3 ) 00111 * 00112 * Set the variables to innocuous values. 00113 * 00114 DO 20 J = 1, NMAX 00115 DO 10 I = 1, NMAX 00116 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00117 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00118 10 CONTINUE 00119 B( J ) = 0. 00120 R1( J ) = 0. 00121 R2( J ) = 0. 00122 W( J ) = 0. 00123 X( J ) = 0. 00124 IP( J ) = J 00125 20 CONTINUE 00126 ANRM = 1.0 00127 OK = .TRUE. 00128 * 00129 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00130 * 00131 * Test error exits of the routines that use factorization 00132 * of a symmetric indefinite matrix with patrial 00133 * (Bunch-Kaufman) pivoting. 00134 * 00135 * CSYTRF 00136 * 00137 SRNAMT = 'CSYTRF' 00138 INFOT = 1 00139 CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00140 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00143 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00144 INFOT = 4 00145 CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00146 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00147 * 00148 * CSYTF2 00149 * 00150 SRNAMT = 'CSYTF2' 00151 INFOT = 1 00152 CALL CSYTF2( '/', 0, A, 1, IP, INFO ) 00153 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00154 INFOT = 2 00155 CALL CSYTF2( 'U', -1, A, 1, IP, INFO ) 00156 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00157 INFOT = 4 00158 CALL CSYTF2( 'U', 2, A, 1, IP, INFO ) 00159 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00160 * 00161 * CSYTRI 00162 * 00163 SRNAMT = 'CSYTRI' 00164 INFOT = 1 00165 CALL CSYTRI( '/', 0, A, 1, IP, W, INFO ) 00166 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00167 INFOT = 2 00168 CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00169 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00170 INFOT = 4 00171 CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00172 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00173 * 00174 * CSYTRI2 00175 * 00176 SRNAMT = 'CSYTRI2' 00177 INFOT = 1 00178 CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00179 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00180 INFOT = 2 00181 CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00182 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00183 INFOT = 4 00184 CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00185 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00186 * 00187 * CSYTRS 00188 * 00189 SRNAMT = 'CSYTRS' 00190 INFOT = 1 00191 CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00192 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00193 INFOT = 2 00194 CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00195 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00196 INFOT = 3 00197 CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00198 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00199 INFOT = 5 00200 CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00201 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00202 INFOT = 8 00203 CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00204 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00205 * 00206 * CSYRFS 00207 * 00208 SRNAMT = 'CSYRFS' 00209 INFOT = 1 00210 CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00211 $ R, INFO ) 00212 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00213 INFOT = 2 00214 CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00215 $ W, R, INFO ) 00216 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00217 INFOT = 3 00218 CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00219 $ W, R, INFO ) 00220 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00221 INFOT = 5 00222 CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00223 $ R, INFO ) 00224 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00225 INFOT = 7 00226 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00227 $ R, INFO ) 00228 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00229 INFOT = 10 00230 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00231 $ R, INFO ) 00232 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00233 INFOT = 12 00234 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00235 $ R, INFO ) 00236 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00237 * 00238 * CSYCON 00239 * 00240 SRNAMT = 'CSYCON' 00241 INFOT = 1 00242 CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00243 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00244 INFOT = 2 00245 CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00246 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00247 INFOT = 4 00248 CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00249 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00250 INFOT = 6 00251 CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00252 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00253 * 00254 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00255 * 00256 * Test error exits of the routines that use factorization 00257 * of a symmetric indefinite packed matrix with patrial 00258 * (Bunch-Kaufman) pivoting. 00259 * 00260 * CSPTRF 00261 * 00262 SRNAMT = 'CSPTRF' 00263 INFOT = 1 00264 CALL CSPTRF( '/', 0, A, IP, INFO ) 00265 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 00266 INFOT = 2 00267 CALL CSPTRF( 'U', -1, A, IP, INFO ) 00268 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 00269 * 00270 * CSPTRI 00271 * 00272 SRNAMT = 'CSPTRI' 00273 INFOT = 1 00274 CALL CSPTRI( '/', 0, A, IP, W, INFO ) 00275 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 00276 INFOT = 2 00277 CALL CSPTRI( 'U', -1, A, IP, W, INFO ) 00278 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 00279 * 00280 * CSPTRS 00281 * 00282 SRNAMT = 'CSPTRS' 00283 INFOT = 1 00284 CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00285 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00286 INFOT = 2 00287 CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00288 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00289 INFOT = 3 00290 CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00291 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00292 INFOT = 7 00293 CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00294 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00295 * 00296 * CSPRFS 00297 * 00298 SRNAMT = 'CSPRFS' 00299 INFOT = 1 00300 CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00301 $ INFO ) 00302 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00303 INFOT = 2 00304 CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00305 $ INFO ) 00306 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00307 INFOT = 3 00308 CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00309 $ INFO ) 00310 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00311 INFOT = 8 00312 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00313 $ INFO ) 00314 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00315 INFOT = 10 00316 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00317 $ INFO ) 00318 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00319 * 00320 * CSPCON 00321 * 00322 SRNAMT = 'CSPCON' 00323 INFOT = 1 00324 CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00325 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00326 INFOT = 2 00327 CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00328 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00329 INFOT = 5 00330 CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00331 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00332 END IF 00333 * 00334 * Print a summary line. 00335 * 00336 CALL ALAESM( PATH, OK, NOUT ) 00337 * 00338 RETURN 00339 * 00340 * End of CERRSY 00341 * 00342 END