TESTING/LIN/dchkab.f

   1 *> \brief \b DCHKAB
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       PROGRAM DCHKAB
  12 *
  13 *
  14 *> \par Purpose:
  15 *  =============
  16 *>
  17 *> \verbatim
  18 *>
  19 *> DCHKAB is the test program for the DOUBLE PRECISION LAPACK
  20 *> DSGESV/DSPOSV routine
  21 *>
  22 *> The program must be driven by a short data file. The first 5 records
  23 *> specify problem dimensions and program options using list-directed
  24 *> input. The remaining lines specify the LAPACK test paths and the
  25 *> number of matrix types to use in testing.  An annotated example of a
  26 *> data file can be obtained by deleting the first 3 characters from the
  27 *> following 10 lines:
  28 *> Data file for testing DOUBLE PRECISION LAPACK DSGESV
  29 *> 7                      Number of values of M
  30 *> 0 1 2 3 5 10 16        Values of M (row dimension)
  31 *> 1                      Number of values of NRHS
  32 *> 2                      Values of NRHS (number of right hand sides)
  33 *> 20.0                   Threshold value of test ratio
  34 *> T                      Put T to test the LAPACK routines
  35 *> T                      Put T to test the error exits
  36 *> DGE    11              List types on next line if 0 < NTYPES < 11
  37 *> DPO    9               List types on next line if 0 < NTYPES <  9
  38 *> \endverbatim
  39 *
  40 *  Arguments:
  41 *  ==========
  42 *
  43 *> \verbatim
  44 *>  NMAX    INTEGER
  45 *>          The maximum allowable value for N
  46 *>
  47 *>  MAXIN   INTEGER
  48 *>          The number of different values that can be used for each of
  49 *>          M, N, NRHS, NB, and NX
  50 *>
  51 *>  MAXRHS  INTEGER
  52 *>          The maximum number of right hand sides
  53 *>
  54 *>  NIN     INTEGER
  55 *>          The unit number for input
  56 *>
  57 *>  NOUT    INTEGER
  58 *>          The unit number for output
  59 *> \endverbatim
  60 *
  61 *  Authors:
  62 *  ========
  63 *
  64 *> \author Univ. of Tennessee
  65 *> \author Univ. of California Berkeley
  66 *> \author Univ. of Colorado Denver
  67 *> \author NAG Ltd.
  68 *
  69 *> \date April 2012
  70 *
  71 *> \ingroup double_lin
  72 *
  73 *  =====================================================================
  74       PROGRAM DCHKAB
  75 *
  76 *  -- LAPACK test routine (version 3.4.1) --
  77 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  78 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  79 *     April 2012
  80 *
  81 *  =====================================================================
  82 *
  83 *     .. Parameters ..
  84       INTEGER            NMAX
  85       PARAMETER          ( NMAX = 132 )
  86       INTEGER            MAXIN
  87       PARAMETER          ( MAXIN = 12 )
  88       INTEGER            MAXRHS
  89       PARAMETER          ( MAXRHS = 16 )
  90       INTEGER            MATMAX
  91       PARAMETER          ( MATMAX = 30 )
  92       INTEGER            NIN, NOUT
  93       PARAMETER          ( NIN = 5, NOUT = 6 )
  94       INTEGER            LDAMAX
  95       PARAMETER          ( LDAMAX = NMAX )
  96 *     ..
  97 *     .. Local Scalars ..
  98       LOGICAL            FATAL, TSTDRV, TSTERR
  99       CHARACTER          C1
 100       CHARACTER*2        C2
 101       CHARACTER*3        PATH
 102       CHARACTER*10       INTSTR
 103       CHARACTER*72       ALINE
 104       INTEGER            I, IC, K, LDA, NM, NMATS,
 105      $                   NNS, NRHS, NTYPES,
 106      $                   VERS_MAJOR, VERS_MINOR, VERS_PATCH
 107       DOUBLE PRECISION   EPS, S1, S2, THRESH
 108       REAL               SEPS
 109 *     ..
 110 *     .. Local Arrays ..
 111       LOGICAL            DOTYPE( MATMAX )
 112       INTEGER            IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN )
 113       DOUBLE PRECISION   A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
 114      $                   RWORK( NMAX ), WORK( NMAX*MAXRHS*2 )
 115       REAL               SWORK(NMAX*(NMAX+MAXRHS))
 116 *     ..
 117 *     .. External Functions ..
 118       DOUBLE PRECISION   DLAMCH, DSECND
 119       LOGICAL            LSAME, LSAMEN
 120       REAL               SLAMCH
 121       EXTERNAL           LSAME, LSAMEN, DLAMCH, DSECND, SLAMCH
 122 *     ..
 123 *     .. External Subroutines ..
 124       EXTERNAL           ALAREQ, DDRVAB, DDRVAC, DERRAB, DERRAC,
 125      $                   ILAVER
 126 *     ..
 127 *     .. Scalars in Common ..
 128       LOGICAL            LERR, OK
 129       CHARACTER*32       SRNAMT
 130       INTEGER            INFOT, NUNIT
 131 *     ..
 132 *     .. Common blocks ..
 133       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
 134       COMMON             / SRNAMC / SRNAMT
 135 *     ..
 136 *     .. Data statements ..
 137       DATA               INTSTR / '0123456789' /
 138 *     ..
 139 *     .. Executable Statements ..
 140 *
 141       S1 = DSECND( )
 142       LDA = NMAX
 143       FATAL = .FALSE.
 144 *
 145 *     Read a dummy line.
 146 *
 147       READ( NIN, FMT = * )
 148 *
 149 *     Report values of parameters.
 150 *
 151       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
 152       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
 153 *
 154 *     Read the values of M
 155 *
 156       READ( NIN, FMT = * )NM
 157       IF( NM.LT.1 ) THEN
 158          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
 159          NM = 0
 160          FATAL = .TRUE.
 161       ELSE IF( NM.GT.MAXIN ) THEN
 162          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
 163          NM = 0
 164          FATAL = .TRUE.
 165       END IF
 166       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
 167       DO 10 I = 1, NM
 168          IF( MVAL( I ).LT.0 ) THEN
 169             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
 170             FATAL = .TRUE.
 171          ELSE IF( MVAL( I ).GT.NMAX ) THEN
 172             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
 173             FATAL = .TRUE.
 174          END IF
 175    10 CONTINUE
 176       IF( NM.GT.0 )
 177      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
 178 *
 179 *     Read the values of NRHS
 180 *
 181       READ( NIN, FMT = * )NNS
 182       IF( NNS.LT.1 ) THEN
 183          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
 184          NNS = 0
 185          FATAL = .TRUE.
 186       ELSE IF( NNS.GT.MAXIN ) THEN
 187          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
 188          NNS = 0
 189          FATAL = .TRUE.
 190       END IF
 191       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
 192       DO 30 I = 1, NNS
 193          IF( NSVAL( I ).LT.0 ) THEN
 194             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
 195             FATAL = .TRUE.
 196          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
 197             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
 198             FATAL = .TRUE.
 199          END IF
 200    30 CONTINUE
 201       IF( NNS.GT.0 )
 202      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
 203 *
 204 *     Read the threshold value for the test ratios.
 205 *
 206       READ( NIN, FMT = * )THRESH
 207       WRITE( NOUT, FMT = 9992 )THRESH
 208 *
 209 *     Read the flag that indicates whether to test the driver routine.
 210 *
 211       READ( NIN, FMT = * )TSTDRV
 212 *
 213 *     Read the flag that indicates whether to test the error exits.
 214 *
 215       READ( NIN, FMT = * )TSTERR
 216 *
 217       IF( FATAL ) THEN
 218          WRITE( NOUT, FMT = 9999 )
 219          STOP
 220       END IF
 221 *
 222 *     Calculate and print the machine dependent constants.
 223 *
 224       SEPS = SLAMCH( 'Underflow threshold' )
 225       WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
 226       SEPS = SLAMCH( 'Overflow threshold' )
 227       WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
 228       SEPS = SLAMCH( 'Epsilon' )
 229       WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
 230       WRITE( NOUT, FMT = * )
 231 *
 232       EPS = DLAMCH( 'Underflow threshold' )
 233       WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
 234       EPS = DLAMCH( 'Overflow threshold' )
 235       WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
 236       EPS = DLAMCH( 'Epsilon' )
 237       WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
 238       WRITE( NOUT, FMT = * )
 239 *
 240    80 CONTINUE
 241 *
 242 *     Read a test path and the number of matrix types to use.
 243 *
 244       READ( NIN, FMT = '(A72)', END = 140 )ALINE
 245       PATH = ALINE( 1: 3 )
 246       NMATS = MATMAX
 247       I = 3
 248    90 CONTINUE
 249       I = I + 1
 250       IF( I.GT.72 ) THEN
 251          NMATS = MATMAX
 252          GO TO 130
 253       END IF
 254       IF( ALINE( I: I ).EQ.' ' )
 255      $   GO TO 90
 256       NMATS = 0
 257   100 CONTINUE
 258       C1 = ALINE( I: I )
 259       DO 110 K = 1, 10
 260          IF( C1.EQ.INTSTR( K: K ) ) THEN
 261             IC = K - 1
 262             GO TO 120
 263          END IF
 264   110 CONTINUE
 265       GO TO 130
 266   120 CONTINUE
 267       NMATS = NMATS*10 + IC
 268       I = I + 1
 269       IF( I.GT.72 )
 270      $   GO TO 130
 271       GO TO 100
 272   130 CONTINUE
 273       C1 = PATH( 1: 1 )
 274       C2 = PATH( 2: 3 )
 275       NRHS = NSVAL( 1 )
 276 *
 277 *     Check first character for correct precision.
 278 *
 279       IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN
 280          WRITE( NOUT, FMT = 9990 )PATH
 281
 282 *
 283       ELSE IF( NMATS.LE.0 ) THEN
 284 *
 285 *        Check for a positive number of tests requested.
 286 *
 287          WRITE( NOUT, FMT = 9989 )PATH
 288          GO TO 140
 289 *
 290       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
 291 *
 292 *        GE:  general matrices
 293 *
 294          NTYPES = 11
 295          CALL ALAREQ( 'DGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
 296 *
 297 *        Test the error exits
 298 *
 299          IF( TSTERR )
 300      $      CALL DERRAB( NOUT )
 301 *
 302          IF( TSTDRV ) THEN
 303             CALL DDRVAB( DOTYPE, NM, MVAL, NNS,
 304      $                   NSVAL, THRESH, LDA, A( 1, 1 ),
 305      $                   A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
 306      $                   WORK, RWORK, SWORK, IWORK, NOUT )
 307          ELSE
 308             WRITE( NOUT, FMT = 9989 )'DSGESV'
 309          END IF
 310 *
 311       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
 312 *
 313 *        PO:  positive definite matrices
 314 *
 315          NTYPES = 9
 316          CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
 317 *
 318 *
 319          IF( TSTERR )
 320      $      CALL DERRAC( NOUT )
 321 *
 322 *
 323          IF( TSTDRV ) THEN
 324             CALL DDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL,
 325      $                   THRESH, LDA, A( 1, 1 ), A( 1, 2 ),
 326      $                   B( 1, 1 ), B( 1, 2 ),
 327      $                   WORK, RWORK, SWORK, NOUT )
 328          ELSE
 329             WRITE( NOUT, FMT = 9989 )PATH
 330          END IF
 331       ELSE
 332 *
 333       END IF
 334 *
 335 *     Go back to get another input line.
 336 *
 337       GO TO 80
 338 *
 339 *     Branch to this line when the last record is read.
 340 *
 341   140 CONTINUE
 342       CLOSE ( NIN )
 343       S2 = DSECND( )
 344       WRITE( NOUT, FMT = 9998 )
 345       WRITE( NOUT, FMT = 9997 )S2 - S1
 346 *
 347  9999 FORMAT( / ' Execution not attempted due to input errors' )
 348  9998 FORMAT( / ' End of tests' )
 349  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
 350  9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
 351      $      I6 )
 352  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
 353      $      I6 )
 354  9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV',
 355      $  ' routines ',
 356      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
 357      $      / / ' The following parameter values will be used:' )
 358  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
 359  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
 360      $      'less than', F8.2, / )
 361  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
 362  9990 FORMAT( / 1X, A6, ' routines were not tested' )
 363  9989 FORMAT( / 1X, A6, ' driver routines were not tested' )
 364 *
 365 *     End of DCHKAB
 366 *
 367       END