1 SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NIN, NMATS, NOUT, NTYPES
10 * ..
11 * .. Array Arguments ..
12 LOGICAL DOTYPE( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * ALARQG handles input for the LAPACK test program. It is called
19 * to evaluate the input line which requested NMATS matrix types for
20 * PATH. The flow of control is as follows:
21 *
22 * If NMATS = NTYPES then
23 * DOTYPE(1:NTYPES) = .TRUE.
24 * else
25 * Read the next input line for NMATS matrix types
26 * Set DOTYPE(I) = .TRUE. for each valid type I
27 * endif
28 *
29 * Arguments
30 * =========
31 *
32 * PATH (input) CHARACTER*3
33 * An LAPACK path name for testing.
34 *
35 * NMATS (input) INTEGER
36 * The number of matrix types to be used in testing this path.
37 *
38 * DOTYPE (output) LOGICAL array, dimension (NTYPES)
39 * The vector of flags indicating if each type will be tested.
40 *
41 * NTYPES (input) INTEGER
42 * The maximum number of matrix types for this path.
43 *
44 * NIN (input) INTEGER
45 * The unit number for input. NIN >= 1.
46 *
47 * NOUT (input) INTEGER
48 * The unit number for output. NOUT >= 1.
49 *
50 * ======================================================================
51 *
52 * .. Local Scalars ..
53 LOGICAL FIRSTT
54 CHARACTER C1
55 CHARACTER*10 INTSTR
56 CHARACTER*80 LINE
57 INTEGER I, I1, IC, J, K, LENP, NT
58 * ..
59 * .. Local Arrays ..
60 INTEGER NREQ( 100 )
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC LEN
64 * ..
65 * .. Data statements ..
66 DATA INTSTR / '0123456789' /
67 * ..
68 * .. Executable Statements ..
69 *
70 IF( NMATS.GE.NTYPES ) THEN
71 *
72 * Test everything if NMATS >= NTYPES.
73 *
74 DO 10 I = 1, NTYPES
75 DOTYPE( I ) = .TRUE.
76 10 CONTINUE
77 ELSE
78 DO 20 I = 1, NTYPES
79 DOTYPE( I ) = .FALSE.
80 20 CONTINUE
81 FIRSTT = .TRUE.
82 *
83 * Read a line of matrix types if 0 < NMATS < NTYPES.
84 *
85 IF( NMATS.GT.0 ) THEN
86 READ( NIN, FMT = '(A80)', END = 90 )LINE
87 LENP = LEN( LINE )
88 I = 0
89 DO 60 J = 1, NMATS
90 NREQ( J ) = 0
91 I1 = 0
92 30 CONTINUE
93 I = I + 1
94 IF( I.GT.LENP ) THEN
95 IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN
96 GO TO 60
97 ELSE
98 WRITE( NOUT, FMT = 9995 )LINE
99 WRITE( NOUT, FMT = 9994 )NMATS
100 GO TO 80
101 END IF
102 END IF
103 IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN
104 I1 = I
105 C1 = LINE( I1: I1 )
106 *
107 * Check that a valid integer was read
108 *
109 DO 40 K = 1, 10
110 IF( C1.EQ.INTSTR( K: K ) ) THEN
111 IC = K - 1
112 GO TO 50
113 END IF
114 40 CONTINUE
115 WRITE( NOUT, FMT = 9996 )I, LINE
116 WRITE( NOUT, FMT = 9994 )NMATS
117 GO TO 80
118 50 CONTINUE
119 NREQ( J ) = 10*NREQ( J ) + IC
120 GO TO 30
121 ELSE IF( I1.GT.0 ) THEN
122 GO TO 60
123 ELSE
124 GO TO 30
125 END IF
126 60 CONTINUE
127 END IF
128 DO 70 I = 1, NMATS
129 NT = NREQ( I )
130 IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN
131 IF( DOTYPE( NT ) ) THEN
132 IF( FIRSTT )
133 $ WRITE( NOUT, FMT = * )
134 FIRSTT = .FALSE.
135 WRITE( NOUT, FMT = 9997 )NT, PATH
136 END IF
137 DOTYPE( NT ) = .TRUE.
138 ELSE
139 WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES
140 9999 FORMAT( ' *** Invalid type request for ', A3, ', type ',
141 $ I4, ': must satisfy 1 <= type <= ', I2 )
142 END IF
143 70 CONTINUE
144 80 CONTINUE
145 END IF
146 RETURN
147 *
148 90 CONTINUE
149 WRITE( NOUT, FMT = 9998 )PATH
150 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
151 $ 'types for ', A3, /' *** Check that you are requesting the',
152 $ ' right number of types for each path', / )
153 9997 FORMAT( ' *** Warning: duplicate request of matrix type ', I2,
154 $ ' for ', A3 )
155 9996 FORMAT( //' *** Invalid integer value in column ', I2,
156 $ ' of input', ' line:', /A79 )
157 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 )
158 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ',
159 $ 'adjust NTYPES on previous line' )
160 WRITE( NOUT, FMT = * )
161 STOP
162 *
163 * End of ALARQG
164 *
165 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NIN, NMATS, NOUT, NTYPES
10 * ..
11 * .. Array Arguments ..
12 LOGICAL DOTYPE( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * ALARQG handles input for the LAPACK test program. It is called
19 * to evaluate the input line which requested NMATS matrix types for
20 * PATH. The flow of control is as follows:
21 *
22 * If NMATS = NTYPES then
23 * DOTYPE(1:NTYPES) = .TRUE.
24 * else
25 * Read the next input line for NMATS matrix types
26 * Set DOTYPE(I) = .TRUE. for each valid type I
27 * endif
28 *
29 * Arguments
30 * =========
31 *
32 * PATH (input) CHARACTER*3
33 * An LAPACK path name for testing.
34 *
35 * NMATS (input) INTEGER
36 * The number of matrix types to be used in testing this path.
37 *
38 * DOTYPE (output) LOGICAL array, dimension (NTYPES)
39 * The vector of flags indicating if each type will be tested.
40 *
41 * NTYPES (input) INTEGER
42 * The maximum number of matrix types for this path.
43 *
44 * NIN (input) INTEGER
45 * The unit number for input. NIN >= 1.
46 *
47 * NOUT (input) INTEGER
48 * The unit number for output. NOUT >= 1.
49 *
50 * ======================================================================
51 *
52 * .. Local Scalars ..
53 LOGICAL FIRSTT
54 CHARACTER C1
55 CHARACTER*10 INTSTR
56 CHARACTER*80 LINE
57 INTEGER I, I1, IC, J, K, LENP, NT
58 * ..
59 * .. Local Arrays ..
60 INTEGER NREQ( 100 )
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC LEN
64 * ..
65 * .. Data statements ..
66 DATA INTSTR / '0123456789' /
67 * ..
68 * .. Executable Statements ..
69 *
70 IF( NMATS.GE.NTYPES ) THEN
71 *
72 * Test everything if NMATS >= NTYPES.
73 *
74 DO 10 I = 1, NTYPES
75 DOTYPE( I ) = .TRUE.
76 10 CONTINUE
77 ELSE
78 DO 20 I = 1, NTYPES
79 DOTYPE( I ) = .FALSE.
80 20 CONTINUE
81 FIRSTT = .TRUE.
82 *
83 * Read a line of matrix types if 0 < NMATS < NTYPES.
84 *
85 IF( NMATS.GT.0 ) THEN
86 READ( NIN, FMT = '(A80)', END = 90 )LINE
87 LENP = LEN( LINE )
88 I = 0
89 DO 60 J = 1, NMATS
90 NREQ( J ) = 0
91 I1 = 0
92 30 CONTINUE
93 I = I + 1
94 IF( I.GT.LENP ) THEN
95 IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN
96 GO TO 60
97 ELSE
98 WRITE( NOUT, FMT = 9995 )LINE
99 WRITE( NOUT, FMT = 9994 )NMATS
100 GO TO 80
101 END IF
102 END IF
103 IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN
104 I1 = I
105 C1 = LINE( I1: I1 )
106 *
107 * Check that a valid integer was read
108 *
109 DO 40 K = 1, 10
110 IF( C1.EQ.INTSTR( K: K ) ) THEN
111 IC = K - 1
112 GO TO 50
113 END IF
114 40 CONTINUE
115 WRITE( NOUT, FMT = 9996 )I, LINE
116 WRITE( NOUT, FMT = 9994 )NMATS
117 GO TO 80
118 50 CONTINUE
119 NREQ( J ) = 10*NREQ( J ) + IC
120 GO TO 30
121 ELSE IF( I1.GT.0 ) THEN
122 GO TO 60
123 ELSE
124 GO TO 30
125 END IF
126 60 CONTINUE
127 END IF
128 DO 70 I = 1, NMATS
129 NT = NREQ( I )
130 IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN
131 IF( DOTYPE( NT ) ) THEN
132 IF( FIRSTT )
133 $ WRITE( NOUT, FMT = * )
134 FIRSTT = .FALSE.
135 WRITE( NOUT, FMT = 9997 )NT, PATH
136 END IF
137 DOTYPE( NT ) = .TRUE.
138 ELSE
139 WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES
140 9999 FORMAT( ' *** Invalid type request for ', A3, ', type ',
141 $ I4, ': must satisfy 1 <= type <= ', I2 )
142 END IF
143 70 CONTINUE
144 80 CONTINUE
145 END IF
146 RETURN
147 *
148 90 CONTINUE
149 WRITE( NOUT, FMT = 9998 )PATH
150 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
151 $ 'types for ', A3, /' *** Check that you are requesting the',
152 $ ' right number of types for each path', / )
153 9997 FORMAT( ' *** Warning: duplicate request of matrix type ', I2,
154 $ ' for ', A3 )
155 9996 FORMAT( //' *** Invalid integer value in column ', I2,
156 $ ' of input', ' line:', /A79 )
157 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 )
158 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ',
159 $ 'adjust NTYPES on previous line' )
160 WRITE( NOUT, FMT = * )
161 STOP
162 *
163 * End of ALARQG
164 *
165 END