LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ alarqg()

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.

Definition at line 89 of file alarqg.f.

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 *