![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRED 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 DERRED( 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 *> DERRED tests the error exits for the eigenvalue driver routines for 00025 *> DOUBLE PRECISION matrices: 00026 *> 00027 *> PATH driver description 00028 *> ---- ------ ----------- 00029 *> SEV DGEEV find eigenvalues/eigenvectors for nonsymmetric A 00030 *> SES DGEES find eigenvalues/Schur form for nonsymmetric A 00031 *> SVX DGEEVX SGEEV + balancing and condition estimation 00032 *> SSX DGEESX SGEES + balancing and condition estimation 00033 *> DBD DGESVD compute SVD of an M-by-N matrix A 00034 *> DGESDD compute SVD of an M-by-N matrix A (by divide and 00035 *> conquer) 00036 *> DGEJSV compute SVD of an M-by-N matrix A where M >= N 00037 *> \endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 *> \param[in] PATH 00043 *> \verbatim 00044 *> PATH is CHARACTER*3 00045 *> The LAPACK path name for the routines to be tested. 00046 *> \endverbatim 00047 *> 00048 *> \param[in] NUNIT 00049 *> \verbatim 00050 *> NUNIT is INTEGER 00051 *> The unit number for output. 00052 *> \endverbatim 00053 * 00054 * Authors: 00055 * ======== 00056 * 00057 *> \author Univ. of Tennessee 00058 *> \author Univ. of California Berkeley 00059 *> \author Univ. of Colorado Denver 00060 *> \author NAG Ltd. 00061 * 00062 *> \date November 2011 00063 * 00064 *> \ingroup double_eig 00065 * 00066 * ===================================================================== 00067 SUBROUTINE DERRED( PATH, NUNIT ) 00068 * 00069 * -- LAPACK test routine (version 3.4.0) -- 00070 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00071 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00072 * November 2011 00073 * 00074 * .. Scalar Arguments .. 00075 CHARACTER*3 PATH 00076 INTEGER NUNIT 00077 * .. 00078 * 00079 * ===================================================================== 00080 * 00081 * .. Parameters .. 00082 INTEGER NMAX 00083 DOUBLE PRECISION ONE, ZERO 00084 PARAMETER ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 ) 00085 * .. 00086 * .. Local Scalars .. 00087 CHARACTER*2 C2 00088 INTEGER I, IHI, ILO, INFO, J, NT, SDIM 00089 DOUBLE PRECISION ABNRM 00090 * .. 00091 * .. Local Arrays .. 00092 LOGICAL B( NMAX ) 00093 INTEGER IW( 2*NMAX ) 00094 DOUBLE PRECISION A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), 00095 $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ), 00096 $ VR( NMAX, NMAX ), VT( NMAX, NMAX ), 00097 $ W( 4*NMAX ), WI( NMAX ), WR( NMAX ) 00098 * .. 00099 * .. External Subroutines .. 00100 EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV, 00101 $ DGESDD, DGESVD 00102 * .. 00103 * .. External Functions .. 00104 LOGICAL DSLECT, LSAMEN 00105 EXTERNAL DSLECT, LSAMEN 00106 * .. 00107 * .. Intrinsic Functions .. 00108 INTRINSIC LEN_TRIM 00109 * .. 00110 * .. Arrays in Common .. 00111 LOGICAL SELVAL( 20 ) 00112 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 ) 00113 * .. 00114 * .. Scalars in Common .. 00115 LOGICAL LERR, OK 00116 CHARACTER*32 SRNAMT 00117 INTEGER INFOT, NOUT, SELDIM, SELOPT 00118 * .. 00119 * .. Common blocks .. 00120 COMMON / INFOC / INFOT, NOUT, OK, LERR 00121 COMMON / SRNAMC / SRNAMT 00122 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 00123 * .. 00124 * .. Executable Statements .. 00125 * 00126 NOUT = NUNIT 00127 WRITE( NOUT, FMT = * ) 00128 C2 = PATH( 2: 3 ) 00129 * 00130 * Initialize A 00131 * 00132 DO 20 J = 1, NMAX 00133 DO 10 I = 1, NMAX 00134 A( I, J ) = ZERO 00135 10 CONTINUE 00136 20 CONTINUE 00137 DO 30 I = 1, NMAX 00138 A( I, I ) = ONE 00139 30 CONTINUE 00140 OK = .TRUE. 00141 NT = 0 00142 * 00143 IF( LSAMEN( 2, C2, 'EV' ) ) THEN 00144 * 00145 * Test DGEEV 00146 * 00147 SRNAMT = 'DGEEV ' 00148 INFOT = 1 00149 CALL DGEEV( 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 00150 $ INFO ) 00151 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00152 INFOT = 2 00153 CALL DGEEV( 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 00154 $ INFO ) 00155 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00156 INFOT = 3 00157 CALL DGEEV( 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 00158 $ INFO ) 00159 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00160 INFOT = 5 00161 CALL DGEEV( 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, W, 6, 00162 $ INFO ) 00163 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00164 INFOT = 9 00165 CALL DGEEV( 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8, 00166 $ INFO ) 00167 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00168 INFOT = 11 00169 CALL DGEEV( 'N', 'V', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8, 00170 $ INFO ) 00171 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00172 INFOT = 13 00173 CALL DGEEV( 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, W, 3, 00174 $ INFO ) 00175 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 00176 NT = NT + 7 00177 * 00178 ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN 00179 * 00180 * Test DGEES 00181 * 00182 SRNAMT = 'DGEES ' 00183 INFOT = 1 00184 CALL DGEES( 'X', 'N', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W, 00185 $ 1, B, INFO ) 00186 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 00187 INFOT = 2 00188 CALL DGEES( 'N', 'X', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W, 00189 $ 1, B, INFO ) 00190 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 00191 INFOT = 4 00192 CALL DGEES( 'N', 'S', DSLECT, -1, A, 1, SDIM, WR, WI, VL, 1, W, 00193 $ 1, B, INFO ) 00194 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 00195 INFOT = 6 00196 CALL DGEES( 'N', 'S', DSLECT, 2, A, 1, SDIM, WR, WI, VL, 1, W, 00197 $ 6, B, INFO ) 00198 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 00199 INFOT = 11 00200 CALL DGEES( 'V', 'S', DSLECT, 2, A, 2, SDIM, WR, WI, VL, 1, W, 00201 $ 6, B, INFO ) 00202 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 00203 INFOT = 13 00204 CALL DGEES( 'N', 'S', DSLECT, 1, A, 1, SDIM, WR, WI, VL, 1, W, 00205 $ 2, B, INFO ) 00206 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 00207 NT = NT + 6 00208 * 00209 ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN 00210 * 00211 * Test DGEEVX 00212 * 00213 SRNAMT = 'DGEEVX' 00214 INFOT = 1 00215 CALL DGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 00216 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00217 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00218 INFOT = 2 00219 CALL DGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 00220 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00221 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00222 INFOT = 3 00223 CALL DGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 00224 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00225 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00226 INFOT = 4 00227 CALL DGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, 00228 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00229 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00230 INFOT = 5 00231 CALL DGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 00232 $ 1, ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00233 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00234 INFOT = 7 00235 CALL DGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, 00236 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00237 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00238 INFOT = 11 00239 CALL DGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, 00240 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO ) 00241 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00242 INFOT = 13 00243 CALL DGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, 00244 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO ) 00245 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00246 INFOT = 21 00247 CALL DGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1, 00248 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 00249 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00250 INFOT = 21 00251 CALL DGEEVX( 'N', 'V', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1, 00252 $ ILO, IHI, S, ABNRM, R1, R2, W, 2, IW, INFO ) 00253 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00254 INFOT = 21 00255 CALL DGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, 00256 $ ILO, IHI, S, ABNRM, R1, R2, W, 3, IW, INFO ) 00257 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 00258 NT = NT + 11 00259 * 00260 ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN 00261 * 00262 * Test DGEESX 00263 * 00264 SRNAMT = 'DGEESX' 00265 INFOT = 1 00266 CALL DGEESX( 'X', 'N', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL, 00267 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 00268 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00269 INFOT = 2 00270 CALL DGEESX( 'N', 'X', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL, 00271 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 00272 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00273 INFOT = 4 00274 CALL DGEESX( 'N', 'N', DSLECT, 'X', 0, A, 1, SDIM, WR, WI, VL, 00275 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 00276 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00277 INFOT = 5 00278 CALL DGEESX( 'N', 'N', DSLECT, 'N', -1, A, 1, SDIM, WR, WI, VL, 00279 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 00280 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00281 INFOT = 7 00282 CALL DGEESX( 'N', 'N', DSLECT, 'N', 2, A, 1, SDIM, WR, WI, VL, 00283 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO ) 00284 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00285 INFOT = 12 00286 CALL DGEESX( 'V', 'N', DSLECT, 'N', 2, A, 2, SDIM, WR, WI, VL, 00287 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO ) 00288 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00289 INFOT = 16 00290 CALL DGEESX( 'N', 'N', DSLECT, 'N', 1, A, 1, SDIM, WR, WI, VL, 00291 $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO ) 00292 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 00293 NT = NT + 7 00294 * 00295 ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN 00296 * 00297 * Test DGESVD 00298 * 00299 SRNAMT = 'DGESVD' 00300 INFOT = 1 00301 CALL DGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 00302 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00303 INFOT = 2 00304 CALL DGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 00305 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00306 INFOT = 2 00307 CALL DGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 00308 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00309 INFOT = 3 00310 CALL DGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, 00311 $ INFO ) 00312 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00313 INFOT = 4 00314 CALL DGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, 00315 $ INFO ) 00316 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00317 INFOT = 6 00318 CALL DGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, INFO ) 00319 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00320 INFOT = 9 00321 CALL DGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, INFO ) 00322 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00323 INFOT = 11 00324 CALL DGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, INFO ) 00325 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 00326 NT = 8 00327 IF( OK ) THEN 00328 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00329 $ NT 00330 ELSE 00331 WRITE( NOUT, FMT = 9998 ) 00332 END IF 00333 * 00334 * Test DGESDD 00335 * 00336 SRNAMT = 'DGESDD' 00337 INFOT = 1 00338 CALL DGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 00339 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 00340 INFOT = 2 00341 CALL DGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 00342 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 00343 INFOT = 3 00344 CALL DGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 00345 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 00346 INFOT = 5 00347 CALL DGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO ) 00348 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 00349 INFOT = 8 00350 CALL DGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, IW, INFO ) 00351 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 00352 INFOT = 10 00353 CALL DGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO ) 00354 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 00355 NT = 6 00356 IF( OK ) THEN 00357 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00358 $ NT 00359 ELSE 00360 WRITE( NOUT, FMT = 9998 ) 00361 END IF 00362 * 00363 * Test DGEJSV 00364 * 00365 SRNAMT = 'DGEJSV' 00366 INFOT = 1 00367 CALL DGEJSV( 'X', 'U', 'V', 'R', 'N', 'N', 00368 $ 0, 0, A, 1, S, U, 1, VT, 1, 00369 $ W, 1, IW, INFO) 00370 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00371 INFOT = 2 00372 CALL DGEJSV( 'G', 'X', 'V', 'R', 'N', 'N', 00373 $ 0, 0, A, 1, S, U, 1, VT, 1, 00374 $ W, 1, IW, INFO) 00375 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00376 INFOT = 3 00377 CALL DGEJSV( 'G', 'U', 'X', 'R', 'N', 'N', 00378 $ 0, 0, A, 1, S, U, 1, VT, 1, 00379 $ W, 1, IW, INFO) 00380 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00381 INFOT = 4 00382 CALL DGEJSV( 'G', 'U', 'V', 'X', 'N', 'N', 00383 $ 0, 0, A, 1, S, U, 1, VT, 1, 00384 $ W, 1, IW, INFO) 00385 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00386 INFOT = 5 00387 CALL DGEJSV( 'G', 'U', 'V', 'R', 'X', 'N', 00388 $ 0, 0, A, 1, S, U, 1, VT, 1, 00389 $ W, 1, IW, INFO) 00390 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00391 INFOT = 6 00392 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'X', 00393 $ 0, 0, A, 1, S, U, 1, VT, 1, 00394 $ W, 1, IW, INFO) 00395 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00396 INFOT = 7 00397 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 00398 $ -1, 0, A, 1, S, U, 1, VT, 1, 00399 $ W, 1, IW, INFO) 00400 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00401 INFOT = 8 00402 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 00403 $ 0, -1, A, 1, S, U, 1, VT, 1, 00404 $ W, 1, IW, INFO) 00405 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00406 INFOT = 10 00407 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 00408 $ 2, 1, A, 1, S, U, 1, VT, 1, 00409 $ W, 1, IW, INFO) 00410 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00411 INFOT = 13 00412 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 00413 $ 2, 2, A, 2, S, U, 1, VT, 2, 00414 $ W, 1, IW, INFO) 00415 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00416 INFOT = 14 00417 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 00418 $ 2, 2, A, 2, S, U, 2, VT, 1, 00419 $ W, 1, IW, INFO) 00420 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 00421 NT = 11 00422 IF( OK ) THEN 00423 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00424 $ NT 00425 ELSE 00426 WRITE( NOUT, FMT = 9998 ) 00427 END IF 00428 END IF 00429 * 00430 * Print a summary line. 00431 * 00432 IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN 00433 IF( OK ) THEN 00434 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00435 $ NT 00436 ELSE 00437 WRITE( NOUT, FMT = 9998 ) 00438 END IF 00439 END IF 00440 * 00441 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3, 00442 $ ' tests done)' ) 00443 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' ) 00444 RETURN 00445 * 00446 * End of DERRED 00447 END