LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> 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 *> \date November 2011
87 *
88 *> \ingroup aux_eig
89 *
90 * =====================================================================
91  SUBROUTINE alarqg( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
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 *
221  END