|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRSY( 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 * ZERRSY tests the error exits for the COMPLEX*16 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 DOUBLE PRECISION ANRM, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) 00041 COMPLEX*16 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, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI, 00050 $ ZSPTRS, ZSYCON, ZSYRFS, ZSYTF2, ZSYTRF, ZSYTRI, 00051 $ ZSYTRI2, ZSYTRS 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 DBLE, DCMPLX 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 ) = DCMPLX( 1.D0 / DBLE( I+J ), 00076 $ -1.D0 / DBLE( I+J ) ) 00077 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00078 $ -1.D0 / DBLE( I+J ) ) 00079 10 CONTINUE 00080 B( J ) = 0.D0 00081 R1( J ) = 0.D0 00082 R2( J ) = 0.D0 00083 W( J ) = 0.D0 00084 X( J ) = 0.D0 00085 IP( J ) = J 00086 20 CONTINUE 00087 ANRM = 1.0D0 00088 OK = .TRUE. 00089 * 00090 * Test error exits of the routines that use the diagonal pivoting 00091 * factorization of a symmetric indefinite matrix. 00092 * 00093 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00094 * 00095 * ZSYTRF 00096 * 00097 SRNAMT = 'ZSYTRF' 00098 INFOT = 1 00099 CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00100 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00101 INFOT = 2 00102 CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00103 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00104 INFOT = 4 00105 CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00106 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00107 * 00108 * ZSYTF2 00109 * 00110 SRNAMT = 'ZSYTF2' 00111 INFOT = 1 00112 CALL ZSYTF2( '/', 0, A, 1, IP, INFO ) 00113 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00114 INFOT = 2 00115 CALL ZSYTF2( 'U', -1, A, 1, IP, INFO ) 00116 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00117 INFOT = 4 00118 CALL ZSYTF2( 'U', 2, A, 1, IP, INFO ) 00119 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00120 * 00121 * ZSYTRI 00122 * 00123 SRNAMT = 'ZSYTRI' 00124 INFOT = 1 00125 CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO ) 00126 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00127 INFOT = 2 00128 CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00129 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00130 INFOT = 4 00131 CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00132 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00133 * 00134 * ZSYTRI2 00135 * 00136 SRNAMT = 'ZSYTRI2' 00137 INFOT = 1 00138 CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00139 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00140 INFOT = 2 00141 CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00142 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00143 INFOT = 4 00144 CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00145 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00146 * 00147 * ZSYTRS 00148 * 00149 SRNAMT = 'ZSYTRS' 00150 INFOT = 1 00151 CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00152 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00153 INFOT = 2 00154 CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00155 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00156 INFOT = 3 00157 CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00158 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00159 INFOT = 5 00160 CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00161 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00162 INFOT = 8 00163 CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00164 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00165 * 00166 * ZSYRFS 00167 * 00168 SRNAMT = 'ZSYRFS' 00169 INFOT = 1 00170 CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00171 $ R, INFO ) 00172 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00173 INFOT = 2 00174 CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00175 $ W, R, INFO ) 00176 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00177 INFOT = 3 00178 CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00179 $ W, R, INFO ) 00180 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00181 INFOT = 5 00182 CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00183 $ R, INFO ) 00184 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00185 INFOT = 7 00186 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00187 $ R, INFO ) 00188 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00189 INFOT = 10 00190 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00191 $ R, INFO ) 00192 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00193 INFOT = 12 00194 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00195 $ R, INFO ) 00196 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00197 * 00198 * ZSYCON 00199 * 00200 SRNAMT = 'ZSYCON' 00201 INFOT = 1 00202 CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00203 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00204 INFOT = 2 00205 CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00206 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00207 INFOT = 4 00208 CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00209 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00210 INFOT = 6 00211 CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00212 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00213 * 00214 * Test error exits of the routines that use the diagonal pivoting 00215 * factorization of a symmetric indefinite packed matrix. 00216 * 00217 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00218 * 00219 * ZSPTRF 00220 * 00221 SRNAMT = 'ZSPTRF' 00222 INFOT = 1 00223 CALL ZSPTRF( '/', 0, A, IP, INFO ) 00224 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00225 INFOT = 2 00226 CALL ZSPTRF( 'U', -1, A, IP, INFO ) 00227 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00228 * 00229 * ZSPTRI 00230 * 00231 SRNAMT = 'ZSPTRI' 00232 INFOT = 1 00233 CALL ZSPTRI( '/', 0, A, IP, W, INFO ) 00234 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00235 INFOT = 2 00236 CALL ZSPTRI( 'U', -1, A, IP, W, INFO ) 00237 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00238 * 00239 * ZSPTRS 00240 * 00241 SRNAMT = 'ZSPTRS' 00242 INFOT = 1 00243 CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00244 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00245 INFOT = 2 00246 CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00247 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00248 INFOT = 3 00249 CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00250 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00251 INFOT = 7 00252 CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00253 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00254 * 00255 * ZSPRFS 00256 * 00257 SRNAMT = 'ZSPRFS' 00258 INFOT = 1 00259 CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00260 $ INFO ) 00261 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00262 INFOT = 2 00263 CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00264 $ INFO ) 00265 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00266 INFOT = 3 00267 CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00268 $ INFO ) 00269 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00270 INFOT = 8 00271 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00272 $ INFO ) 00273 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00274 INFOT = 10 00275 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00276 $ INFO ) 00277 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00278 * 00279 * ZSPCON 00280 * 00281 SRNAMT = 'ZSPCON' 00282 INFOT = 1 00283 CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00284 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00285 INFOT = 2 00286 CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00287 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00288 INFOT = 5 00289 CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00290 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00291 END IF 00292 * 00293 * Print a summary line. 00294 * 00295 CALL ALAESM( PATH, OK, NOUT ) 00296 * 00297 RETURN 00298 * 00299 * End of ZERRSY 00300 * 00301 END
1.7.3 
