LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
derred.f
Go to the documentation of this file.
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
 All Files Functions