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