LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
alareq.f
Go to the documentation of this file.
1 *> \brief \b ALAREQ
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 ALAREQ( 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 *> ALAREQ 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 *> \ingroup aux_lin
87 *
88 * =====================================================================
89  SUBROUTINE alareq( 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 ALAREQ
217 *
218  END
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:90