LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine alarqg ( character*3  PATH,
integer  NMATS,
logical, dimension( * )  DOTYPE,
integer  NTYPES,
integer  NIN,
integer  NOUT 
)

ALARQG

Purpose:
 ALARQG 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
November 2011

Definition at line 92 of file alarqg.f.

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 *