alareq()

subroutine alareq	(	character*3	PATH,
		integer	NMATS,
		logical, dimension( * )	DOTYPE,
		integer	NTYPES,
		integer	NIN,
		integer	NOUT
	)

ALAREQ

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

Parameters

[in]	PATH	PATH is CHARACTER*3 An LAPACK path name for testing.
[in]	NMATS	NMATS is INTEGER The number of matrix types to be used in testing this path.
[out]	DOTYPE	DOTYPE is LOGICAL array, dimension (NTYPES) The vector of flags indicating if each type will be tested.
[in]	NTYPES	NTYPES is INTEGER The maximum number of matrix types for this path.
[in]	NIN	NIN is INTEGER The unit number for input. NIN >= 1.
[in]	NOUT	NOUT is INTEGER The unit number for output. NOUT >= 1.

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Date

December 2016

Definition at line 92 of file alareq.f.

*
*  -- LAPACK test routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      CHARACTER*3        PATH
      INTEGER            NIN, NMATS, NOUT, NTYPES
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * )
*     ..
*
*  =====================================================================
*
*     .. 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
*

Here is the caller graph for this function: