LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dchkaa.f
Go to the documentation of this file.
00001 *> \brief \b DCHKAA
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 DCHKAA
00012 * 
00013 *
00014 *> \par Purpose:
00015 *  =============
00016 *>
00017 *> \verbatim
00018 *>
00019 *> DCHKAA is the main test program for the DOUBLE PRECISION LAPACK
00020 *> linear equation routines
00021 *>
00022 *> The program must be driven by a short data file. The first 15 records
00023 *> (not including the first comment  line) specify problem dimensions
00024 *> and program options using list-directed input. The remaining lines
00025 *> specify the LAPACK test paths and the number of matrix types to use
00026 *> in testing.  An annotated example of a data file can be obtained by
00027 *> deleting the first 3 characters from the following 40 lines:
00028 *> Data file for testing DOUBLE PRECISION LAPACK linear eqn. routines
00029 *> 7                      Number of values of M
00030 *> 0 1 2 3 5 10 16        Values of M (row dimension)
00031 *> 7                      Number of values of N
00032 *> 0 1 2 3 5 10 16        Values of N (column dimension)
00033 *> 1                      Number of values of NRHS
00034 *> 2                      Values of NRHS (number of right hand sides)
00035 *> 5                      Number of values of NB
00036 *> 1 3 3 3 20             Values of NB (the blocksize)
00037 *> 1 0 5 9 1              Values of NX (crossover point)
00038 *> 3                      Number of values of RANK
00039 *> 30 50 90               Values of rank (as a % of N)
00040 *> 20.0                   Threshold value of test ratio
00041 *> T                      Put T to test the LAPACK routines
00042 *> T                      Put T to test the driver routines
00043 *> T                      Put T to test the error exits
00044 *> DGE   11               List types on next line if 0 < NTYPES < 11
00045 *> DGB    8               List types on next line if 0 < NTYPES <  8
00046 *> DGT   12               List types on next line if 0 < NTYPES < 12
00047 *> DPO    9               List types on next line if 0 < NTYPES <  9
00048 *> DPS    9               List types on next line if 0 < NTYPES <  9
00049 *> DPP    9               List types on next line if 0 < NTYPES <  9
00050 *> DPB    8               List types on next line if 0 < NTYPES <  8
00051 *> DPT   12               List types on next line if 0 < NTYPES < 12
00052 *> DSY   10               List types on next line if 0 < NTYPES < 10
00053 *> DSR   10               List types on next line if 0 < NTYPES < 10
00054 *> DSP   10               List types on next line if 0 < NTYPES < 10
00055 *> DTR   18               List types on next line if 0 < NTYPES < 18
00056 *> DTP   18               List types on next line if 0 < NTYPES < 18
00057 *> DTB   17               List types on next line if 0 < NTYPES < 17
00058 *> DQR    8               List types on next line if 0 < NTYPES <  8
00059 *> DRQ    8               List types on next line if 0 < NTYPES <  8
00060 *> DLQ    8               List types on next line if 0 < NTYPES <  8
00061 *> DQL    8               List types on next line if 0 < NTYPES <  8
00062 *> DQP    6               List types on next line if 0 < NTYPES <  6
00063 *> DTZ    3               List types on next line if 0 < NTYPES <  3
00064 *> DLS    6               List types on next line if 0 < NTYPES <  6
00065 *> DEQ
00066 *> DQT
00067 *> DQX
00068 *> \endverbatim
00069 *
00070 *  Parameters:
00071 *  ==========
00072 *
00073 *> \verbatim
00074 *>  NMAX    INTEGER
00075 *>          The maximum allowable value for M and N.
00076 *>
00077 *>  MAXIN   INTEGER
00078 *>          The number of different values that can be used for each of
00079 *>          M, N, NRHS, NB, NX and RANK
00080 *>
00081 *>  MAXRHS  INTEGER
00082 *>          The maximum number of right hand sides
00083 *>
00084 *>  MATMAX  INTEGER
00085 *>          The maximum number of matrix types to use for testing
00086 *>
00087 *>  NIN     INTEGER
00088 *>          The unit number for input
00089 *>
00090 *>  NOUT    INTEGER
00091 *>          The unit number for output
00092 *> \endverbatim
00093 *
00094 *  Authors:
00095 *  ========
00096 *
00097 *> \author Univ. of Tennessee 
00098 *> \author Univ. of California Berkeley 
00099 *> \author Univ. of Colorado Denver 
00100 *> \author NAG Ltd. 
00101 *
00102 *> \date April 2012
00103 *
00104 *> \ingroup double_lin
00105 *
00106 *  =====================================================================
00107       PROGRAM DCHKAA
00108 *
00109 *  -- LAPACK test routine (version 3.4.1) --
00110 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00111 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00112 *     April 2012
00113 *
00114 *  =====================================================================
00115 *
00116 *     .. Parameters ..
00117       INTEGER            NMAX
00118       PARAMETER          ( NMAX = 132 )
00119       INTEGER            MAXIN
00120       PARAMETER          ( MAXIN = 12 )
00121       INTEGER            MAXRHS
00122       PARAMETER          ( MAXRHS = 16 )
00123       INTEGER            MATMAX
00124       PARAMETER          ( MATMAX = 30 )
00125       INTEGER            NIN, NOUT
00126       PARAMETER          ( NIN = 5, NOUT = 6 )
00127       INTEGER            KDMAX
00128       PARAMETER          ( KDMAX = NMAX+( NMAX+1 ) / 4 )
00129 *     ..
00130 *     .. Local Scalars ..
00131       LOGICAL            FATAL, TSTCHK, TSTDRV, TSTERR
00132       CHARACTER          C1
00133       CHARACTER*2        C2
00134       CHARACTER*3        PATH
00135       CHARACTER*10       INTSTR
00136       CHARACTER*72       ALINE
00137       INTEGER            I, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, NN,
00138      $                   NNB, NNB2, NNS, NRHS, NTYPES, NRANK,
00139      $                   VERS_MAJOR, VERS_MINOR, VERS_PATCH
00140       DOUBLE PRECISION   EPS, S1, S2, THREQ, THRESH
00141 *     ..
00142 *     .. Local Arrays ..
00143       LOGICAL            DOTYPE( MATMAX )
00144       INTEGER            IWORK( 25*NMAX ), MVAL( MAXIN ),
00145      $                   NBVAL( MAXIN ), NBVAL2( MAXIN ),
00146      $                   NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
00147      $                   RANKVAL( MAXIN ), PIV( NMAX )
00148       DOUBLE PRECISION   A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
00149      $                   RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ),
00150      $                   WORK( NMAX, NMAX+MAXRHS+30 )
00151 *     ..
00152 *     .. External Functions ..
00153       LOGICAL            LSAME, LSAMEN
00154       DOUBLE PRECISION   DLAMCH, DSECND
00155       EXTERNAL           LSAME, LSAMEN, DLAMCH, DSECND
00156 *     ..
00157 *     .. External Subroutines ..
00158       EXTERNAL           ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ,
00159      $                   DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3,
00160      $                   DCHKQL, DCHKQP, DCHKQR, DCHKRQ, DCHKSP, DCHKSY,
00161      $                   DCHKTB, DCHKTP, DCHKTR, DCHKTZ,
00162      $                   DDRVGB, DDRVGE, DDRVGT, DDRVLS, DDRVPB, DDRVPO,
00163      $                   DDRVPP, DDRVPT, DDRVSP, DDRVSY,
00164      $                   ILAVER, DCHKQRT, DCHKQRTP
00165 *     ..
00166 *     .. Scalars in Common ..
00167       LOGICAL            LERR, OK
00168       CHARACTER*32       SRNAMT
00169       INTEGER            INFOT, NUNIT
00170 *     ..
00171 *     .. Arrays in Common ..
00172       INTEGER            IPARMS( 100 )
00173 *     ..
00174 *     .. Common blocks ..
00175       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00176       COMMON             / SRNAMC / SRNAMT
00177       COMMON             / CLAENV / IPARMS
00178 *     ..
00179 *     .. Data statements ..
00180       DATA               THREQ / 2.0D0 / , INTSTR / '0123456789' /
00181 *     ..
00182 *     .. Executable Statements ..
00183 *
00184       S1 = DSECND( )
00185       LDA = NMAX
00186       FATAL = .FALSE.
00187 *
00188 *     Read a dummy line.
00189 *
00190       READ( NIN, FMT = * )
00191 *
00192 *     Report values of parameters.
00193 *
00194       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00195       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00196 *
00197 *     Read the values of M
00198 *
00199       READ( NIN, FMT = * )NM
00200       IF( NM.LT.1 ) THEN
00201          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
00202          NM = 0
00203          FATAL = .TRUE.
00204       ELSE IF( NM.GT.MAXIN ) THEN
00205          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
00206          NM = 0
00207          FATAL = .TRUE.
00208       END IF
00209       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
00210       DO 10 I = 1, NM
00211          IF( MVAL( I ).LT.0 ) THEN
00212             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
00213             FATAL = .TRUE.
00214          ELSE IF( MVAL( I ).GT.NMAX ) THEN
00215             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
00216             FATAL = .TRUE.
00217          END IF
00218    10 CONTINUE
00219       IF( NM.GT.0 )
00220      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
00221 *
00222 *     Read the values of N
00223 *
00224       READ( NIN, FMT = * )NN
00225       IF( NN.LT.1 ) THEN
00226          WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
00227          NN = 0
00228          FATAL = .TRUE.
00229       ELSE IF( NN.GT.MAXIN ) THEN
00230          WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
00231          NN = 0
00232          FATAL = .TRUE.
00233       END IF
00234       READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
00235       DO 20 I = 1, NN
00236          IF( NVAL( I ).LT.0 ) THEN
00237             WRITE( NOUT, FMT = 9996 )' N  ', NVAL( I ), 0
00238             FATAL = .TRUE.
00239          ELSE IF( NVAL( I ).GT.NMAX ) THEN
00240             WRITE( NOUT, FMT = 9995 )' N  ', NVAL( I ), NMAX
00241             FATAL = .TRUE.
00242          END IF
00243    20 CONTINUE
00244       IF( NN.GT.0 )
00245      $   WRITE( NOUT, FMT = 9993 )'N   ', ( NVAL( I ), I = 1, NN )
00246 *
00247 *     Read the values of NRHS
00248 *
00249       READ( NIN, FMT = * )NNS
00250       IF( NNS.LT.1 ) THEN
00251          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00252          NNS = 0
00253          FATAL = .TRUE.
00254       ELSE IF( NNS.GT.MAXIN ) THEN
00255          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00256          NNS = 0
00257          FATAL = .TRUE.
00258       END IF
00259       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00260       DO 30 I = 1, NNS
00261          IF( NSVAL( I ).LT.0 ) THEN
00262             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00263             FATAL = .TRUE.
00264          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00265             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00266             FATAL = .TRUE.
00267          END IF
00268    30 CONTINUE
00269       IF( NNS.GT.0 )
00270      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00271 *
00272 *     Read the values of NB
00273 *
00274       READ( NIN, FMT = * )NNB
00275       IF( NNB.LT.1 ) THEN
00276          WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1
00277          NNB = 0
00278          FATAL = .TRUE.
00279       ELSE IF( NNB.GT.MAXIN ) THEN
00280          WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN
00281          NNB = 0
00282          FATAL = .TRUE.
00283       END IF
00284       READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB )
00285       DO 40 I = 1, NNB
00286          IF( NBVAL( I ).LT.0 ) THEN
00287             WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0
00288             FATAL = .TRUE.
00289          END IF
00290    40 CONTINUE
00291       IF( NNB.GT.0 )
00292      $   WRITE( NOUT, FMT = 9993 )'NB  ', ( NBVAL( I ), I = 1, NNB )
00293 *
00294 *     Set NBVAL2 to be the set of unique values of NB
00295 *
00296       NNB2 = 0
00297       DO 60 I = 1, NNB
00298          NB = NBVAL( I )
00299          DO 50 J = 1, NNB2
00300             IF( NB.EQ.NBVAL2( J ) )
00301      $         GO TO 60
00302    50    CONTINUE
00303          NNB2 = NNB2 + 1
00304          NBVAL2( NNB2 ) = NB
00305    60 CONTINUE
00306 *
00307 *     Read the values of NX
00308 *
00309       READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB )
00310       DO 70 I = 1, NNB
00311          IF( NXVAL( I ).LT.0 ) THEN
00312             WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0
00313             FATAL = .TRUE.
00314          END IF
00315    70 CONTINUE
00316       IF( NNB.GT.0 )
00317      $   WRITE( NOUT, FMT = 9993 )'NX  ', ( NXVAL( I ), I = 1, NNB )
00318 *
00319 *     Read the values of RANKVAL
00320 *
00321       READ( NIN, FMT = * )NRANK
00322       IF( NN.LT.1 ) THEN
00323          WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1
00324          NRANK = 0
00325          FATAL = .TRUE.
00326       ELSE IF( NN.GT.MAXIN ) THEN
00327          WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN
00328          NRANK = 0
00329          FATAL = .TRUE.
00330       END IF
00331       READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK )
00332       DO I = 1, NRANK
00333          IF( RANKVAL( I ).LT.0 ) THEN
00334             WRITE( NOUT, FMT = 9996 )' RANK  ', RANKVAL( I ), 0
00335             FATAL = .TRUE.
00336          ELSE IF( RANKVAL( I ).GT.100 ) THEN
00337             WRITE( NOUT, FMT = 9995 )' RANK  ', RANKVAL( I ), 100
00338             FATAL = .TRUE.
00339          END IF
00340       END DO
00341       IF( NRANK.GT.0 )
00342      $   WRITE( NOUT, FMT = 9993 )'RANK % OF N',
00343      $   ( RANKVAL( I ), I = 1, NRANK )
00344 *
00345 *     Read the threshold value for the test ratios.
00346 *
00347       READ( NIN, FMT = * )THRESH
00348       WRITE( NOUT, FMT = 9992 )THRESH
00349 *
00350 *     Read the flag that indicates whether to test the LAPACK routines.
00351 *
00352       READ( NIN, FMT = * )TSTCHK
00353 *
00354 *     Read the flag that indicates whether to test the driver routines.
00355 *
00356       READ( NIN, FMT = * )TSTDRV
00357 *
00358 *     Read the flag that indicates whether to test the error exits.
00359 *
00360       READ( NIN, FMT = * )TSTERR
00361 *
00362       IF( FATAL ) THEN
00363          WRITE( NOUT, FMT = 9999 )
00364          STOP
00365       END IF
00366 *
00367 *     Calculate and print the machine dependent constants.
00368 *
00369       EPS = DLAMCH( 'Underflow threshold' )
00370       WRITE( NOUT, FMT = 9991 )'underflow', EPS
00371       EPS = DLAMCH( 'Overflow threshold' )
00372       WRITE( NOUT, FMT = 9991 )'overflow ', EPS
00373       EPS = DLAMCH( 'Epsilon' )
00374       WRITE( NOUT, FMT = 9991 )'precision', EPS
00375       WRITE( NOUT, FMT = * )
00376 *
00377    80 CONTINUE
00378 *
00379 *     Read a test path and the number of matrix types to use.
00380 *
00381       READ( NIN, FMT = '(A72)', END = 140 )ALINE
00382       PATH = ALINE( 1: 3 )
00383       NMATS = MATMAX
00384       I = 3
00385    90 CONTINUE
00386       I = I + 1
00387       IF( I.GT.72 ) THEN
00388          NMATS = MATMAX
00389          GO TO 130
00390       END IF
00391       IF( ALINE( I: I ).EQ.' ' )
00392      $   GO TO 90
00393       NMATS = 0
00394   100 CONTINUE
00395       C1 = ALINE( I: I )
00396       DO 110 K = 1, 10
00397          IF( C1.EQ.INTSTR( K: K ) ) THEN
00398             IC = K - 1
00399             GO TO 120
00400          END IF
00401   110 CONTINUE
00402       GO TO 130
00403   120 CONTINUE
00404       NMATS = NMATS*10 + IC
00405       I = I + 1
00406       IF( I.GT.72 )
00407      $   GO TO 130
00408       GO TO 100
00409   130 CONTINUE
00410       C1 = PATH( 1: 1 )
00411       C2 = PATH( 2: 3 )
00412       NRHS = NSVAL( 1 )
00413 *
00414 *     Check first character for correct precision.
00415 *
00416       IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN
00417          WRITE( NOUT, FMT = 9990 )PATH
00418 *
00419       ELSE IF( NMATS.LE.0 ) THEN
00420 *
00421 *        Check for a positive number of tests requested.
00422 *
00423          WRITE( NOUT, FMT = 9989 )PATH
00424 *
00425       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
00426 *
00427 *        GE:  general matrices
00428 *
00429          NTYPES = 11
00430          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00431 *
00432          IF( TSTCHK ) THEN
00433             CALL DCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS,
00434      $                   NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ),
00435      $                   A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
00436      $                   B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
00437          ELSE
00438             WRITE( NOUT, FMT = 9989 )PATH
00439          END IF
00440 *
00441          IF( TSTDRV ) THEN
00442             CALL DDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
00443      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00444      $                   B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
00445      $                   RWORK, IWORK, NOUT )
00446          ELSE
00447             WRITE( NOUT, FMT = 9988 )PATH
00448          END IF
00449 *
00450       ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
00451 *
00452 *        GB:  general banded matrices
00453 *
00454          LA = ( 2*KDMAX+1 )*NMAX
00455          LAFAC = ( 3*KDMAX+1 )*NMAX
00456          NTYPES = 8
00457          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00458 *
00459          IF( TSTCHK ) THEN
00460             CALL DCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS,
00461      $                   NSVAL, THRESH, TSTERR, A( 1, 1 ), LA,
00462      $                   A( 1, 3 ), LAFAC, B( 1, 1 ), B( 1, 2 ),
00463      $                   B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
00464          ELSE
00465             WRITE( NOUT, FMT = 9989 )PATH
00466          END IF
00467 *
00468          IF( TSTDRV ) THEN
00469             CALL DDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
00470      $                   A( 1, 1 ), LA, A( 1, 3 ), LAFAC, A( 1, 6 ),
00471      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S,
00472      $                   WORK, RWORK, IWORK, NOUT )
00473          ELSE
00474             WRITE( NOUT, FMT = 9988 )PATH
00475          END IF
00476 *
00477       ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN
00478 *
00479 *        GT:  general tridiagonal matrices
00480 *
00481          NTYPES = 12
00482          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00483 *
00484          IF( TSTCHK ) THEN
00485             CALL DCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00486      $                   A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
00487      $                   B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
00488          ELSE
00489             WRITE( NOUT, FMT = 9989 )PATH
00490          END IF
00491 *
00492          IF( TSTDRV ) THEN
00493             CALL DDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
00494      $                   A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
00495      $                   B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
00496          ELSE
00497             WRITE( NOUT, FMT = 9988 )PATH
00498          END IF
00499 *
00500       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
00501 *
00502 *        PO:  positive definite matrices
00503 *
00504          NTYPES = 9
00505          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00506 *
00507          IF( TSTCHK ) THEN
00508             CALL DCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
00509      $                   THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
00510      $                   A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
00511      $                   WORK, RWORK, IWORK, NOUT )
00512          ELSE
00513             WRITE( NOUT, FMT = 9989 )PATH
00514          END IF
00515 *
00516          IF( TSTDRV ) THEN
00517             CALL DDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
00518      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00519      $                   B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
00520      $                   RWORK, IWORK, NOUT )
00521          ELSE
00522             WRITE( NOUT, FMT = 9988 )PATH
00523          END IF
00524 *
00525       ELSE IF( LSAMEN( 2, C2, 'PS' ) ) THEN
00526 *
00527 *        PS:  positive semi-definite matrices
00528 *
00529          NTYPES = 9
00530 *
00531          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00532 *
00533          IF( TSTCHK ) THEN
00534             CALL DCHKPS( DOTYPE, NN, NVAL, NNB2, NBVAL2, NRANK,
00535      $                   RANKVAL, THRESH, TSTERR, LDA, A( 1, 1 ),
00536      $                   A( 1, 2 ), A( 1, 3 ), PIV, WORK, RWORK,
00537      $                   NOUT )
00538          ELSE
00539             WRITE( NOUT, FMT = 9989 )PATH
00540          END IF
00541 *
00542       ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
00543 *
00544 *        PP:  positive definite packed matrices
00545 *
00546          NTYPES = 9
00547          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00548 *
00549          IF( TSTCHK ) THEN
00550             CALL DCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00551      $                   LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
00552      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK,
00553      $                   IWORK, NOUT )
00554          ELSE
00555             WRITE( NOUT, FMT = 9989 )PATH
00556          END IF
00557 *
00558          IF( TSTDRV ) THEN
00559             CALL DDRVPP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
00560      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00561      $                   B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
00562      $                   RWORK, IWORK, NOUT )
00563          ELSE
00564             WRITE( NOUT, FMT = 9988 )PATH
00565          END IF
00566 *
00567       ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
00568 *
00569 *        PB:  positive definite banded matrices
00570 *
00571          NTYPES = 8
00572          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00573 *
00574          IF( TSTCHK ) THEN
00575             CALL DCHKPB( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
00576      $                   THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
00577      $                   A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
00578      $                   WORK, RWORK, IWORK, NOUT )
00579          ELSE
00580             WRITE( NOUT, FMT = 9989 )PATH
00581          END IF
00582 *
00583          IF( TSTDRV ) THEN
00584             CALL DDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
00585      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00586      $                   B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
00587      $                   RWORK, IWORK, NOUT )
00588          ELSE
00589             WRITE( NOUT, FMT = 9988 )PATH
00590          END IF
00591 *
00592       ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
00593 *
00594 *        PT:  positive definite tridiagonal matrices
00595 *
00596          NTYPES = 12
00597          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00598 *
00599          IF( TSTCHK ) THEN
00600             CALL DCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00601      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00602      $                   B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT )
00603          ELSE
00604             WRITE( NOUT, FMT = 9989 )PATH
00605          END IF
00606 *
00607          IF( TSTDRV ) THEN
00608             CALL DDRVPT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
00609      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00610      $                   B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT )
00611          ELSE
00612             WRITE( NOUT, FMT = 9988 )PATH
00613          END IF
00614 *
00615       ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN
00616 *
00617 *        SY:  symmetric indefinite matrices,
00618 *             with partial (Bunch-Kaufman) pivoting algorithm
00619 *
00620          NTYPES = 10
00621          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00622 *
00623          IF( TSTCHK ) THEN
00624             CALL DCHKSY( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
00625      $                   THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
00626      $                   A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
00627      $                   WORK, RWORK, IWORK, NOUT )
00628          ELSE
00629             WRITE( NOUT, FMT = 9989 )PATH
00630          END IF
00631 *
00632          IF( TSTDRV ) THEN
00633             CALL DDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
00634      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00635      $                   B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
00636      $                   NOUT )
00637          ELSE
00638             WRITE( NOUT, FMT = 9988 )PATH
00639          END IF
00640 *
00641       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
00642 *
00643 *        SP:  symmetric indefinite packed matrices,
00644 *             with partial (Bunch-Kaufman) pivoting algorithm
00645 *
00646          NTYPES = 10
00647          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00648 *
00649          IF( TSTCHK ) THEN
00650             CALL DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00651      $                   LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
00652      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK,
00653      $                   IWORK, NOUT )
00654          ELSE
00655             WRITE( NOUT, FMT = 9989 )PATH
00656          END IF
00657 *
00658          IF( TSTDRV ) THEN
00659             CALL DDRVSP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
00660      $                   A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
00661      $                   B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
00662      $                   NOUT )
00663          ELSE
00664             WRITE( NOUT, FMT = 9988 )PATH
00665          END IF
00666 *
00667       ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN
00668 *
00669 *        TR:  triangular matrices
00670 *
00671          NTYPES = 18
00672          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00673 *
00674          IF( TSTCHK ) THEN
00675             CALL DCHKTR( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
00676      $                   THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
00677      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK,
00678      $                   IWORK, NOUT )
00679          ELSE
00680             WRITE( NOUT, FMT = 9989 )PATH
00681          END IF
00682 *
00683       ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN
00684 *
00685 *        TP:  triangular packed matrices
00686 *
00687          NTYPES = 18
00688          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00689 *
00690          IF( TSTCHK ) THEN
00691             CALL DCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00692      $                   LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
00693      $                   B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
00694      $                   NOUT )
00695          ELSE
00696             WRITE( NOUT, FMT = 9989 )PATH
00697          END IF
00698 *
00699       ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
00700 *
00701 *        TB:  triangular banded matrices
00702 *
00703          NTYPES = 17
00704          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00705 *
00706          IF( TSTCHK ) THEN
00707             CALL DCHKTB( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00708      $                   LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
00709      $                   B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
00710      $                   NOUT )
00711          ELSE
00712             WRITE( NOUT, FMT = 9989 )PATH
00713          END IF
00714 *
00715       ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN
00716 *
00717 *        QR:  QR factorization
00718 *
00719          NTYPES = 8
00720          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00721 *
00722          IF( TSTCHK ) THEN
00723             CALL DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00724      $                   NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
00725      $                   A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
00726      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
00727      $                   WORK, RWORK, IWORK, NOUT )
00728          ELSE
00729             WRITE( NOUT, FMT = 9989 )PATH
00730          END IF
00731 *
00732       ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN
00733 *
00734 *        LQ:  LQ factorization
00735 *
00736          NTYPES = 8
00737          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00738 *
00739          IF( TSTCHK ) THEN
00740             CALL DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00741      $                   NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
00742      $                   A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
00743      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
00744      $                   WORK, RWORK, NOUT )
00745          ELSE
00746             WRITE( NOUT, FMT = 9989 )PATH
00747          END IF
00748 *
00749       ELSE IF( LSAMEN( 2, C2, 'QL' ) ) THEN
00750 *
00751 *        QL:  QL factorization
00752 *
00753          NTYPES = 8
00754          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00755 *
00756          IF( TSTCHK ) THEN
00757             CALL DCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00758      $                   NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
00759      $                   A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
00760      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
00761      $                   WORK, RWORK, IWORK, NOUT )
00762          ELSE
00763             WRITE( NOUT, FMT = 9989 )PATH
00764          END IF
00765 *
00766       ELSE IF( LSAMEN( 2, C2, 'RQ' ) ) THEN
00767 *
00768 *        RQ:  RQ factorization
00769 *
00770          NTYPES = 8
00771          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00772 *
00773          IF( TSTCHK ) THEN
00774             CALL DCHKRQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00775      $                   NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
00776      $                   A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
00777      $                   B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
00778      $                   WORK, RWORK, IWORK, NOUT )
00779          ELSE
00780             WRITE( NOUT, FMT = 9989 )PATH
00781          END IF
00782 *
00783       ELSE IF( LSAMEN( 2, C2, 'QP' ) ) THEN
00784 *
00785 *        QP:  QR factorization with pivoting
00786 *
00787          NTYPES = 6
00788          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00789 *
00790          IF( TSTCHK ) THEN
00791             CALL DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
00792      $                   A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
00793      $                   B( 1, 3 ), WORK, IWORK, NOUT )
00794             CALL DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00795      $                   THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
00796      $                   B( 1, 3 ), WORK, IWORK, NOUT )
00797          ELSE
00798             WRITE( NOUT, FMT = 9989 )PATH
00799          END IF
00800 *
00801       ELSE IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
00802 *
00803 *        TZ:  Trapezoidal matrix
00804 *
00805          NTYPES = 3
00806          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00807 *
00808          IF( TSTCHK ) THEN
00809             CALL DCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
00810      $                   A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
00811      $                   B( 1, 3 ), WORK, NOUT )
00812          ELSE
00813             WRITE( NOUT, FMT = 9989 )PATH
00814          END IF
00815 *
00816       ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN
00817 *
00818 *        LS:  Least squares drivers
00819 *
00820          NTYPES = 6
00821          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00822 *
00823          IF( TSTDRV ) THEN
00824             CALL DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB,
00825      $                   NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ),
00826      $                   A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
00827      $                   RWORK, RWORK( NMAX+1 ), WORK, IWORK, NOUT )
00828          ELSE
00829             WRITE( NOUT, FMT = 9988 )PATH
00830          END IF
00831 *
00832       ELSE IF( LSAMEN( 2, C2, 'EQ' ) ) THEN
00833 *
00834 *        EQ:  Equilibration routines for general and positive definite
00835 *             matrices (THREQ should be between 2 and 10)
00836 *
00837          IF( TSTCHK ) THEN
00838             CALL DCHKEQ( THREQ, NOUT )
00839          ELSE
00840             WRITE( NOUT, FMT = 9989 )PATH
00841          END IF
00842 *         
00843       ELSE IF( LSAMEN( 2, C2, 'QT' ) ) THEN
00844 *
00845 *        QT:  QRT routines for general matrices
00846 *
00847          IF( TSTCHK ) THEN
00848             CALL DCHKQRT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 
00849      $                    NBVAL, NOUT )
00850          ELSE
00851             WRITE( NOUT, FMT = 9989 )PATH
00852          END IF
00853 *
00854       ELSE IF( LSAMEN( 2, C2, 'QX' ) ) THEN
00855 *
00856 *        QX:  QRT routines for triangular-pentagonal matrices
00857 *
00858          IF( TSTCHK ) THEN
00859             CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 
00860      $                     NBVAL, NOUT )
00861          ELSE
00862             WRITE( NOUT, FMT = 9989 )PATH
00863          END IF
00864 *
00865       ELSE
00866 *
00867          WRITE( NOUT, FMT = 9990 )PATH
00868       END IF
00869 *
00870 *     Go back to get another input line.
00871 *
00872       GO TO 80
00873 *
00874 *     Branch to this line when the last record is read.
00875 *
00876   140 CONTINUE
00877       CLOSE ( NIN )
00878       S2 = DSECND( )
00879       WRITE( NOUT, FMT = 9998 )
00880       WRITE( NOUT, FMT = 9997 )S2 - S1
00881 *
00882  9999 FORMAT( / ' Execution not attempted due to input errors' )
00883  9998 FORMAT( / ' End of tests' )
00884  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00885  9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
00886      $      I6 )
00887  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
00888      $      I6 )
00889  9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK routines ',
00890      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
00891      $      / / ' The following parameter values will be used:' )
00892  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
00893  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
00894      $      'less than', F8.2, / )
00895  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
00896  9990 FORMAT( / 1X, A3, ':  Unrecognized path name' )
00897  9989 FORMAT( / 1X, A3, ' routines were not tested' )
00898  9988 FORMAT( / 1X, A3, ' driver routines were not tested' )
00899 *
00900 *     End of DCHKAA
00901 *
00902       END
 All Files Functions