LAPACK: TESTING/LIN/dchkab.f Source File

Go to the documentation of this file.
00001       PROGRAM DCHKAB
00002       IMPLICIT NONE
00003 *
00004 *  -- LAPACK test routine (version 3.2.1) --
00005 *
00006 *  -- April 2009                                                   --
00007 *
00008 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00009 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00010 *
00011 *  Purpose
00012 *  =======
00013 *
00014 *  DCHKAB is the test program for the DOUBLE PRECISION LAPACK
00015 *  DSGESV/DSPOSV routine
00016 *
00017 *  The program must be driven by a short data file. The first 5 records
00018 *  specify problem dimensions and program options using list-directed
00019 *  input. The remaining lines specify the LAPACK test paths and the
00020 *  number of matrix types to use in testing.  An annotated example of a
00021 *  data file can be obtained by deleting the first 3 characters from the
00022 *  following 10 lines:
00023 *  Data file for testing DOUBLE PRECISION LAPACK DSGESV
00024 *  7                      Number of values of M
00025 *  0 1 2 3 5 10 16        Values of M (row dimension)
00026 *  1                      Number of values of NRHS
00027 *  2                      Values of NRHS (number of right hand sides)
00028 *  20.0                   Threshold value of test ratio
00029 *  T                      Put T to test the LAPACK routines
00030 *  T                      Put T to test the error exits 
00031 *  DGE    11              List types on next line if 0 < NTYPES < 11
00032 *  DPO    9               List types on next line if 0 < NTYPES <  9
00033 *
00034 *  Internal Parameters
00035 *  ===================
00036 *
00037 *  NMAX    INTEGER
00038 *          The maximum allowable value for N
00039 *
00040 *  MAXIN   INTEGER
00041 *          The number of different values that can be used for each of
00042 *          M, N, NRHS, NB, and NX
00043 *
00044 *  MAXRHS  INTEGER
00045 *          The maximum number of right hand sides
00046 *
00047 *  NIN     INTEGER
00048 *          The unit number for input
00049 *
00050 *  NOUT    INTEGER
00051 *          The unit number for output
00052 *
00053 *  =====================================================================
00054 *
00055 *     .. Parameters ..
00056       INTEGER            NMAX
00057       PARAMETER          ( NMAX = 132 )
00058       INTEGER            MAXIN
00059       PARAMETER          ( MAXIN = 12 )
00060       INTEGER            MAXRHS
00061       PARAMETER          ( MAXRHS = 16 )
00062       INTEGER            MATMAX
00063       PARAMETER          ( MATMAX = 30 )
00064       INTEGER            NIN, NOUT
00065       PARAMETER          ( NIN = 5, NOUT = 6 )
00066       INTEGER            LDAMAX
00067       PARAMETER          ( LDAMAX = NMAX )
00068 *     ..
00069 *     .. Local Scalars ..
00070       LOGICAL            FATAL, TSTDRV, TSTERR
00071       CHARACTER          C1
00072       CHARACTER*2        C2
00073       CHARACTER*3        PATH
00074       CHARACTER*10       INTSTR
00075       CHARACTER*72       ALINE
00076       INTEGER            I, IC, K, LDA, NM, NMATS, 
00077      $                   NNS, NRHS, NTYPES,
00078      $                   VERS_MAJOR, VERS_MINOR, VERS_PATCH
00079       DOUBLE PRECISION   EPS, S1, S2, THRESH
00080       REAL               SEPS
00081 *     ..
00082 *     .. Local Arrays ..
00083       LOGICAL            DOTYPE( MATMAX )
00084       INTEGER            IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN )
00085       DOUBLE PRECISION   A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
00086      $                   RWORK( NMAX ), WORK( NMAX*MAXRHS*2 )
00087       REAL               SWORK(NMAX*(NMAX+MAXRHS))
00088 *     ..
00089 *     .. External Functions ..
00090       DOUBLE PRECISION   DLAMCH, DSECND
00091       LOGICAL            LSAME, LSAMEN
00092       REAL               SLAMCH
00093       EXTERNAL           LSAME, LSAMEN, DLAMCH, DSECND, SLAMCH
00094 *     ..
00095 *     .. External Subroutines ..
00096       EXTERNAL           ALAREQ, DDRVAB, DDRVAC, DERRAB, DERRAC,
00097      $                   ILAVER
00098 *     ..
00099 *     .. Scalars in Common ..
00100       LOGICAL            LERR, OK
00101       CHARACTER*32       SRNAMT
00102       INTEGER            INFOT, NUNIT
00103 *     ..
00104 *     .. Common blocks ..
00105       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00106       COMMON             / SRNAMC / SRNAMT
00107 *     ..
00108 *     .. Data statements ..
00109       DATA               INTSTR / '0123456789' /
00110 *     ..
00111 *     .. Executable Statements ..
00112 *
00113       S1 = DSECND( )
00114       LDA = NMAX
00115       FATAL = .FALSE.
00116 *
00117 *     Read a dummy line.
00118 *
00119       READ( NIN, FMT = * )
00120 *
00121 *     Report values of parameters.
00122 *
00123       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00124       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00125 *
00126 *     Read the values of M
00127 *
00128       READ( NIN, FMT = * )NM
00129       IF( NM.LT.1 ) THEN
00130          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
00131          NM = 0
00132          FATAL = .TRUE.
00133       ELSE IF( NM.GT.MAXIN ) THEN
00134          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
00135          NM = 0
00136          FATAL = .TRUE.
00137       END IF
00138       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
00139       DO 10 I = 1, NM
00140          IF( MVAL( I ).LT.0 ) THEN
00141             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
00142             FATAL = .TRUE.
00143          ELSE IF( MVAL( I ).GT.NMAX ) THEN
00144             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
00145             FATAL = .TRUE.
00146          END IF
00147    10 CONTINUE
00148       IF( NM.GT.0 )
00149      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
00150 *
00151 *     Read the values of NRHS
00152 *
00153       READ( NIN, FMT = * )NNS
00154       IF( NNS.LT.1 ) THEN
00155          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00156          NNS = 0
00157          FATAL = .TRUE.
00158       ELSE IF( NNS.GT.MAXIN ) THEN
00159          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00160          NNS = 0
00161          FATAL = .TRUE.
00162       END IF
00163       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00164       DO 30 I = 1, NNS
00165          IF( NSVAL( I ).LT.0 ) THEN
00166             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00167             FATAL = .TRUE.
00168          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00169             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00170             FATAL = .TRUE.
00171          END IF
00172    30 CONTINUE
00173       IF( NNS.GT.0 )
00174      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00175 *
00176 *     Read the threshold value for the test ratios.
00177 *
00178       READ( NIN, FMT = * )THRESH
00179       WRITE( NOUT, FMT = 9992 )THRESH
00180 *
00181 *     Read the flag that indicates whether to test the driver routine.
00182 *
00183       READ( NIN, FMT = * )TSTDRV
00184 *
00185 *     Read the flag that indicates whether to test the error exits.
00186 *
00187       READ( NIN, FMT = * )TSTERR
00188 *
00189       IF( FATAL ) THEN
00190          WRITE( NOUT, FMT = 9999 )
00191          STOP
00192       END IF
00193 *
00194 *     Calculate and print the machine dependent constants.
00195 *
00196       SEPS = SLAMCH( 'Underflow threshold' )
00197       WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
00198       SEPS = SLAMCH( 'Overflow threshold' )
00199       WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
00200       SEPS = SLAMCH( 'Epsilon' )
00201       WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
00202       WRITE( NOUT, FMT = * )
00203 *
00204       EPS = DLAMCH( 'Underflow threshold' )
00205       WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
00206       EPS = DLAMCH( 'Overflow threshold' )
00207       WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
00208       EPS = DLAMCH( 'Epsilon' )
00209       WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
00210       WRITE( NOUT, FMT = * )
00211 *
00212    80 CONTINUE
00213 *
00214 *     Read a test path and the number of matrix types to use.
00215 *
00216       READ( NIN, FMT = '(A72)', END = 140 )ALINE
00217       PATH = ALINE( 1: 3 )
00218       NMATS = MATMAX
00219       I = 3
00220    90 CONTINUE
00221       I = I + 1
00222       IF( I.GT.72 ) THEN
00223          NMATS = MATMAX
00224          GO TO 130
00225       END IF
00226       IF( ALINE( I: I ).EQ.' ' )
00227      $   GO TO 90
00228       NMATS = 0
00229   100 CONTINUE
00230       C1 = ALINE( I: I )
00231       DO 110 K = 1, 10
00232          IF( C1.EQ.INTSTR( K: K ) ) THEN
00233             IC = K - 1
00234             GO TO 120
00235          END IF
00236   110 CONTINUE
00237       GO TO 130
00238   120 CONTINUE
00239       NMATS = NMATS*10 + IC
00240       I = I + 1
00241       IF( I.GT.72 )
00242      $   GO TO 130
00243       GO TO 100
00244   130 CONTINUE
00245       C1 = PATH( 1: 1 )
00246       C2 = PATH( 2: 3 )
00247       NRHS = NSVAL( 1 )
00248 *
00249 *     Check first character for correct precision.
00250 *
00251       IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN
00252          WRITE( NOUT, FMT = 9990 )PATH
00253 
00254 *
00255       ELSE IF( NMATS.LE.0 ) THEN
00256 *
00257 *        Check for a positive number of tests requested.
00258 *
00259          WRITE( NOUT, FMT = 9989 )PATH
00260          GO TO 140
00261 *
00262       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
00263 *
00264 *        GE:  general matrices
00265 *
00266          NTYPES = 11
00267          CALL ALAREQ( 'DGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
00268 *
00269 *        Test the error exits
00270 *
00271          IF( TSTERR )
00272      $      CALL DERRAB( NOUT )
00273 *
00274          IF( TSTDRV ) THEN
00275             CALL DDRVAB( DOTYPE, NM, MVAL, NNS,
00276      $                   NSVAL, THRESH, LDA, A( 1, 1 ),
00277      $                   A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
00278      $                   WORK, RWORK, SWORK, IWORK, NOUT )
00279          ELSE
00280             WRITE( NOUT, FMT = 9989 )'DSGESV'
00281          END IF
00282 *     
00283       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
00284 *
00285 *        PO:  positive definite matrices
00286 *
00287          NTYPES = 9
00288          CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
00289 *
00290 *
00291          IF( TSTERR )
00292      $      CALL DERRAC( NOUT )
00293 *
00294 *
00295          IF( TSTDRV ) THEN
00296             CALL DDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL,
00297      $                   THRESH, LDA, A( 1, 1 ), A( 1, 2 ),
00298      $                   B( 1, 1 ), B( 1, 2 ), 
00299      $                   WORK, RWORK, SWORK, NOUT )
00300          ELSE
00301             WRITE( NOUT, FMT = 9989 )PATH
00302          END IF
00303       ELSE
00304 *
00305       END IF
00306 *
00307 *     Go back to get another input line.
00308 *
00309       GO TO 80
00310 *
00311 *     Branch to this line when the last record is read.
00312 *
00313   140 CONTINUE
00314       CLOSE ( NIN )
00315       S2 = DSECND( )
00316       WRITE( NOUT, FMT = 9998 )
00317       WRITE( NOUT, FMT = 9997 )S2 - S1
00318 *
00319  9999 FORMAT( / ' Execution not attempted due to input errors' )
00320  9998 FORMAT( / ' End of tests' )
00321  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00322  9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
00323      $      I6 )
00324  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
00325      $      I6 )
00326  9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV', 
00327      $  ' routines ',
00328      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
00329      $      / / ' The following parameter values will be used:' )
00330  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
00331  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
00332      $      'less than', F8.2, / )
00333  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
00334  9990 FORMAT( / 1X, A6, ' routines were not tested' )
00335  9989 FORMAT( / 1X, A6, ' driver routines were not tested' )
00336  9988 FORMAT( / 1X, A3, ':  Unrecognized path name' )
00337 *
00338 *     End of DCHKAB
00339 *
00340       END