Browse Files
       1
       2
       3
       4
       5
       6
       7
       8
       9
      10
      11
      12
      13
      14
      15
      16
      17
      18
      19
      20
      21
      22
      23
      24
      25
      26
      27
      28
      29
      30
      31
      32
      33
      34
      35
      36
      37
      38
      39
      40
      41
      42
      43
      44
      45
      46
      47
      48
      49
      50
      51
      52
      53
      54
      55
      56
      57
      58
      59
      60
      61
      62
      63
      64
      65
      66
      67
      68
      69
      70
      71
      72
      73
      74
      75
      76
      77
      78
      79
      80
      81
      82
      83
      84
      85
      86
      87
      88
      89
      90
      91
      92
      93
      94
      95
      96
      97
      98
      99
     100
     101
     102
     103
     104
     105
     106
     107
     108
     109
     110
     111
     112
     113
     114
     115
     116
     117
     118
     119
     120
     121
     122
     123
     124
     125
     126
     127
     128
     129
     130
     131
     132
     133
     134
     135
     136
     137
     138
     139
     140
     141
     142
     143
     144
     145
     146
     147
     148
     149
     150
     151
     152
     153
     154
     155
     156
     157
     158
     159
     160
     161
     162
     163
     164
     165
      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