|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE DERRGE( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.2.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * April 2009 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * DERRGE tests the error exits for the DOUBLE PRECISION routines 00016 * for general matrices. 00017 * 00018 * Note that this file is used only when the XBLAS are available, 00019 * otherwise derrge.f defines this subroutine. 00020 * 00021 * Arguments 00022 * ========= 00023 * 00024 * PATH (input) CHARACTER*3 00025 * The LAPACK path name for the routines to be tested. 00026 * 00027 * NUNIT (input) INTEGER 00028 * The unit number for output. 00029 * 00030 * ===================================================================== 00031 * 00032 * .. Parameters .. 00033 INTEGER NMAX, LW 00034 PARAMETER ( NMAX = 4, LW = 3*NMAX ) 00035 * .. 00036 * .. Local Scalars .. 00037 CHARACTER EQ 00038 CHARACTER*2 C2 00039 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS 00040 DOUBLE PRECISION ANRM, CCOND, RCOND, BERR 00041 * .. 00042 * .. Local Arrays .. 00043 INTEGER IP( NMAX ), IW( NMAX ) 00044 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00045 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), 00046 $ W( LW ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ), 00047 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 00048 * .. 00049 * .. External Functions .. 00050 LOGICAL LSAMEN 00051 EXTERNAL LSAMEN 00052 * .. 00053 * .. External Subroutines .. 00054 EXTERNAL ALAESM, CHKXER, DGBCON, DGBEQU, DGBRFS, DGBTF2, 00055 $ DGBTRF, DGBTRS, DGECON, DGEEQU, DGERFS, DGETF2, 00056 $ DGETRF, DGETRI, DGETRS, DGEEQUB, DGERFSX, 00057 $ DGBEQUB, DGBRFSX 00058 * .. 00059 * .. Scalars in Common .. 00060 LOGICAL LERR, OK 00061 CHARACTER*32 SRNAMT 00062 INTEGER INFOT, NOUT 00063 * .. 00064 * .. Common blocks .. 00065 COMMON / INFOC / INFOT, NOUT, OK, LERR 00066 COMMON / SRNAMC / SRNAMT 00067 * .. 00068 * .. Intrinsic Functions .. 00069 INTRINSIC DBLE 00070 * .. 00071 * .. Executable Statements .. 00072 * 00073 NOUT = NUNIT 00074 WRITE( NOUT, FMT = * ) 00075 C2 = PATH( 2: 3 ) 00076 * 00077 * Set the variables to innocuous values. 00078 * 00079 DO 20 J = 1, NMAX 00080 DO 10 I = 1, NMAX 00081 A( I, J ) = 1.D0 / DBLE( I+J ) 00082 AF( I, J ) = 1.D0 / DBLE( I+J ) 00083 10 CONTINUE 00084 B( J ) = 0.D0 00085 R1( J ) = 0.D0 00086 R2( J ) = 0.D0 00087 W( J ) = 0.D0 00088 X( J ) = 0.D0 00089 C( J ) = 0.D0 00090 R( J ) = 0.D0 00091 IP( J ) = J 00092 IW( J ) = J 00093 20 CONTINUE 00094 OK = .TRUE. 00095 * 00096 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00097 * 00098 * Test error exits of the routines that use the LU decomposition 00099 * of a general matrix. 00100 * 00101 * DGETRF 00102 * 00103 SRNAMT = 'DGETRF' 00104 INFOT = 1 00105 CALL DGETRF( -1, 0, A, 1, IP, INFO ) 00106 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK ) 00107 INFOT = 2 00108 CALL DGETRF( 0, -1, A, 1, IP, INFO ) 00109 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK ) 00110 INFOT = 4 00111 CALL DGETRF( 2, 1, A, 1, IP, INFO ) 00112 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK ) 00113 * 00114 * DGETF2 00115 * 00116 SRNAMT = 'DGETF2' 00117 INFOT = 1 00118 CALL DGETF2( -1, 0, A, 1, IP, INFO ) 00119 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK ) 00120 INFOT = 2 00121 CALL DGETF2( 0, -1, A, 1, IP, INFO ) 00122 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK ) 00123 INFOT = 4 00124 CALL DGETF2( 2, 1, A, 1, IP, INFO ) 00125 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK ) 00126 * 00127 * DGETRI 00128 * 00129 SRNAMT = 'DGETRI' 00130 INFOT = 1 00131 CALL DGETRI( -1, A, 1, IP, W, LW, INFO ) 00132 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK ) 00133 INFOT = 3 00134 CALL DGETRI( 2, A, 1, IP, W, LW, INFO ) 00135 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK ) 00136 * 00137 * DGETRS 00138 * 00139 SRNAMT = 'DGETRS' 00140 INFOT = 1 00141 CALL DGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00142 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL DGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 00145 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00146 INFOT = 3 00147 CALL DGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 00148 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00149 INFOT = 5 00150 CALL DGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 00151 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00152 INFOT = 8 00153 CALL DGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 00154 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00155 * 00156 * DGERFS 00157 * 00158 SRNAMT = 'DGERFS' 00159 INFOT = 1 00160 CALL DGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00161 $ IW, INFO ) 00162 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00163 INFOT = 2 00164 CALL DGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00165 $ W, IW, INFO ) 00166 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00167 INFOT = 3 00168 CALL DGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00169 $ W, IW, INFO ) 00170 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00171 INFOT = 5 00172 CALL DGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00173 $ IW, INFO ) 00174 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00175 INFOT = 7 00176 CALL DGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00177 $ IW, INFO ) 00178 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00179 INFOT = 10 00180 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00181 $ IW, INFO ) 00182 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00183 INFOT = 12 00184 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00185 $ IW, INFO ) 00186 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00187 * 00188 * DGERFSX 00189 * 00190 N_ERR_BNDS = 3 00191 NPARAMS = 0 00192 SRNAMT = 'DGERFSX' 00193 INFOT = 1 00194 CALL DGERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, R, C, B, 1, X, 00195 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00196 $ NPARAMS, PARAMS, W, IW, INFO ) 00197 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00198 INFOT = 2 00199 EQ = '/' 00200 CALL DGERFSX( 'N', EQ, 2, 1, A, 1, AF, 2, IP, R, C, B, 2, X, 00201 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00202 $ NPARAMS, PARAMS, W, IW, INFO ) 00203 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00204 INFOT = 3 00205 EQ = 'R' 00206 CALL DGERFSX( 'N', EQ, -1, 0, A, 1, AF, 1, IP, R, C, B, 1, X, 00207 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00208 $ NPARAMS, PARAMS, W, IW, INFO ) 00209 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00210 INFOT = 4 00211 CALL DGERFSX( 'N', EQ, 0, -1, A, 1, AF, 1, IP, R, C, B, 1, X, 00212 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00213 $ NPARAMS, PARAMS, W, IW, INFO ) 00214 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00215 INFOT = 6 00216 CALL DGERFSX( 'N', EQ, 2, 1, A, 1, AF, 2, IP, R, C, B, 2, X, 00217 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00218 $ NPARAMS, PARAMS, W, IW, INFO ) 00219 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00220 INFOT = 8 00221 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 1, IP, R, C, B, 2, X, 00222 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00223 $ NPARAMS, PARAMS, W, IW, INFO ) 00224 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00225 INFOT = 13 00226 EQ = 'C' 00227 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 2, IP, R, C, B, 1, X, 00228 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00229 $ NPARAMS, PARAMS, W, IW, INFO ) 00230 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00231 INFOT = 15 00232 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 2, IP, R, C, B, 2, X, 00233 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00234 $ NPARAMS, PARAMS, W, IW, INFO ) 00235 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK ) 00236 * 00237 * DGECON 00238 * 00239 SRNAMT = 'DGECON' 00240 INFOT = 1 00241 CALL DGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00242 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK ) 00243 INFOT = 2 00244 CALL DGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00245 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK ) 00246 INFOT = 4 00247 CALL DGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO ) 00248 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK ) 00249 * 00250 * DGEEQU 00251 * 00252 SRNAMT = 'DGEEQU' 00253 INFOT = 1 00254 CALL DGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00255 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK ) 00256 INFOT = 2 00257 CALL DGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00258 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK ) 00259 INFOT = 4 00260 CALL DGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00261 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK ) 00262 * 00263 * DGEEQUB 00264 * 00265 SRNAMT = 'DGEEQUB' 00266 INFOT = 1 00267 CALL DGEEQUB( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00268 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK ) 00269 INFOT = 2 00270 CALL DGEEQUB( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00271 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK ) 00272 INFOT = 4 00273 CALL DGEEQUB( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00274 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK ) 00275 * 00276 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00277 * 00278 * Test error exits of the routines that use the LU decomposition 00279 * of a general band matrix. 00280 * 00281 * DGBTRF 00282 * 00283 SRNAMT = 'DGBTRF' 00284 INFOT = 1 00285 CALL DGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 00286 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00287 INFOT = 2 00288 CALL DGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 00289 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00290 INFOT = 3 00291 CALL DGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 00292 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00293 INFOT = 4 00294 CALL DGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 00295 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00296 INFOT = 6 00297 CALL DGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 00298 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00299 * 00300 * DGBTF2 00301 * 00302 SRNAMT = 'DGBTF2' 00303 INFOT = 1 00304 CALL DGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 00305 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00306 INFOT = 2 00307 CALL DGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 00308 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00309 INFOT = 3 00310 CALL DGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 00311 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00312 INFOT = 4 00313 CALL DGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 00314 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00315 INFOT = 6 00316 CALL DGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 00317 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00318 * 00319 * DGBTRS 00320 * 00321 SRNAMT = 'DGBTRS' 00322 INFOT = 1 00323 CALL DGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00324 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00325 INFOT = 2 00326 CALL DGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00327 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00328 INFOT = 3 00329 CALL DGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 00330 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00331 INFOT = 4 00332 CALL DGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 00333 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00334 INFOT = 5 00335 CALL DGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 00336 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00337 INFOT = 7 00338 CALL DGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 00339 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00340 INFOT = 10 00341 CALL DGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00342 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00343 * 00344 * DGBRFS 00345 * 00346 SRNAMT = 'DGBRFS' 00347 INFOT = 1 00348 CALL DGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00349 $ R2, W, IW, INFO ) 00350 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00351 INFOT = 2 00352 CALL DGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00353 $ R2, W, IW, INFO ) 00354 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00355 INFOT = 3 00356 CALL DGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00357 $ R2, W, IW, INFO ) 00358 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00359 INFOT = 4 00360 CALL DGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00361 $ R2, W, IW, INFO ) 00362 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00363 INFOT = 5 00364 CALL DGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00365 $ R2, W, IW, INFO ) 00366 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00367 INFOT = 7 00368 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 00369 $ R2, W, IW, INFO ) 00370 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00371 INFOT = 9 00372 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 00373 $ R2, W, IW, INFO ) 00374 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00375 INFOT = 12 00376 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 00377 $ R2, W, IW, INFO ) 00378 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00379 INFOT = 14 00380 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 00381 $ R2, W, IW, INFO ) 00382 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00383 * 00384 * DGBRFSX 00385 * 00386 N_ERR_BNDS = 3 00387 NPARAMS = 0 00388 SRNAMT = 'DGBRFSX' 00389 INFOT = 1 00390 CALL DGBRFSX( '/', EQ, 0, 0, 0, 0, A, 1, AF, 1, IP, R, C, B, 1, 00391 $ X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00392 $ NPARAMS, PARAMS, W, IW, INFO ) 00393 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00394 INFOT = 2 00395 EQ = '/' 00396 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 1, AF, 2, IP, R, C, B, 2, 00397 $ X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00398 $ NPARAMS, PARAMS, W, IW, INFO ) 00399 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00400 INFOT = 3 00401 EQ = 'R' 00402 CALL DGBRFSX( 'N', EQ, -1, 1, 1, 0, A, 1, AF, 1, IP, R, C, B, 00403 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00404 $ NPARAMS, PARAMS, W, IW, INFO ) 00405 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00406 INFOT = 4 00407 EQ = 'R' 00408 CALL DGBRFSX( 'N', EQ, 2, -1, 1, 1, A, 3, AF, 4, IP, R, C, B, 00409 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00410 $ NPARAMS, PARAMS, W, IW, INFO ) 00411 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00412 INFOT = 5 00413 EQ = 'R' 00414 CALL DGBRFSX( 'N', EQ, 2, 1, -1, 1, A, 3, AF, 4, IP, R, C, B, 00415 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00416 $ NPARAMS, PARAMS, W, IW, INFO ) 00417 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00418 INFOT = 6 00419 CALL DGBRFSX( 'N', EQ, 0, 0, 0, -1, A, 1, AF, 1, IP, R, C, B, 00420 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00421 $ NPARAMS, PARAMS, W, IW, INFO ) 00422 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00423 INFOT = 8 00424 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 1, AF, 2, IP, R, C, B, 00425 $ 2, X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00426 $ NPARAMS, PARAMS, W, IW, INFO ) 00427 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00428 INFOT = 10 00429 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 3, IP, R, C, B, 2, 00430 $ X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00431 $ NPARAMS, PARAMS, W, IW, INFO ) 00432 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00433 INFOT = 13 00434 EQ = 'C' 00435 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 5, IP, R, C, B, 00436 $ 1, X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00437 $ NPARAMS, PARAMS, W, IW, INFO ) 00438 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00439 INFOT = 15 00440 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 5, IP, R, C, B, 2, 00441 $ X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, 00442 $ NPARAMS, PARAMS, W, IW, INFO ) 00443 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK ) 00444 * 00445 * DGBCON 00446 * 00447 SRNAMT = 'DGBCON' 00448 INFOT = 1 00449 CALL DGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00450 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00451 INFOT = 2 00452 CALL DGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, 00453 $ INFO ) 00454 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00455 INFOT = 3 00456 CALL DGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW, 00457 $ INFO ) 00458 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00459 INFOT = 4 00460 CALL DGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW, 00461 $ INFO ) 00462 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00463 INFOT = 6 00464 CALL DGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO ) 00465 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00466 * 00467 * DGBEQU 00468 * 00469 SRNAMT = 'DGBEQU' 00470 INFOT = 1 00471 CALL DGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00472 $ INFO ) 00473 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00474 INFOT = 2 00475 CALL DGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00476 $ INFO ) 00477 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00478 INFOT = 3 00479 CALL DGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00480 $ INFO ) 00481 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00482 INFOT = 4 00483 CALL DGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00484 $ INFO ) 00485 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00486 INFOT = 6 00487 CALL DGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00488 $ INFO ) 00489 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00490 * 00491 * DGBEQUB 00492 * 00493 SRNAMT = 'DGBEQUB' 00494 INFOT = 1 00495 CALL DGBEQUB( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00496 $ INFO ) 00497 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK ) 00498 INFOT = 2 00499 CALL DGBEQUB( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00500 $ INFO ) 00501 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK ) 00502 INFOT = 3 00503 CALL DGBEQUB( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00504 $ INFO ) 00505 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK ) 00506 INFOT = 4 00507 CALL DGBEQUB( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00508 $ INFO ) 00509 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK ) 00510 INFOT = 6 00511 CALL DGBEQUB( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00512 $ INFO ) 00513 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK ) 00514 END IF 00515 * 00516 * Print a summary line. 00517 * 00518 CALL ALAESM( PATH, OK, NOUT ) 00519 * 00520 RETURN 00521 * 00522 * End of DERRGE 00523 * 00524 END
1.7.3 
