1*> \brief \b ALARQG
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER*3        PATH
15*       INTEGER            NIN, NMATS, NOUT, NTYPES
16*       ..
17*       .. Array Arguments ..
18*       LOGICAL            DOTYPE( * )
19*       ..
20*
21*
22*> \par Purpose:
23*  =============
24*>
25*> \verbatim
26*>
27*> ALARQG handles input for the LAPACK test program.  It is called
28*> to evaluate the input line which requested NMATS matrix types for
29*> PATH.  The flow of control is as follows:
30*>
31*> If NMATS = NTYPES then
32*>    DOTYPE(1:NTYPES) = .TRUE.
33*> else
34*>    Read the next input line for NMATS matrix types
35*>    Set DOTYPE(I) = .TRUE. for each valid type I
36*> endif
37*> \endverbatim
38*
39*  Arguments:
40*  ==========
41*
42*> \param[in] PATH
43*> \verbatim
44*>          PATH is CHARACTER*3
45*>          An LAPACK path name for testing.
46*> \endverbatim
47*>
48*> \param[in] NMATS
49*> \verbatim
50*>          NMATS is INTEGER
51*>          The number of matrix types to be used in testing this path.
52*> \endverbatim
53*>
54*> \param[out] DOTYPE
55*> \verbatim
56*>          DOTYPE is LOGICAL array, dimension (NTYPES)
57*>          The vector of flags indicating if each type will be tested.
58*> \endverbatim
59*>
60*> \param[in] NTYPES
61*> \verbatim
62*>          NTYPES is INTEGER
63*>          The maximum number of matrix types for this path.
64*> \endverbatim
65*>
66*> \param[in] NIN
67*> \verbatim
68*>          NIN is INTEGER
69*>          The unit number for input.  NIN >= 1.
70*> \endverbatim
71*>
72*> \param[in] NOUT
73*> \verbatim
74*>          NOUT is INTEGER
75*>          The unit number for output.  NOUT >= 1.
76*> \endverbatim
77*
78*  Authors:
79*  ========
80*
81*> \author Univ. of Tennessee
82*> \author Univ. of California Berkeley
83*> \author Univ. of Colorado Denver
84*> \author NAG Ltd.
85*
86*> \ingroup aux_eig
87*
88*  =====================================================================
89      SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
90*
91*  -- LAPACK test routine --
92*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
93*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*
95*     .. Scalar Arguments ..
96      CHARACTER*3        PATH
97      INTEGER            NIN, NMATS, NOUT, NTYPES
98*     ..
99*     .. Array Arguments ..
100      LOGICAL            DOTYPE( * )
101*     ..
102*
103* ======================================================================
104*
105*     .. Local Scalars ..
106      LOGICAL            FIRSTT
107      CHARACTER          C1
108      CHARACTER*10       INTSTR
109      CHARACTER*80       LINE
110      INTEGER            I, I1, IC, J, K, LENP, NT
111*     ..
112*     .. Local Arrays ..
113      INTEGER            NREQ( 100 )
114*     ..
115*     .. Intrinsic Functions ..
116      INTRINSIC          LEN
117*     ..
118*     .. Data statements ..
119      DATA               INTSTR / '0123456789' /
120*     ..
121*     .. Executable Statements ..
122*
123      IF( NMATS.GE.NTYPES ) THEN
124*
125*        Test everything if NMATS >= NTYPES.
126*
127         DO 10 I = 1, NTYPES
128            DOTYPE( I ) = .TRUE.
129   10    CONTINUE
130      ELSE
131         DO 20 I = 1, NTYPES
132            DOTYPE( I ) = .FALSE.
133   20    CONTINUE
134         FIRSTT = .TRUE.
135*
136*        Read a line of matrix types if 0 < NMATS < NTYPES.
137*
138         IF( NMATS.GT.0 ) THEN
139            READ( NIN, FMT = '(A80)', END = 90 )LINE
140            LENP = LEN( LINE )
141            I = 0
142            DO 60 J = 1, NMATS
143               NREQ( J ) = 0
144               I1 = 0
145   30          CONTINUE
146               I = I + 1
147               IF( I.GT.LENP ) THEN
148                  IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN
149                     GO TO 60
150                  ELSE
151                     WRITE( NOUT, FMT = 9995 )LINE
152                     WRITE( NOUT, FMT = 9994 )NMATS
153                     GO TO 80
154                  END IF
155               END IF
156               IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN
157                  I1 = I
158                  C1 = LINE( I1: I1 )
159*
160*              Check that a valid integer was read
161*
162                  DO 40 K = 1, 10
163                     IF( C1.EQ.INTSTR( K: K ) ) THEN
164                        IC = K - 1
165                        GO TO 50
166                     END IF
167   40             CONTINUE
168                  WRITE( NOUT, FMT = 9996 )I, LINE
169                  WRITE( NOUT, FMT = 9994 )NMATS
170                  GO TO 80
171   50             CONTINUE
172                  NREQ( J ) = 10*NREQ( J ) + IC
173                  GO TO 30
174               ELSE IF( I1.GT.0 ) THEN
175                  GO TO 60
176               ELSE
177                  GO TO 30
178               END IF
179   60       CONTINUE
180         END IF
181         DO 70 I = 1, NMATS
182            NT = NREQ( I )
183            IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN
184               IF( DOTYPE( NT ) ) THEN
185                  IF( FIRSTT )
186     $               WRITE( NOUT, FMT = * )
187                  FIRSTT = .FALSE.
188                  WRITE( NOUT, FMT = 9997 )NT, PATH
189               END IF
190               DOTYPE( NT ) = .TRUE.
191            ELSE
192               WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES
193 9999          FORMAT( ' *** Invalid type request for ', A3, ', type  ',
194     $               I4, ': must satisfy  1 <= type <= ', I2 )
195            END IF
196   70    CONTINUE
197   80    CONTINUE
198      END IF
199      RETURN
200*
201   90 CONTINUE
202      WRITE( NOUT, FMT = 9998 )PATH
203 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
204     $      'types for ', A3, /' *** Check that you are requesting the',
205     $      ' right number of types for each path', / )
206 9997 FORMAT( ' *** Warning:  duplicate request of matrix type ', I2,
207     $      ' for ', A3 )
208 9996 FORMAT( //' *** Invalid integer value in column ', I2,
209     $      ' of input', ' line:', /A79 )
210 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 )
211 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ',
212     $      'adjust NTYPES on previous line' )
213      WRITE( NOUT, FMT = * )
214      STOP
215*
216*     End of ALARQG
217*
218      END
219