 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DERRSY( 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 * DERRSY tests the error exits for the DOUBLE PRECISION 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 ), IW( NMAX ) 00040 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00041 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ) 00042 * .. 00043 * .. External Functions .. 00044 LOGICAL LSAMEN 00045 EXTERNAL LSAMEN 00046 * .. 00047 * .. External Subroutines .. 00048 EXTERNAL ALAESM, CHKXER, DSPCON, DSPRFS, DSPTRF, DSPTRI, 00049 $ DSPTRS, DSYCON, DSYRFS, DSYTF2, DSYTRF, DSYTRI, 00050 $ DSYTRI2, DSYTRS 00051 * .. 00052 * .. Scalars in Common .. 00053 LOGICAL LERR, OK 00054 CHARACTER*32 SRNAMT 00055 INTEGER INFOT, NOUT 00056 * .. 00057 * .. Common blocks .. 00058 COMMON / INFOC / INFOT, NOUT, OK, LERR 00059 COMMON / SRNAMC / SRNAMT 00060 * .. 00061 * .. Intrinsic Functions .. 00062 INTRINSIC DBLE 00063 * .. 00064 * .. Executable Statements .. 00065 * 00066 NOUT = NUNIT 00067 WRITE( NOUT, FMT = * ) 00068 C2 = PATH( 2: 3 ) 00069 * 00070 * Set the variables to innocuous values. 00071 * 00072 DO 20 J = 1, NMAX 00073 DO 10 I = 1, NMAX 00074 A( I, J ) = 1.D0 / DBLE( I+J ) 00075 AF( I, J ) = 1.D0 / DBLE( I+J ) 00076 10 CONTINUE 00077 B( J ) = 0.D0 00078 R1( J ) = 0.D0 00079 R2( J ) = 0.D0 00080 W( J ) = 0.D0 00081 X( J ) = 0.D0 00082 IP( J ) = J 00083 IW( J ) = J 00084 20 CONTINUE 00085 ANRM = 1.0D0 00086 RCOND = 1.0D0 00087 OK = .TRUE. 00088 * 00089 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00090 * 00091 * Test error exits of the routines that use the Bunch-Kaufman 00092 * factorization of a symmetric indefinite matrix. 00093 * 00094 * DSYTRF 00095 * 00096 SRNAMT = 'DSYTRF' 00097 INFOT = 1 00098 CALL DSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00099 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK ) 00100 INFOT = 2 00101 CALL DSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00102 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK ) 00103 INFOT = 4 00104 CALL DSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00105 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK ) 00106 * 00107 * DSYTF2 00108 * 00109 SRNAMT = 'DSYTF2' 00110 INFOT = 1 00111 CALL DSYTF2( '/', 0, A, 1, IP, INFO ) 00112 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK ) 00113 INFOT = 2 00114 CALL DSYTF2( 'U', -1, A, 1, IP, INFO ) 00115 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK ) 00116 INFOT = 4 00117 CALL DSYTF2( 'U', 2, A, 1, IP, INFO ) 00118 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK ) 00119 * 00120 * DSYTRI 00121 * 00122 SRNAMT = 'DSYTRI' 00123 INFOT = 1 00124 CALL DSYTRI( '/', 0, A, 1, IP, W, INFO ) 00125 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK ) 00126 INFOT = 2 00127 CALL DSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00128 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK ) 00129 INFOT = 4 00130 CALL DSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00131 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK ) 00132 * 00133 * DSYTRI2 00134 * 00135 SRNAMT = 'DSYTRI2' 00136 INFOT = 1 00137 CALL DSYTRI2( '/', 0, A, 1, IP, W, IW, INFO ) 00138 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO ) 00141 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK ) 00142 INFOT = 4 00143 CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO ) 00144 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK ) 00145 * 00146 * DSYTRS 00147 * 00148 SRNAMT = 'DSYTRS' 00149 INFOT = 1 00150 CALL DSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00151 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK ) 00152 INFOT = 2 00153 CALL DSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00154 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK ) 00155 INFOT = 3 00156 CALL DSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00157 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK ) 00158 INFOT = 5 00159 CALL DSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00160 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK ) 00161 INFOT = 8 00162 CALL DSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00163 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK ) 00164 * 00165 * DSYRFS 00166 * 00167 SRNAMT = 'DSYRFS' 00168 INFOT = 1 00169 CALL DSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00170 $ IW, INFO ) 00171 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00172 INFOT = 2 00173 CALL DSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00174 $ W, IW, INFO ) 00175 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00176 INFOT = 3 00177 CALL DSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00178 $ W, IW, INFO ) 00179 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00180 INFOT = 5 00181 CALL DSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00182 $ IW, INFO ) 00183 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00184 INFOT = 7 00185 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00186 $ IW, INFO ) 00187 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00188 INFOT = 10 00189 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00190 $ IW, INFO ) 00191 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00192 INFOT = 12 00193 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00194 $ IW, INFO ) 00195 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK ) 00196 * 00197 * DSYCON 00198 * 00199 SRNAMT = 'DSYCON' 00200 INFOT = 1 00201 CALL DSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00202 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK ) 00203 INFOT = 2 00204 CALL DSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00205 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK ) 00206 INFOT = 4 00207 CALL DSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00208 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK ) 00209 INFOT = 6 00210 CALL DSYCON( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO ) 00211 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK ) 00212 * 00213 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00214 * 00215 * Test error exits of the routines that use the Bunch-Kaufman 00216 * factorization of a symmetric indefinite packed matrix. 00217 * 00218 * DSPTRF 00219 * 00220 SRNAMT = 'DSPTRF' 00221 INFOT = 1 00222 CALL DSPTRF( '/', 0, A, IP, INFO ) 00223 CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK ) 00224 INFOT = 2 00225 CALL DSPTRF( 'U', -1, A, IP, INFO ) 00226 CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK ) 00227 * 00228 * DSPTRI 00229 * 00230 SRNAMT = 'DSPTRI' 00231 INFOT = 1 00232 CALL DSPTRI( '/', 0, A, IP, W, INFO ) 00233 CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK ) 00234 INFOT = 2 00235 CALL DSPTRI( 'U', -1, A, IP, W, INFO ) 00236 CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK ) 00237 * 00238 * DSPTRS 00239 * 00240 SRNAMT = 'DSPTRS' 00241 INFOT = 1 00242 CALL DSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00243 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK ) 00244 INFOT = 2 00245 CALL DSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00246 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK ) 00247 INFOT = 3 00248 CALL DSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00249 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK ) 00250 INFOT = 7 00251 CALL DSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00252 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK ) 00253 * 00254 * DSPRFS 00255 * 00256 SRNAMT = 'DSPRFS' 00257 INFOT = 1 00258 CALL DSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW, 00259 $ INFO ) 00260 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK ) 00261 INFOT = 2 00262 CALL DSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW, 00263 $ INFO ) 00264 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK ) 00265 INFOT = 3 00266 CALL DSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW, 00267 $ INFO ) 00268 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK ) 00269 INFOT = 8 00270 CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW, 00271 $ INFO ) 00272 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK ) 00273 INFOT = 10 00274 CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW, 00275 $ INFO ) 00276 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK ) 00277 * 00278 * DSPCON 00279 * 00280 SRNAMT = 'DSPCON' 00281 INFOT = 1 00282 CALL DSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO ) 00283 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK ) 00284 INFOT = 2 00285 CALL DSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO ) 00286 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK ) 00287 INFOT = 5 00288 CALL DSPCON( 'U', 1, A, IP, -1.0D0, RCOND, W, IW, INFO ) 00289 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK ) 00290 END IF 00291 * 00292 * Print a summary line. 00293 * 00294 CALL ALAESM( PATH, OK, NOUT ) 00295 * 00296 RETURN 00297 * 00298 * End of DERRSY 00299 * 00300 END
1.7.3 
