LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
alarqg.f
Go to the documentation of this file.
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*> END IF
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
subroutine alarqg(path, nmats, dotype, ntypes, nin, nout)
ALARQG
Definition alarqg.f:90