alareq.f

Go to the documentation of this file.

      SUBROUTINE alareq( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      CHARACTER*3        path
      INTEGER            nin, nmats, nout, ntypes
*     ..
*     .. Array Arguments ..
      LOGICAL            dotype( * )
*     ..
*
*  Purpose
*  =======
*
*  ALAREQ handles input for the LAPACK test program.  It is called
*  to evaluate the input line which requested NMATS matrix types for
*  PATH.  The flow of control is as follows:
*
*  If NMATS = NTYPES then
*     DOTYPE(1:NTYPES) = .TRUE.
*  else
*     Read the next input line for NMATS matrix types
*     Set DOTYPE(I) = .TRUE. for each valid type I
*  endif
*
*  Arguments
*  =========
*
*  PATH    (input) CHARACTER*3
*          An LAPACK path name for testing.
*
*  NMATS   (input) INTEGER
*          The number of matrix types to be used in testing this path.
*
*  DOTYPE  (output) LOGICAL array, dimension (NTYPES)
*          The vector of flags indicating if each type will be tested.
*
*  NTYPES  (input) INTEGER
*          The maximum number of matrix types for this path.
*
*  NIN     (input) INTEGER
*          The unit number for input.  NIN >= 1.
*
*  NOUT    (input) INTEGER
*          The unit number for output.  NOUT >= 1.
*
*  =====================================================================
*
*     .. Local Scalars ..
      LOGICAL            firstt
      CHARACTER          c1
      CHARACTER*10       intstr
      CHARACTER*80       line
      INTEGER            i, i1, ic, j, k, lenp, nt
*     ..
*     .. Local Arrays ..
      INTEGER            nreq( 100 )
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          len
*     ..
*     .. Data statements ..
      DATA               intstr / '0123456789' /
*     ..
*     .. Executable Statements ..
*
      IF( nmats.GE.ntypes ) THEN
*
*        Test everything if NMATS >= NTYPES.
*
         DO 10 i = 1, ntypes
            dotype( i ) = .true.
   10    continue
      ELSE
         DO 20 i = 1, ntypes
            dotype( i ) = .false.
   20    continue
         firstt = .true.
*
*        Read a line of matrix types if 0 < NMATS < NTYPES.
*
         IF( nmats.GT.0 ) THEN
            READ( nin, fmt = '(A80)', END = 90 )line
            lenp = len( line )
            i = 0
            DO 60 j = 1, nmats
               nreq( j ) = 0
               i1 = 0
   30          continue
               i = i + 1
               IF( i.GT.lenp ) THEN
                  IF( j.EQ.nmats .AND. i1.GT.0 ) THEN
                     go to 60
                  ELSE
                     WRITE( nout, fmt = 9995 )line
                     WRITE( nout, fmt = 9994 )nmats
                     go to 80
                  END IF
               END IF
               IF( line( i: i ).NE.' ' .AND. line( i: i ).NE.',' ) THEN
                  i1 = i
                  c1 = line( i1: i1 )
*
*              Check that a valid integer was read
*
                  DO 40 k = 1, 10
                     IF( c1.EQ.intstr( k: k ) ) THEN
                        ic = k - 1
                        go to 50
                     END IF
   40             continue
                  WRITE( nout, fmt = 9996 )i, line
                  WRITE( nout, fmt = 9994 )nmats
                  go to 80
   50             continue
                  nreq( j ) = 10*nreq( j ) + ic
                  go to 30
               ELSE IF( i1.GT.0 ) THEN
                  go to 60
               ELSE
                  go to 30
               END IF
   60       continue
         END IF
         DO 70 i = 1, nmats
            nt = nreq( i )
            IF( nt.GT.0 .AND. nt.LE.ntypes ) THEN
               IF( dotype( nt ) ) THEN
                  IF( firstt )
     $               WRITE( nout, fmt = * )
                  firstt = .false.
                  WRITE( nout, fmt = 9997 )nt, path
               END IF
               dotype( nt ) = .true.
            ELSE
               WRITE( nout, fmt = 9999 )path, nt, ntypes
 9999          format( ' *** Invalid type request for ', a3, ', type  ',
     $               i4, ': must satisfy  1 <= type <= ', i2 )
            END IF
   70    continue
   80    continue
      END IF
      return
*
   90 continue
      WRITE( nout, fmt = 9998 )path
 9998 format( /' *** End of file reached when trying to read matrix ',
     $      'types for ', a3, /' *** Check that you are requesting the',
     $      ' right number of types for each path', / )
 9997 format( ' *** Warning:  duplicate request of matrix type ', i2,
     $      ' for ', a3 )
 9996 format( //' *** Invalid integer value in column ', i2,
     $      ' of input', ' line:', /a79 )
 9995 format( //' *** Not enough matrix types on input line', /a79 )
 9994 format( ' ==> Specify ', i4, ' matrix types on this line or ',
     $      'adjust NTYPES on previous line' )
      WRITE( nout, fmt = * )
      stop
*
*     End of ALAREQ
*
      END