LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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
 END IF
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*