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*> \date November 2011
87*
88*> \ingroup aux_eig
89*
90*  =====================================================================
91      SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
92*
93*  -- LAPACK test routine (version 3.4.0) --
94*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
95*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
96*     November 2011
97*
98*     .. Scalar Arguments ..
99      CHARACTER*3        PATH
100      INTEGER            NIN, NMATS, NOUT, NTYPES
101*     ..
102*     .. Array Arguments ..
103      LOGICAL            DOTYPE( * )
104*     ..
105*
106* ======================================================================
107*
108*     .. Local Scalars ..
109      LOGICAL            FIRSTT
110      CHARACTER          C1
111      CHARACTER*10       INTSTR
112      CHARACTER*80       LINE
113      INTEGER            I, I1, IC, J, K, LENP, NT
114*     ..
115*     .. Local Arrays ..
116      INTEGER            NREQ( 100 )
117*     ..
118*     .. Intrinsic Functions ..
119      INTRINSIC          LEN
120*     ..
121*     .. Data statements ..
122      DATA               INTSTR / '0123456789' /
123*     ..
124*     .. Executable Statements ..
125*
126      IF( NMATS.GE.NTYPES ) THEN
127*
128*        Test everything if NMATS >= NTYPES.
129*
130         DO 10 I = 1, NTYPES
131            DOTYPE( I ) = .TRUE.
132   10    CONTINUE
133      ELSE
134         DO 20 I = 1, NTYPES
135            DOTYPE( I ) = .FALSE.
136   20    CONTINUE
137         FIRSTT = .TRUE.
138*
139*        Read a line of matrix types if 0 < NMATS < NTYPES.
140*
141         IF( NMATS.GT.0 ) THEN
142            READ( NIN, FMT = '(A80)', END = 90 )LINE
143            LENP = LEN( LINE )
144            I = 0
145            DO 60 J = 1, NMATS
146               NREQ( J ) = 0
147               I1 = 0
148   30          CONTINUE
149               I = I + 1
150               IF( I.GT.LENP ) THEN
151                  IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN
152                     GO TO 60
153                  ELSE
154                     WRITE( NOUT, FMT = 9995 )LINE
155                     WRITE( NOUT, FMT = 9994 )NMATS
156                     GO TO 80
157                  END IF
158               END IF
159               IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN
160                  I1 = I
161                  C1 = LINE( I1: I1 )
162*
163*              Check that a valid integer was read
164*
165                  DO 40 K = 1, 10
166                     IF( C1.EQ.INTSTR( K: K ) ) THEN
167                        IC = K - 1
168                        GO TO 50
169                     END IF
170   40             CONTINUE
171                  WRITE( NOUT, FMT = 9996 )I, LINE
172                  WRITE( NOUT, FMT = 9994 )NMATS
173                  GO TO 80
174   50             CONTINUE
175                  NREQ( J ) = 10*NREQ( J ) + IC
176                  GO TO 30
177               ELSE IF( I1.GT.0 ) THEN
178                  GO TO 60
179               ELSE
180                  GO TO 30
181               END IF
182   60       CONTINUE
183         END IF
184         DO 70 I = 1, NMATS
185            NT = NREQ( I )
186            IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN
187               IF( DOTYPE( NT ) ) THEN
188                  IF( FIRSTT )
189     $               WRITE( NOUT, FMT = * )
190                  FIRSTT = .FALSE.
191                  WRITE( NOUT, FMT = 9997 )NT, PATH
192               END IF
193               DOTYPE( NT ) = .TRUE.
194            ELSE
195               WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES
196 9999          FORMAT( ' *** Invalid type request for ', A3, ', type  ',
197     $               I4, ': must satisfy  1 <= type <= ', I2 )
198            END IF
199   70    CONTINUE
200   80    CONTINUE
201      END IF
202      RETURN
203*
204   90 CONTINUE
205      WRITE( NOUT, FMT = 9998 )PATH
206 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
207     $      'types for ', A3, /' *** Check that you are requesting the',
208     $      ' right number of types for each path', / )
209 9997 FORMAT( ' *** Warning:  duplicate request of matrix type ', I2,
210     $      ' for ', A3 )
211 9996 FORMAT( //' *** Invalid integer value in column ', I2,
212     $      ' of input', ' line:', /A79 )
213 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 )
214 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ',
215     $      'adjust NTYPES on previous line' )
216      WRITE( NOUT, FMT = * )
217      STOP
218*
219*     End of ALARQG
220*
221      END
222