|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SERRGE( 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 * SERRGE tests the error exits for the REAL routines 00016 * for general 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, LW 00031 PARAMETER ( NMAX = 4, LW = 3*NMAX ) 00032 * .. 00033 * .. Local Scalars .. 00034 CHARACTER*2 C2 00035 INTEGER I, INFO, J 00036 REAL ANRM, CCOND, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ), IW( NMAX ) 00040 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00041 $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX ) 00042 * .. 00043 * .. External Functions .. 00044 LOGICAL LSAMEN 00045 EXTERNAL LSAMEN 00046 * .. 00047 * .. External Subroutines .. 00048 EXTERNAL ALAESM, CHKXER, SGBCON, SGBEQU, SGBRFS, SGBTF2, 00049 $ SGBTRF, SGBTRS, SGECON, SGEEQU, SGERFS, SGETF2, 00050 $ SGETRF, SGETRI, SGETRS 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 REAL 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. / REAL( I+J ) 00075 AF( I, J ) = 1. / REAL( I+J ) 00076 10 CONTINUE 00077 B( J ) = 0. 00078 R1( J ) = 0. 00079 R2( J ) = 0. 00080 W( J ) = 0. 00081 X( J ) = 0. 00082 IP( J ) = J 00083 IW( J ) = J 00084 20 CONTINUE 00085 OK = .TRUE. 00086 * 00087 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00088 * 00089 * Test error exits of the routines that use the LU decomposition 00090 * of a general matrix. 00091 * 00092 * SGETRF 00093 * 00094 SRNAMT = 'SGETRF' 00095 INFOT = 1 00096 CALL SGETRF( -1, 0, A, 1, IP, INFO ) 00097 CALL CHKXER( 'SGETRF', INFOT, NOUT, LERR, OK ) 00098 INFOT = 2 00099 CALL SGETRF( 0, -1, A, 1, IP, INFO ) 00100 CALL CHKXER( 'SGETRF', INFOT, NOUT, LERR, OK ) 00101 INFOT = 4 00102 CALL SGETRF( 2, 1, A, 1, IP, INFO ) 00103 CALL CHKXER( 'SGETRF', INFOT, NOUT, LERR, OK ) 00104 * 00105 * SGETF2 00106 * 00107 SRNAMT = 'SGETF2' 00108 INFOT = 1 00109 CALL SGETF2( -1, 0, A, 1, IP, INFO ) 00110 CALL CHKXER( 'SGETF2', INFOT, NOUT, LERR, OK ) 00111 INFOT = 2 00112 CALL SGETF2( 0, -1, A, 1, IP, INFO ) 00113 CALL CHKXER( 'SGETF2', INFOT, NOUT, LERR, OK ) 00114 INFOT = 4 00115 CALL SGETF2( 2, 1, A, 1, IP, INFO ) 00116 CALL CHKXER( 'SGETF2', INFOT, NOUT, LERR, OK ) 00117 * 00118 * SGETRI 00119 * 00120 SRNAMT = 'SGETRI' 00121 INFOT = 1 00122 CALL SGETRI( -1, A, 1, IP, W, LW, INFO ) 00123 CALL CHKXER( 'SGETRI', INFOT, NOUT, LERR, OK ) 00124 INFOT = 3 00125 CALL SGETRI( 2, A, 1, IP, W, LW, INFO ) 00126 CALL CHKXER( 'SGETRI', INFOT, NOUT, LERR, OK ) 00127 * 00128 * SGETRS 00129 * 00130 SRNAMT = 'SGETRS' 00131 INFOT = 1 00132 CALL SGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00133 CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK ) 00134 INFOT = 2 00135 CALL SGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 00136 CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK ) 00137 INFOT = 3 00138 CALL SGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 00139 CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK ) 00140 INFOT = 5 00141 CALL SGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 00142 CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK ) 00143 INFOT = 8 00144 CALL SGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 00145 CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK ) 00146 * 00147 * SGERFS 00148 * 00149 SRNAMT = 'SGERFS' 00150 INFOT = 1 00151 CALL SGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00152 $ IW, INFO ) 00153 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00154 INFOT = 2 00155 CALL SGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00156 $ W, IW, INFO ) 00157 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00158 INFOT = 3 00159 CALL SGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00160 $ W, IW, INFO ) 00161 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00162 INFOT = 5 00163 CALL SGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00164 $ IW, INFO ) 00165 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00166 INFOT = 7 00167 CALL SGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00168 $ IW, INFO ) 00169 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00170 INFOT = 10 00171 CALL SGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00172 $ IW, INFO ) 00173 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00174 INFOT = 12 00175 CALL SGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00176 $ IW, INFO ) 00177 CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK ) 00178 * 00179 * SGECON 00180 * 00181 SRNAMT = 'SGECON' 00182 INFOT = 1 00183 CALL SGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00184 CALL CHKXER( 'SGECON', INFOT, NOUT, LERR, OK ) 00185 INFOT = 2 00186 CALL SGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00187 CALL CHKXER( 'SGECON', INFOT, NOUT, LERR, OK ) 00188 INFOT = 4 00189 CALL SGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO ) 00190 CALL CHKXER( 'SGECON', INFOT, NOUT, LERR, OK ) 00191 * 00192 * SGEEQU 00193 * 00194 SRNAMT = 'SGEEQU' 00195 INFOT = 1 00196 CALL SGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00197 CALL CHKXER( 'SGEEQU', INFOT, NOUT, LERR, OK ) 00198 INFOT = 2 00199 CALL SGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00200 CALL CHKXER( 'SGEEQU', INFOT, NOUT, LERR, OK ) 00201 INFOT = 4 00202 CALL SGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00203 CALL CHKXER( 'SGEEQU', INFOT, NOUT, LERR, OK ) 00204 * 00205 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00206 * 00207 * Test error exits of the routines that use the LU decomposition 00208 * of a general band matrix. 00209 * 00210 * SGBTRF 00211 * 00212 SRNAMT = 'SGBTRF' 00213 INFOT = 1 00214 CALL SGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 00215 CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK ) 00216 INFOT = 2 00217 CALL SGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 00218 CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK ) 00219 INFOT = 3 00220 CALL SGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 00221 CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK ) 00222 INFOT = 4 00223 CALL SGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 00224 CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK ) 00225 INFOT = 6 00226 CALL SGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 00227 CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK ) 00228 * 00229 * SGBTF2 00230 * 00231 SRNAMT = 'SGBTF2' 00232 INFOT = 1 00233 CALL SGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 00234 CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK ) 00235 INFOT = 2 00236 CALL SGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 00237 CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK ) 00238 INFOT = 3 00239 CALL SGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 00240 CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK ) 00241 INFOT = 4 00242 CALL SGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 00243 CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK ) 00244 INFOT = 6 00245 CALL SGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 00246 CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK ) 00247 * 00248 * SGBTRS 00249 * 00250 SRNAMT = 'SGBTRS' 00251 INFOT = 1 00252 CALL SGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00253 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00254 INFOT = 2 00255 CALL SGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00256 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00257 INFOT = 3 00258 CALL SGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 00259 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00260 INFOT = 4 00261 CALL SGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 00262 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00263 INFOT = 5 00264 CALL SGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 00265 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00266 INFOT = 7 00267 CALL SGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 00268 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00269 INFOT = 10 00270 CALL SGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00271 CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK ) 00272 * 00273 * SGBRFS 00274 * 00275 SRNAMT = 'SGBRFS' 00276 INFOT = 1 00277 CALL SGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00278 $ R2, W, IW, INFO ) 00279 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00280 INFOT = 2 00281 CALL SGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00282 $ R2, W, IW, INFO ) 00283 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00284 INFOT = 3 00285 CALL SGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00286 $ R2, W, IW, INFO ) 00287 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00288 INFOT = 4 00289 CALL SGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00290 $ R2, W, IW, INFO ) 00291 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00292 INFOT = 5 00293 CALL SGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00294 $ R2, W, IW, INFO ) 00295 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00296 INFOT = 7 00297 CALL SGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 00298 $ R2, W, IW, INFO ) 00299 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00300 INFOT = 9 00301 CALL SGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 00302 $ R2, W, IW, INFO ) 00303 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00304 INFOT = 12 00305 CALL SGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 00306 $ R2, W, IW, INFO ) 00307 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00308 INFOT = 14 00309 CALL SGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 00310 $ R2, W, IW, INFO ) 00311 CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK ) 00312 * 00313 * SGBCON 00314 * 00315 SRNAMT = 'SGBCON' 00316 INFOT = 1 00317 CALL SGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00318 CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK ) 00319 INFOT = 2 00320 CALL SGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, 00321 $ INFO ) 00322 CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK ) 00323 INFOT = 3 00324 CALL SGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW, 00325 $ INFO ) 00326 CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK ) 00327 INFOT = 4 00328 CALL SGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW, 00329 $ INFO ) 00330 CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK ) 00331 INFOT = 6 00332 CALL SGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO ) 00333 CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK ) 00334 * 00335 * SGBEQU 00336 * 00337 SRNAMT = 'SGBEQU' 00338 INFOT = 1 00339 CALL SGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00340 $ INFO ) 00341 CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK ) 00342 INFOT = 2 00343 CALL SGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00344 $ INFO ) 00345 CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK ) 00346 INFOT = 3 00347 CALL SGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00348 $ INFO ) 00349 CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK ) 00350 INFOT = 4 00351 CALL SGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00352 $ INFO ) 00353 CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK ) 00354 INFOT = 6 00355 CALL SGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00356 $ INFO ) 00357 CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK ) 00358 END IF 00359 * 00360 * Print a summary line. 00361 * 00362 CALL ALAESM( PATH, OK, NOUT ) 00363 * 00364 RETURN 00365 * 00366 * End of SERRGE 00367 * 00368 END
1.7.3 
