dchkab.f

Go to the documentation of this file.

*> \brief \b DCHKAB
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       PROGRAM DCHKAB
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> DCHKAB is the test program for the DOUBLE PRECISION LAPACK
*> DSGESV/DSPOSV routine
*>
*> The program must be driven by a short data file. The first 5 records
*> specify problem dimensions and program options using list-directed
*> input. The remaining lines specify the LAPACK test paths and the
*> number of matrix types to use in testing.  An annotated example of a
*> data file can be obtained by deleting the first 3 characters from the
*> following 10 lines:
*> Data file for testing DOUBLE PRECISION LAPACK DSGESV
*> 7                      Number of values of M
*> 0 1 2 3 5 10 16        Values of M (row dimension)
*> 1                      Number of values of NRHS
*> 2                      Values of NRHS (number of right hand sides)
*> 20.0                   Threshold value of test ratio
*> T                      Put T to test the LAPACK routines
*> T                      Put T to test the error exits
*> DGE    11              List types on next line if 0 < NTYPES < 11
*> DPO    9               List types on next line if 0 < NTYPES <  9
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \verbatim
*>  NMAX    INTEGER
*>          The maximum allowable value for N
*>
*>  MAXIN   INTEGER
*>          The number of different values that can be used for each of
*>          M, N, NRHS, NB, and NX
*>
*>  MAXRHS  INTEGER
*>          The maximum number of right hand sides
*>
*>  NIN     INTEGER
*>          The unit number for input
*>
*>  NOUT    INTEGER
*>          The unit number for output
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup double_lin
*
*  =====================================================================
      PROGRAM dchkab
*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            nmax
      parameter( nmax = 132 )
      INTEGER            maxin
      parameter( maxin = 12 )
      INTEGER            maxrhs
      parameter( maxrhs = 16 )
      INTEGER            matmax
      parameter( matmax = 30 )
      INTEGER            nin, nout
      parameter( nin = 5, nout = 6 )
      INTEGER            ldamax
      parameter( ldamax = nmax )
*     ..
*     .. Local Scalars ..
      LOGICAL            fatal, tstdrv, tsterr
      CHARACTER          c1
      CHARACTER*2        c2
      CHARACTER*3        path
      CHARACTER*10       intstr
      CHARACTER*72       aline
      INTEGER            i, ic, k, lda, nm, nmats,
     $                   nns, nrhs, ntypes,
     $                   vers_major, vers_minor, vers_patch
      DOUBLE PRECISION   eps, s1, s2, thresh
      REAL               seps
*     ..
*     .. Local Arrays ..
      LOGICAL            dotype( matmax )
      INTEGER            iwork( nmax ), mval( maxin ), nsval( maxin )
      DOUBLE PRECISION   a( ldamax*nmax, 2 ), b( nmax*maxrhs, 2 ),
     $                   rwork( nmax ), work( nmax*maxrhs*2 )
      REAL               swork(nmax*(nmax+maxrhs))
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   dlamch, dsecnd
      LOGICAL            lsame, lsamen
      REAL               slamch
      EXTERNAL           lsame, lsamen, dlamch, dsecnd, slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           alareq, ddrvab, ddrvac, derrab, derrac,
     $                   ilaver
*     ..
*     .. Scalars in Common ..
      LOGICAL            lerr, ok
      CHARACTER*32       srnamt
      INTEGER            infot, nunit
*     ..
*     .. Common blocks ..
      COMMON             / infoc / infot, nunit, ok, lerr
      COMMON             / srnamc / srnamt
*     ..
*     .. Data statements ..
      DATA               intstr / '0123456789' /
*     ..
*     .. Executable Statements ..
*
      s1 = dsecnd( )
      lda = nmax
      fatal = .false.
*
*     Read a dummy line.
*
      READ( nin, fmt = * )
*
*     Report values of parameters.
*
      CALL ilaver( vers_major, vers_minor, vers_patch )
      WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
*
*     Read the values of M
*
      READ( nin, fmt = * )nm
      IF( nm.LT.1 ) THEN
         WRITE( nout, fmt = 9996 )' NM ', nm, 1
         nm = 0
         fatal = .true.
      ELSE IF( nm.GT.maxin ) THEN
         WRITE( nout, fmt = 9995 )' NM ', nm, maxin
         nm = 0
         fatal = .true.
      END IF
      READ( nin, fmt = * )( mval( i ), i = 1, nm )
      DO 10 i = 1, nm
         IF( mval( i ).LT.0 ) THEN
            WRITE( nout, fmt = 9996 )' M  ', mval( i ), 0
            fatal = .true.
         ELSE IF( mval( i ).GT.nmax ) THEN
            WRITE( nout, fmt = 9995 )' M  ', mval( i ), nmax
            fatal = .true.
         END IF
   10 CONTINUE
      IF( nm.GT.0 )
     $   WRITE( nout, fmt = 9993 )'M   ', ( mval( i ), i = 1, nm )
*
*     Read the values of NRHS
*
      READ( nin, fmt = * )nns
      IF( nns.LT.1 ) THEN
         WRITE( nout, fmt = 9996 )' NNS', nns, 1
         nns = 0
         fatal = .true.
      ELSE IF( nns.GT.maxin ) THEN
         WRITE( nout, fmt = 9995 )' NNS', nns, maxin
         nns = 0
         fatal = .true.
      END IF
      READ( nin, fmt = * )( nsval( i ), i = 1, nns )
      DO 30 i = 1, nns
         IF( nsval( i ).LT.0 ) THEN
            WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
            fatal = .true.
         ELSE IF( nsval( i ).GT.maxrhs ) THEN
            WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
            fatal = .true.
         END IF
   30 CONTINUE
      IF( nns.GT.0 )
     $   WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
