|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CERRSY( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * CERRSY tests the error exits for the COMPLEX routines 00016 * for symmetric indefinite matrices. 00017 * 00018 * Arguments 00019 * ========= 00020 * 00021 * PATH (input) CHARACTER*3 00022 * The LAPACK path name for the routines to be tested. 00023 * 00024 * NUNIT (input) INTEGER 00025 * The unit number for output. 00026 * 00027 * ===================================================================== 00028 * 00029 * .. Parameters .. 00030 INTEGER NMAX 00031 PARAMETER ( NMAX = 4 ) 00032 * .. 00033 * .. Local Scalars .. 00034 CHARACTER*2 C2 00035 INTEGER I, INFO, J 00036 REAL ANRM, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 00041 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00042 $ W( 2*NMAX ), X( NMAX ) 00043 * .. 00044 * .. External Functions .. 00045 LOGICAL LSAMEN 00046 EXTERNAL LSAMEN 00047 * .. 00048 * .. External Subroutines .. 00049 EXTERNAL ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI, 00050 $ CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI, 00051 $ CSYTRI2, CSYTRS 00052 * .. 00053 * .. Scalars in Common .. 00054 LOGICAL LERR, OK 00055 CHARACTER*32 SRNAMT 00056 INTEGER INFOT, NOUT 00057 * .. 00058 * .. Common blocks .. 00059 COMMON / INFOC / INFOT, NOUT, OK, LERR 00060 COMMON / SRNAMC / SRNAMT 00061 * .. 00062 * .. Intrinsic Functions .. 00063 INTRINSIC CMPLX, REAL 00064 * .. 00065 * .. Executable Statements .. 00066 * 00067 NOUT = NUNIT 00068 WRITE( NOUT, FMT = * ) 00069 C2 = PATH( 2: 3 ) 00070 * 00071 * Set the variables to innocuous values. 00072 * 00073 DO 20 J = 1, NMAX 00074 DO 10 I = 1, NMAX 00075 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00076 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00077 10 CONTINUE 00078 B( J ) = 0. 00079 R1( J ) = 0. 00080 R2( J ) = 0. 00081 W( J ) = 0. 00082 X( J ) = 0. 00083 IP( J ) = J 00084 20 CONTINUE 00085 ANRM = 1.0 00086 OK = .TRUE. 00087 * 00088 * Test error exits of the routines that use the diagonal pivoting 00089 * factorization of a symmetric indefinite matrix. 00090 * 00091 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00092 * 00093 * CSYTRF 00094 * 00095 SRNAMT = 'CSYTRF' 00096 INFOT = 1 00097 CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00098 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00099 INFOT = 2 00100 CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00101 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00102 INFOT = 4 00103 CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00104 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 00105 * 00106 * CSYTF2 00107 * 00108 SRNAMT = 'CSYTF2' 00109 INFOT = 1 00110 CALL CSYTF2( '/', 0, A, 1, IP, INFO ) 00111 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00112 INFOT = 2 00113 CALL CSYTF2( 'U', -1, A, 1, IP, INFO ) 00114 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00115 INFOT = 4 00116 CALL CSYTF2( 'U', 2, A, 1, IP, INFO ) 00117 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 00118 * 00119 * CSYTRI 00120 * 00121 SRNAMT = 'CSYTRI' 00122 INFOT = 1 00123 CALL CSYTRI( '/', 0, A, 1, IP, W, INFO ) 00124 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00125 INFOT = 2 00126 CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00127 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00128 INFOT = 4 00129 CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00130 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 00131 * 00132 * CSYTRI2 00133 * 00134 SRNAMT = 'CSYTRI2' 00135 INFOT = 1 00136 CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00137 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00138 INFOT = 2 00139 CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00140 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00141 INFOT = 4 00142 CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00143 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 00144 * 00145 * CSYTRS 00146 * 00147 SRNAMT = 'CSYTRS' 00148 INFOT = 1 00149 CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00150 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00151 INFOT = 2 00152 CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00153 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00154 INFOT = 3 00155 CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00156 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00157 INFOT = 5 00158 CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00159 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00160 INFOT = 8 00161 CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00162 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 00163 * 00164 * CSYRFS 00165 * 00166 SRNAMT = 'CSYRFS' 00167 INFOT = 1 00168 CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00169 $ R, INFO ) 00170 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00171 INFOT = 2 00172 CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00173 $ W, R, INFO ) 00174 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00175 INFOT = 3 00176 CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00177 $ W, R, INFO ) 00178 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00179 INFOT = 5 00180 CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00181 $ R, INFO ) 00182 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00183 INFOT = 7 00184 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00185 $ R, INFO ) 00186 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00187 INFOT = 10 00188 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00189 $ R, INFO ) 00190 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00191 INFOT = 12 00192 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00193 $ R, INFO ) 00194 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 00195 * 00196 * CSYCON 00197 * 00198 SRNAMT = 'CSYCON' 00199 INFOT = 1 00200 CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00201 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00202 INFOT = 2 00203 CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00204 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00205 INFOT = 4 00206 CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00207 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00208 INFOT = 6 00209 CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00210 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 00211 * 00212 * Test error exits of the routines that use the diagonal pivoting 00213 * factorization of a symmetric indefinite packed matrix. 00214 * 00215 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00216 * 00217 * CSPTRF 00218 * 00219 SRNAMT = 'CSPTRF' 00220 INFOT = 1 00221 CALL CSPTRF( '/', 0, A, IP, INFO ) 00222 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 00223 INFOT = 2 00224 CALL CSPTRF( 'U', -1, A, IP, INFO ) 00225 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 00226 * 00227 * CSPTRI 00228 * 00229 SRNAMT = 'CSPTRI' 00230 INFOT = 1 00231 CALL CSPTRI( '/', 0, A, IP, W, INFO ) 00232 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 00233 INFOT = 2 00234 CALL CSPTRI( 'U', -1, A, IP, W, INFO ) 00235 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 00236 * 00237 * CSPTRS 00238 * 00239 SRNAMT = 'CSPTRS' 00240 INFOT = 1 00241 CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00242 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00243 INFOT = 2 00244 CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00245 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00246 INFOT = 3 00247 CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00248 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00249 INFOT = 7 00250 CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00251 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 00252 * 00253 * CSPRFS 00254 * 00255 SRNAMT = 'CSPRFS' 00256 INFOT = 1 00257 CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00258 $ INFO ) 00259 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00260 INFOT = 2 00261 CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00262 $ INFO ) 00263 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00264 INFOT = 3 00265 CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00266 $ INFO ) 00267 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00268 INFOT = 8 00269 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00270 $ INFO ) 00271 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00272 INFOT = 10 00273 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00274 $ INFO ) 00275 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 00276 * 00277 * CSPCON 00278 * 00279 SRNAMT = 'CSPCON' 00280 INFOT = 1 00281 CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00282 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00283 INFOT = 2 00284 CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00285 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00286 INFOT = 5 00287 CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00288 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 00289 END IF 00290 * 00291 * Print a summary line. 00292 * 00293 CALL ALAESM( PATH, OK, NOUT ) 00294 * 00295 RETURN 00296 * 00297 * End of CERRSY 00298 * 00299 END
1.7.3 
