![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRGE 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE DERRGE( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> DERRGE tests the error exits for the DOUBLE PRECISION routines 00025 *> for general matrices. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup double_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE DERRGE( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX, LW 00072 PARAMETER ( NMAX = 4, LW = 3*NMAX ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, INFO, J 00077 DOUBLE PRECISION ANRM, CCOND, RCOND 00078 * .. 00079 * .. Local Arrays .. 00080 INTEGER IP( NMAX ), IW( NMAX ) 00081 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00082 $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX ) 00083 * .. 00084 * .. External Functions .. 00085 LOGICAL LSAMEN 00086 EXTERNAL LSAMEN 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL ALAESM, CHKXER, DGBCON, DGBEQU, DGBRFS, DGBTF2, 00090 $ DGBTRF, DGBTRS, DGECON, DGEEQU, DGERFS, DGETF2, 00091 $ DGETRF, DGETRI, DGETRS 00092 * .. 00093 * .. Scalars in Common .. 00094 LOGICAL LERR, OK 00095 CHARACTER*32 SRNAMT 00096 INTEGER INFOT, NOUT 00097 * .. 00098 * .. Common blocks .. 00099 COMMON / INFOC / INFOT, NOUT, OK, LERR 00100 COMMON / SRNAMC / SRNAMT 00101 * .. 00102 * .. Intrinsic Functions .. 00103 INTRINSIC DBLE 00104 * .. 00105 * .. Executable Statements .. 00106 * 00107 NOUT = NUNIT 00108 WRITE( NOUT, FMT = * ) 00109 C2 = PATH( 2: 3 ) 00110 * 00111 * Set the variables to innocuous values. 00112 * 00113 DO 20 J = 1, NMAX 00114 DO 10 I = 1, NMAX 00115 A( I, J ) = 1.D0 / DBLE( I+J ) 00116 AF( I, J ) = 1.D0 / DBLE( I+J ) 00117 10 CONTINUE 00118 B( J ) = 0.D0 00119 R1( J ) = 0.D0 00120 R2( J ) = 0.D0 00121 W( J ) = 0.D0 00122 X( J ) = 0.D0 00123 IP( J ) = J 00124 IW( J ) = J 00125 20 CONTINUE 00126 OK = .TRUE. 00127 * 00128 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00129 * 00130 * Test error exits of the routines that use the LU decomposition 00131 * of a general matrix. 00132 * 00133 * DGETRF 00134 * 00135 SRNAMT = 'DGETRF' 00136 INFOT = 1 00137 CALL DGETRF( -1, 0, A, 1, IP, INFO ) 00138 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL DGETRF( 0, -1, A, 1, IP, INFO ) 00141 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK ) 00142 INFOT = 4 00143 CALL DGETRF( 2, 1, A, 1, IP, INFO ) 00144 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK ) 00145 * 00146 * DGETF2 00147 * 00148 SRNAMT = 'DGETF2' 00149 INFOT = 1 00150 CALL DGETF2( -1, 0, A, 1, IP, INFO ) 00151 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK ) 00152 INFOT = 2 00153 CALL DGETF2( 0, -1, A, 1, IP, INFO ) 00154 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK ) 00155 INFOT = 4 00156 CALL DGETF2( 2, 1, A, 1, IP, INFO ) 00157 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK ) 00158 * 00159 * DGETRI 00160 * 00161 SRNAMT = 'DGETRI' 00162 INFOT = 1 00163 CALL DGETRI( -1, A, 1, IP, W, LW, INFO ) 00164 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK ) 00165 INFOT = 3 00166 CALL DGETRI( 2, A, 1, IP, W, LW, INFO ) 00167 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK ) 00168 * 00169 * DGETRS 00170 * 00171 SRNAMT = 'DGETRS' 00172 INFOT = 1 00173 CALL DGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00174 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00175 INFOT = 2 00176 CALL DGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 00177 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00178 INFOT = 3 00179 CALL DGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 00180 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00181 INFOT = 5 00182 CALL DGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 00183 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00184 INFOT = 8 00185 CALL DGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 00186 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK ) 00187 * 00188 * DGERFS 00189 * 00190 SRNAMT = 'DGERFS' 00191 INFOT = 1 00192 CALL DGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00193 $ IW, INFO ) 00194 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00195 INFOT = 2 00196 CALL DGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00197 $ W, IW, INFO ) 00198 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00199 INFOT = 3 00200 CALL DGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00201 $ W, IW, INFO ) 00202 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00203 INFOT = 5 00204 CALL DGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00205 $ IW, INFO ) 00206 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00207 INFOT = 7 00208 CALL DGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00209 $ IW, INFO ) 00210 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00211 INFOT = 10 00212 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00213 $ IW, INFO ) 00214 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00215 INFOT = 12 00216 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00217 $ IW, INFO ) 00218 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK ) 00219 * 00220 * DGECON 00221 * 00222 SRNAMT = 'DGECON' 00223 INFOT = 1 00224 CALL DGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO ) 00225 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK ) 00226 INFOT = 2 00227 CALL DGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO ) 00228 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK ) 00229 INFOT = 4 00230 CALL DGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO ) 00231 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK ) 00232 * 00233 * DGEEQU 00234 * 00235 SRNAMT = 'DGEEQU' 00236 INFOT = 1 00237 CALL DGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00238 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK ) 00239 INFOT = 2 00240 CALL DGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00241 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK ) 00242 INFOT = 4 00243 CALL DGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00244 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK ) 00245 * 00246 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00247 * 00248 * Test error exits of the routines that use the LU decomposition 00249 * of a general band matrix. 00250 * 00251 * DGBTRF 00252 * 00253 SRNAMT = 'DGBTRF' 00254 INFOT = 1 00255 CALL DGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 00256 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00257 INFOT = 2 00258 CALL DGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 00259 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00260 INFOT = 3 00261 CALL DGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 00262 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00263 INFOT = 4 00264 CALL DGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 00265 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00266 INFOT = 6 00267 CALL DGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 00268 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK ) 00269 * 00270 * DGBTF2 00271 * 00272 SRNAMT = 'DGBTF2' 00273 INFOT = 1 00274 CALL DGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 00275 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00276 INFOT = 2 00277 CALL DGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 00278 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00279 INFOT = 3 00280 CALL DGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 00281 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00282 INFOT = 4 00283 CALL DGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 00284 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00285 INFOT = 6 00286 CALL DGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 00287 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK ) 00288 * 00289 * DGBTRS 00290 * 00291 SRNAMT = 'DGBTRS' 00292 INFOT = 1 00293 CALL DGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00294 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00295 INFOT = 2 00296 CALL DGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00297 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00298 INFOT = 3 00299 CALL DGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 00300 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00301 INFOT = 4 00302 CALL DGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 00303 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00304 INFOT = 5 00305 CALL DGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 00306 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00307 INFOT = 7 00308 CALL DGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 00309 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00310 INFOT = 10 00311 CALL DGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00312 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK ) 00313 * 00314 * DGBRFS 00315 * 00316 SRNAMT = 'DGBRFS' 00317 INFOT = 1 00318 CALL DGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00319 $ R2, W, IW, INFO ) 00320 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00321 INFOT = 2 00322 CALL DGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00323 $ R2, W, IW, INFO ) 00324 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00325 INFOT = 3 00326 CALL DGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00327 $ R2, W, IW, INFO ) 00328 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00329 INFOT = 4 00330 CALL DGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00331 $ R2, W, IW, INFO ) 00332 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00333 INFOT = 5 00334 CALL DGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00335 $ R2, W, IW, INFO ) 00336 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00337 INFOT = 7 00338 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 00339 $ R2, W, IW, INFO ) 00340 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00341 INFOT = 9 00342 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 00343 $ R2, W, IW, INFO ) 00344 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00345 INFOT = 12 00346 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 00347 $ R2, W, IW, INFO ) 00348 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00349 INFOT = 14 00350 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 00351 $ R2, W, IW, INFO ) 00352 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK ) 00353 * 00354 * DGBCON 00355 * 00356 SRNAMT = 'DGBCON' 00357 INFOT = 1 00358 CALL DGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO ) 00359 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00360 INFOT = 2 00361 CALL DGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, 00362 $ INFO ) 00363 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00364 INFOT = 3 00365 CALL DGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW, 00366 $ INFO ) 00367 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00368 INFOT = 4 00369 CALL DGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW, 00370 $ INFO ) 00371 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00372 INFOT = 6 00373 CALL DGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO ) 00374 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK ) 00375 * 00376 * DGBEQU 00377 * 00378 SRNAMT = 'DGBEQU' 00379 INFOT = 1 00380 CALL DGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00381 $ INFO ) 00382 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00383 INFOT = 2 00384 CALL DGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00385 $ INFO ) 00386 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00387 INFOT = 3 00388 CALL DGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00389 $ INFO ) 00390 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00391 INFOT = 4 00392 CALL DGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00393 $ INFO ) 00394 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00395 INFOT = 6 00396 CALL DGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00397 $ INFO ) 00398 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK ) 00399 END IF 00400 * 00401 * Print a summary line. 00402 * 00403 CALL ALAESM( PATH, OK, NOUT ) 00404 * 00405 RETURN 00406 * 00407 * End of DERRGE 00408 * 00409 END