*
*     Read the threshold value for the test ratios.
*
      READ( nin, fmt = * )thresh
      WRITE( nout, fmt = 9992 )thresh
*
*     Read the flag that indicates whether to test the driver routine.
*
      READ( nin, fmt = * )tstdrv
*
*     Read the flag that indicates whether to test the error exits.
*
      READ( nin, fmt = * )tsterr
*
      IF( fatal ) THEN
         WRITE( nout, fmt = 9999 )
         stop
      END IF
*
*     Calculate and print the machine dependent constants.
*
      seps = slamch( 'Underflow threshold' )
      WRITE( nout, fmt = 9991 )'(single precision) underflow', seps
      seps = slamch( 'Overflow threshold' )
      WRITE( nout, fmt = 9991 )'(single precision) overflow ', seps
      seps = slamch( 'Epsilon' )
      WRITE( nout, fmt = 9991 )'(single precision) precision', seps
      WRITE( nout, fmt = * )
*
      eps = dlamch( 'Underflow threshold' )
      WRITE( nout, fmt = 9991 )'(double precision) underflow', eps
      eps = dlamch( 'Overflow threshold' )
      WRITE( nout, fmt = 9991 )'(double precision) overflow ', eps
      eps = dlamch( 'Epsilon' )
      WRITE( nout, fmt = 9991 )'(double precision) precision', eps
      WRITE( nout, fmt = * )
*
   80 CONTINUE
*
*     Read a test path and the number of matrix types to use.
*
      READ( nin, fmt = '(A72)', END = 140 )aline
      path = aline( 1: 3 )
      nmats = matmax
      i = 3
   90 CONTINUE
      i = i + 1
      IF( i.GT.72 ) THEN
         nmats = matmax
         GO TO 130
      END IF
      IF( aline( i: i ).EQ.' ' )
     $   GO TO 90
      nmats = 0
  100 CONTINUE
      c1 = aline( i: i )
      DO 110 k = 1, 10
         IF( c1.EQ.intstr( k: k ) ) THEN
            ic = k - 1
            GO TO 120
         END IF
  110 CONTINUE
      GO TO 130
  120 CONTINUE
      nmats = nmats*10 + ic
      i = i + 1
      IF( i.GT.72 )
     $   GO TO 130
      GO TO 100
  130 CONTINUE
      c1 = path( 1: 1 )
      c2 = path( 2: 3 )
      nrhs = nsval( 1 )
*
*     Check first character for correct precision.
*
      IF( .NOT.lsame( c1, 'Double precision' ) ) THEN
         WRITE( nout, fmt = 9990 )path
 
*
      ELSE IF( nmats.LE.0 ) THEN
*
*        Check for a positive number of tests requested.
*
         WRITE( nout, fmt = 9989 )path
         GO TO 140
*
      ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
*
*        GE:  general matrices
*
         ntypes = 11
         CALL alareq( 'DGE', nmats, dotype, ntypes, nin, nout )
*
*        Test the error exits
*
         IF( tsterr )
     $      CALL derrab( nout )
*
         IF( tstdrv ) THEN
            CALL ddrvab( dotype, nm, mval, nns,
     $                   nsval, thresh, lda, a( 1, 1 ),
     $                   a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
     $                   work, rwork, swork, iwork, nout )
         ELSE
            WRITE( nout, fmt = 9989 )'DSGESV'
         END IF
*
      ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
*
*        PO:  positive definite matrices
*
         ntypes = 9
         CALL alareq( 'DPO', nmats, dotype, ntypes, nin, nout )
*
*
         IF( tsterr )
     $      CALL derrac( nout )
*
*
         IF( tstdrv ) THEN
            CALL ddrvac( dotype, nm, mval, nns, nsval,
     $                   thresh, lda, a( 1, 1 ), a( 1, 2 ),
     $                   b( 1, 1 ), b( 1, 2 ),
     $                   work, rwork, swork, nout )
         ELSE
            WRITE( nout, fmt = 9989 )path
         END IF
      ELSE
*
      END IF
*
*     Go back to get another input line.
*
      GO TO 80
*
*     Branch to this line when the last record is read.
*
  140 CONTINUE
      CLOSE ( nin )
      s2 = dsecnd( )
      WRITE( nout, fmt = 9998 )
      WRITE( nout, fmt = 9997 )s2 - s1
*
 9999 FORMAT( / ' Execution not attempted due to input errors' )
 9998 FORMAT( / ' End of tests' )
 9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
 9996 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be >=',
     $      i6 )
 9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
     $      i6 )
 9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV',
     $  ' routines ',
     $      / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
     $      / / ' The following parameter values will be used:' )
 9993 FORMAT( 4x, a4, ':  ', 10i6, / 11x, 10i6 )
 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
     $      'less than', f8.2, / )
 9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
 9990 FORMAT( / 1x, a6, ' routines were not tested' )
 9989 FORMAT( / 1x, a6, ' driver routines were not tested' )
*
*     End of DCHKAB
*
      END