LAPACK: TESTING/LIN/zchkab.f Source File

Go to the documentation of this file.
00001       PROGRAM ZCHKAB
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 *  ZCHKAB is the test program for the COMPLEX*16 LAPACK
00015 *  ZCGESV/ZCPOSV 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 9 lines:
00023 *  Data file for testing COMPLEX*16 LAPACK ZCGESV
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 routine
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   RWORK(NMAX)
00086       COMPLEX*16         A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
00087      $                   WORK( NMAX*MAXRHS*2 )
00088       COMPLEX            SWORK(NMAX*(NMAX+MAXRHS))
00089 *     ..
00090 *     .. External Functions ..
00091       DOUBLE PRECISION   DLAMCH, DSECND
00092       LOGICAL            LSAME, LSAMEN
00093       REAL               SLAMCH
00094       EXTERNAL           DLAMCH, DSECND, LSAME, LSAMEN, SLAMCH
00095 *     ..
00096 *     .. External Subroutines ..
00097       EXTERNAL           ALAREQ, ZDRVAB, ZDRVAC, ZERRAB, ZERRAC,
00098      $                   ILAVER
00099 *     ..
00100 *     .. Scalars in Common ..
00101       LOGICAL            LERR, OK
00102       CHARACTER*32       SRNAMT
00103       INTEGER            INFOT, NUNIT
00104 *     ..
00105 *     .. Common blocks ..
00106       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00107       COMMON             / SRNAMC / SRNAMT
00108 *
00109 *     .. Data statements ..
00110       DATA               INTSTR / '0123456789' /
00111 *     ..
00112 *     .. Executable Statements ..
00113 *
00114       S1 = DSECND( )
00115       LDA = NMAX
00116       FATAL = .FALSE.
00117 *
00118 *     Read a dummy line.
00119 *
00120       READ( NIN, FMT = * )
00121 *
00122 *     Report values of parameters.
00123 *
00124       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00125       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00126 *
00127 *     Read the values of M
00128 *
00129       READ( NIN, FMT = * )NM
00130       IF( NM.LT.1 ) THEN
00131          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
00132          NM = 0
00133          FATAL = .TRUE.
00134       ELSE IF( NM.GT.MAXIN ) THEN
00135          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
00136          NM = 0
00137          FATAL = .TRUE.
00138       END IF
00139       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
00140       DO 10 I = 1, NM
00141          IF( MVAL( I ).LT.0 ) THEN
00142             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
00143             FATAL = .TRUE.
00144          ELSE IF( MVAL( I ).GT.NMAX ) THEN
00145             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
00146             FATAL = .TRUE.
00147          END IF
00148    10 CONTINUE
00149       IF( NM.GT.0 )
00150      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
00151 *
00152 *     Read the values of NRHS
00153 *
00154       READ( NIN, FMT = * )NNS
00155       IF( NNS.LT.1 ) THEN
00156          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00157          NNS = 0
00158          FATAL = .TRUE.
00159       ELSE IF( NNS.GT.MAXIN ) THEN
00160          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00161          NNS = 0
00162          FATAL = .TRUE.
00163       END IF
00164       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00165       DO 30 I = 1, NNS
00166          IF( NSVAL( I ).LT.0 ) THEN
00167             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00168             FATAL = .TRUE.
00169          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00170             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00171             FATAL = .TRUE.
00172          END IF
00173    30 CONTINUE
00174       IF( NNS.GT.0 )
00175      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00176 *
00177 *     Read the threshold value for the test ratios.
00178 *
00179       READ( NIN, FMT = * )THRESH
00180       WRITE( NOUT, FMT = 9992 )THRESH
00181 *
00182 *     Read the flag that indicates whether to test the driver routine.
00183 *
00184       READ( NIN, FMT = * )TSTDRV
00185 *
00186 *     Read the flag that indicates whether to test the error exits.
00187 *
00188       READ( NIN, FMT = * )TSTERR
00189 *
00190       IF( FATAL ) THEN
00191          WRITE( NOUT, FMT = 9999 )
00192          STOP
00193       END IF
00194 *
00195 *     Calculate and print the machine dependent constants.
00196 *
00197       SEPS = SLAMCH( 'Underflow threshold' )
00198       WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
00199       SEPS = SLAMCH( 'Overflow threshold' )
00200       WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
00201       SEPS = SLAMCH( 'Epsilon' )
00202       WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
00203       WRITE( NOUT, FMT = * )
00204 *
00205       EPS = DLAMCH( 'Underflow threshold' )
00206       WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
00207       EPS = DLAMCH( 'Overflow threshold' )
00208       WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
00209       EPS = DLAMCH( 'Epsilon' )
00210       WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
00211       WRITE( NOUT, FMT = * )
00212 *
00213    80 CONTINUE
00214 *
00215 *     Read a test path and the number of matrix types to use.
00216 *
00217       READ( NIN, FMT = '(A72)', END = 140 )ALINE
00218       PATH = ALINE( 1: 3 )
00219       NMATS = MATMAX
00220       I = 3
00221    90 CONTINUE
00222       I = I + 1
00223       IF( I.GT.72 ) THEN
00224          NMATS = MATMAX
00225          GO TO 130
00226       END IF
00227       IF( ALINE( I: I ).EQ.' ' )
00228      $   GO TO 90
00229       NMATS = 0
00230   100 CONTINUE
00231       C1 = ALINE( I: I )
00232       DO 110 K = 1, 10
00233          IF( C1.EQ.INTSTR( K: K ) ) THEN
00234             IC = K - 1
00235             GO TO 120
00236          END IF
00237   110 CONTINUE
00238       GO TO 130
00239   120 CONTINUE
00240       NMATS = NMATS*10 + IC
00241       I = I + 1
00242       IF( I.GT.72 )
00243      $   GO TO 130
00244       GO TO 100
00245   130 CONTINUE
00246       C1 = PATH( 1: 1 )
00247       C2 = PATH( 2: 3 )
00248       NRHS = NSVAL( 1 )
00249       NRHS = NSVAL( 1 )
00250 *
00251 *     Check first character for correct precision.
00252 *
00253       IF( .NOT.LSAME( C1, 'Zomplex precision' ) ) THEN
00254             WRITE( NOUT, FMT = 9990 )PATH
00255 *
00256       ELSE IF( NMATS.LE.0 ) THEN
00257 *
00258 *        Check for a positive number of tests requested.
00259 *
00260          WRITE( NOUT, FMT = 9990 )'ZCGESV'
00261          GO TO 140
00262 *
00263       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
00264 *
00265 *        GE:  general matrices
00266 *
00267       NTYPES = 11
00268       CALL ALAREQ( 'ZGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
00269 *
00270 *        Test the error exits
00271 *
00272          IF( TSTERR )
00273      $     CALL ZERRAB( NOUT )
00274 *
00275          IF( TSTDRV ) THEN
00276             CALL ZDRVAB( DOTYPE, NM, MVAL, NNS,
00277      $                   NSVAL, THRESH, LDA, A( 1, 1 ),
00278      $                   A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
00279      $                   WORK, RWORK, SWORK, IWORK, NOUT )
00280          ELSE
00281             WRITE( NOUT, FMT = 9989 )'ZCGESV'
00282          END IF
00283 *
00284       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
00285 *
00286 *        PO:  positive definite matrices
00287 *
00288          NTYPES = 9
00289          CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
00290 *
00291          IF( TSTERR )
00292      $      CALL ZERRAC( NOUT )
00293 *
00294 *
00295          IF( TSTDRV ) THEN
00296             CALL ZDRVAC( 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 )'ZCPOSV'
00302          END IF
00303 *
00304       ELSE
00305 *
00306       END IF
00307 *
00308 *     Go back to get another input line.
00309 *
00310       GO TO 80
00311 *
00312 *     Branch to this line when the last record is read.
00313 *
00314   140 CONTINUE
00315       CLOSE ( NIN )
00316       S2 = DSECND( )
00317       WRITE( NOUT, FMT = 9998 )
00318       WRITE( NOUT, FMT = 9997 )S2 - S1
00319 *
00320  9999 FORMAT( / ' Execution not attempted due to input errors' )
00321  9998 FORMAT( / ' End of tests' )
00322  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00323  9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
00324      $      I6 )
00325  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
00326      $      I6 )
00327  9994 FORMAT( ' Tests of the COMPLEX*16 LAPACK ZCGESV/ZCPOSV 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 ZCHKAB
00339 *
00340       END