LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dchkab.f
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 April 2012
00070 *
00071 *> \ingroup double_lin
00072 *
00073 *  =====================================================================
00074       PROGRAM DCHKAB
00075 *
00076 *  -- LAPACK test routine (version 3.4.1) --
00077 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00078 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00079 *     April 2012
00080 *
00081 *  =====================================================================
00082 *
00083 *     .. Parameters ..
00084       INTEGER            NMAX
00085       PARAMETER          ( NMAX = 132 )
00086       INTEGER            MAXIN
00087       PARAMETER          ( MAXIN = 12 )
00088       INTEGER            MAXRHS
00089       PARAMETER          ( MAXRHS = 16 )
00090       INTEGER            MATMAX
00091       PARAMETER          ( MATMAX = 30 )
00092       INTEGER            NIN, NOUT
00093       PARAMETER          ( NIN = 5, NOUT = 6 )
00094       INTEGER            LDAMAX
00095       PARAMETER          ( LDAMAX = NMAX )
00096 *     ..
00097 *     .. Local Scalars ..
00098       LOGICAL            FATAL, TSTDRV, TSTERR
00099       CHARACTER          C1
00100       CHARACTER*2        C2
00101       CHARACTER*3        PATH
00102       CHARACTER*10       INTSTR
00103       CHARACTER*72       ALINE
00104       INTEGER            I, IC, K, LDA, NM, NMATS, 
00105      $                   NNS, NRHS, NTYPES,
00106      $                   VERS_MAJOR, VERS_MINOR, VERS_PATCH
00107       DOUBLE PRECISION   EPS, S1, S2, THRESH
00108       REAL               SEPS
00109 *     ..
00110 *     .. Local Arrays ..
00111       LOGICAL            DOTYPE( MATMAX )
00112       INTEGER            IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN )
00113       DOUBLE PRECISION   A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
00114      $                   RWORK( NMAX ), WORK( NMAX*MAXRHS*2 )
00115       REAL               SWORK(NMAX*(NMAX+MAXRHS))
00116 *     ..
00117 *     .. External Functions ..
00118       DOUBLE PRECISION   DLAMCH, DSECND
00119       LOGICAL            LSAME, LSAMEN
00120       REAL               SLAMCH
00121       EXTERNAL           LSAME, LSAMEN, DLAMCH, DSECND, SLAMCH
00122 *     ..
00123 *     .. External Subroutines ..
00124       EXTERNAL           ALAREQ, DDRVAB, DDRVAC, DERRAB, DERRAC,
00125      $                   ILAVER
00126 *     ..
00127 *     .. Scalars in Common ..
00128       LOGICAL            LERR, OK
00129       CHARACTER*32       SRNAMT
00130       INTEGER            INFOT, NUNIT
00131 *     ..
00132 *     .. Common blocks ..
00133       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00134       COMMON             / SRNAMC / SRNAMT
00135 *     ..
00136 *     .. Data statements ..
00137       DATA               INTSTR / '0123456789' /
00138 *     ..
00139 *     .. Executable Statements ..
00140 *
00141       S1 = DSECND( )
00142       LDA = NMAX
00143       FATAL = .FALSE.
00144 *
00145 *     Read a dummy line.
00146 *
00147       READ( NIN, FMT = * )
00148 *
00149 *     Report values of parameters.
00150 *
00151       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00152       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00153 *
00154 *     Read the values of M
00155 *
00156       READ( NIN, FMT = * )NM
00157       IF( NM.LT.1 ) THEN
00158          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
00159          NM = 0
00160          FATAL = .TRUE.
00161       ELSE IF( NM.GT.MAXIN ) THEN
00162          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
00163          NM = 0
00164          FATAL = .TRUE.
00165       END IF
00166       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
00167       DO 10 I = 1, NM
00168          IF( MVAL( I ).LT.0 ) THEN
00169             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
00170             FATAL = .TRUE.
00171          ELSE IF( MVAL( I ).GT.NMAX ) THEN
00172             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
00173             FATAL = .TRUE.
00174          END IF
00175    10 CONTINUE
00176       IF( NM.GT.0 )
00177      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
00178 *
00179 *     Read the values of NRHS
00180 *
00181       READ( NIN, FMT = * )NNS
00182       IF( NNS.LT.1 ) THEN
00183          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00184          NNS = 0
00185          FATAL = .TRUE.
00186       ELSE IF( NNS.GT.MAXIN ) THEN
00187          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00188          NNS = 0
00189          FATAL = .TRUE.
00190       END IF
00191       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00192       DO 30 I = 1, NNS
00193          IF( NSVAL( I ).LT.0 ) THEN
00194             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00195             FATAL = .TRUE.
00196          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00197             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00198             FATAL = .TRUE.
00199          END IF
00200    30 CONTINUE
00201       IF( NNS.GT.0 )
00202      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00203 *
00204 *     Read the threshold value for the test ratios.
00205 *
00206       READ( NIN, FMT = * )THRESH
00207       WRITE( NOUT, FMT = 9992 )THRESH
00208 *
00209 *     Read the flag that indicates whether to test the driver routine.
00210 *
00211       READ( NIN, FMT = * )TSTDRV
00212 *
00213 *     Read the flag that indicates whether to test the error exits.
00214 *
00215       READ( NIN, FMT = * )TSTERR
00216 *
00217       IF( FATAL ) THEN
00218          WRITE( NOUT, FMT = 9999 )
00219          STOP
00220       END IF
00221 *
00222 *     Calculate and print the machine dependent constants.
00223 *
00224       SEPS = SLAMCH( 'Underflow threshold' )
00225       WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
00226       SEPS = SLAMCH( 'Overflow threshold' )
00227       WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
00228       SEPS = SLAMCH( 'Epsilon' )
00229       WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
00230       WRITE( NOUT, FMT = * )
00231 *
00232       EPS = DLAMCH( 'Underflow threshold' )
00233       WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
00234       EPS = DLAMCH( 'Overflow threshold' )
00235       WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
00236       EPS = DLAMCH( 'Epsilon' )
00237       WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
00238       WRITE( NOUT, FMT = * )
00239 *
00240    80 CONTINUE
00241 *
00242 *     Read a test path and the number of matrix types to use.
00243 *
00244       READ( NIN, FMT = '(A72)', END = 140 )ALINE
00245       PATH = ALINE( 1: 3 )
00246       NMATS = MATMAX
00247       I = 3
00248    90 CONTINUE
00249       I = I + 1
00250       IF( I.GT.72 ) THEN
00251          NMATS = MATMAX
00252          GO TO 130
00253       END IF
00254       IF( ALINE( I: I ).EQ.' ' )
00255      $   GO TO 90
00256       NMATS = 0
00257   100 CONTINUE
00258       C1 = ALINE( I: I )
00259       DO 110 K = 1, 10
00260          IF( C1.EQ.INTSTR( K: K ) ) THEN
00261             IC = K - 1
00262             GO TO 120
00263          END IF
00264   110 CONTINUE
00265       GO TO 130
00266   120 CONTINUE
00267       NMATS = NMATS*10 + IC
00268       I = I + 1
00269       IF( I.GT.72 )
00270      $   GO TO 130
00271       GO TO 100
00272   130 CONTINUE
00273       C1 = PATH( 1: 1 )
00274       C2 = PATH( 2: 3 )
00275       NRHS = NSVAL( 1 )
00276 *
00277 *     Check first character for correct precision.
00278 *
00279       IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN
00280          WRITE( NOUT, FMT = 9990 )PATH
00281 
00282 *
00283       ELSE IF( NMATS.LE.0 ) THEN
00284 *
00285 *        Check for a positive number of tests requested.
00286 *
00287          WRITE( NOUT, FMT = 9989 )PATH
00288          GO TO 140
00289 *
00290       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
00291 *
00292 *        GE:  general matrices
00293 *
00294          NTYPES = 11
00295          CALL ALAREQ( 'DGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
00296 *
00297 *        Test the error exits
00298 *
00299          IF( TSTERR )
00300      $      CALL DERRAB( NOUT )
00301 *
00302          IF( TSTDRV ) THEN
00303             CALL DDRVAB( DOTYPE, NM, MVAL, NNS,
00304      $                   NSVAL, THRESH, LDA, A( 1, 1 ),
00305      $                   A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
00306      $                   WORK, RWORK, SWORK, IWORK, NOUT )
00307          ELSE
00308             WRITE( NOUT, FMT = 9989 )'DSGESV'
00309          END IF
00310 *     
00311       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
00312 *
00313 *        PO:  positive definite matrices
00314 *
00315          NTYPES = 9
00316          CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
00317 *
00318 *
00319          IF( TSTERR )
00320      $      CALL DERRAC( NOUT )
00321 *
00322 *
00323          IF( TSTDRV ) THEN
00324             CALL DDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL,
00325      $                   THRESH, LDA, A( 1, 1 ), A( 1, 2 ),
00326      $                   B( 1, 1 ), B( 1, 2 ), 
00327      $                   WORK, RWORK, SWORK, NOUT )
00328          ELSE
00329             WRITE( NOUT, FMT = 9989 )PATH
00330          END IF
00331       ELSE
00332 *
00333       END IF
00334 *
00335 *     Go back to get another input line.
00336 *
00337       GO TO 80
00338 *
00339 *     Branch to this line when the last record is read.
00340 *
00341   140 CONTINUE
00342       CLOSE ( NIN )
00343       S2 = DSECND( )
00344       WRITE( NOUT, FMT = 9998 )
00345       WRITE( NOUT, FMT = 9997 )S2 - S1
00346 *
00347  9999 FORMAT( / ' Execution not attempted due to input errors' )
00348  9998 FORMAT( / ' End of tests' )
00349  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00350  9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
00351      $      I6 )
00352  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
00353      $      I6 )
00354  9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV', 
00355      $  ' routines ',
00356      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
00357      $      / / ' The following parameter values will be used:' )
00358  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
00359  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
00360      $      'less than', F8.2, / )
00361  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
00362  9990 FORMAT( / 1X, A6, ' routines were not tested' )
00363  9989 FORMAT( / 1X, A6, ' driver routines were not tested' )
00364 *
00365 *     End of DCHKAB
00366 *
00367       END
 All Files Functions