1 SUBROUTINE CCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
2 $ THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ,
3 $ BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
11 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
15 REAL RWORK( * )
16 COMPLEX A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
17 $ BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ),
18 $ TAUB( * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CCKGQR tests
25 * CGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B,
26 * CGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B.
27 *
28 * Arguments
29 * =========
30 *
31 * NM (input) INTEGER
32 * The number of values of M contained in the vector MVAL.
33 *
34 * MVAL (input) INTEGER array, dimension (NM)
35 * The values of the matrix row(column) dimension M.
36 *
37 * NP (input) INTEGER
38 * The number of values of P contained in the vector PVAL.
39 *
40 * PVAL (input) INTEGER array, dimension (NP)
41 * The values of the matrix row(column) dimension P.
42 *
43 * NN (input) INTEGER
44 * The number of values of N contained in the vector NVAL.
45 *
46 * NVAL (input) INTEGER array, dimension (NN)
47 * The values of the matrix column(row) dimension N.
48 *
49 * NMATS (input) INTEGER
50 * The number of matrix types to be tested for each combination
51 * of matrix dimensions. If NMATS >= NTYPES (the maximum
52 * number of matrix types), then all the different types are
53 * generated for testing. If NMATS < NTYPES, another input line
54 * is read to get the numbers of the matrix types to be used.
55 *
56 * ISEED (input/output) INTEGER array, dimension (4)
57 * On entry, the seed of the random number generator. The array
58 * elements should be between 0 and 4095, otherwise they will be
59 * reduced mod 4096, and ISEED(4) must be odd.
60 * On exit, the next seed in the random number sequence after
61 * all the test matrices have been generated.
62 *
63 * THRESH (input) REAL
64 * The threshold value for the test ratios. A result is
65 * included in the output file if RESULT >= THRESH. To have
66 * every test ratio printed, use THRESH = 0.
67 *
68 * NMAX (input) INTEGER
69 * The maximum value permitted for M or N, used in dimensioning
70 * the work arrays.
71 *
72 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
73 *
74 * AF (workspace) COMPLEX array, dimension (NMAX*NMAX)
75 *
76 * AQ (workspace) COMPLEX array, dimension (NMAX*NMAX)
77 *
78 * AR (workspace) COMPLEX array, dimension (NMAX*NMAX)
79 *
80 * TAUA (workspace) COMPLEX array, dimension (NMAX)
81 *
82 * B (workspace) COMPLEX array, dimension (NMAX*NMAX)
83 *
84 * BF (workspace) COMPLEX array, dimension (NMAX*NMAX)
85 *
86 * BZ (workspace) COMPLEX array, dimension (NMAX*NMAX)
87 *
88 * BT (workspace) COMPLEX array, dimension (NMAX*NMAX)
89 *
90 * BWK (workspace) COMPLEX array, dimension (NMAX*NMAX)
91 *
92 * TAUB (workspace) COMPLEX array, dimension (NMAX)
93 *
94 * WORK (workspace) COMPLEX array, dimension (NMAX*NMAX)
95 *
96 * RWORK (workspace) REAL array, dimension (NMAX)
97 *
98 * NIN (input) INTEGER
99 * The unit number for input.
100 *
101 * NOUT (input) INTEGER
102 * The unit number for output.
103 *
104 * INFO (output) INTEGER
105 * = 0 : successful exit
106 * > 0 : If CLATMS returns an error code, the absolute value
107 * of it is returned.
108 *
109 * =====================================================================
110 *
111 * .. Parameters ..
112 INTEGER NTESTS
113 PARAMETER ( NTESTS = 7 )
114 INTEGER NTYPES
115 PARAMETER ( NTYPES = 8 )
116 * ..
117 * .. Local Scalars ..
118 LOGICAL FIRSTT
119 CHARACTER DISTA, DISTB, TYPE
120 CHARACTER*3 PATH
121 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
122 $ LDA, LDB, LWORK, M, MODEA, MODEB, N, NFAIL,
123 $ NRUN, NT, P
124 REAL ANORM, BNORM, CNDNMA, CNDNMB
125 * ..
126 * .. Local Arrays ..
127 LOGICAL DOTYPE( NTYPES )
128 REAL RESULT( NTESTS )
129 * ..
130 * .. External Subroutines ..
131 EXTERNAL ALAHDG, ALAREQ, ALASUM, CGQRTS, CGRQTS, CLATMS,
132 $ SLATB9
133 * ..
134 * .. Intrinsic Functions ..
135 INTRINSIC ABS
136 * ..
137 * .. Executable Statements ..
138 *
139 * Initialize constants.
140 *
141 PATH( 1: 3 ) = 'GQR'
142 INFO = 0
143 NRUN = 0
144 NFAIL = 0
145 FIRSTT = .TRUE.
146 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
147 LDA = NMAX
148 LDB = NMAX
149 LWORK = NMAX*NMAX
150 *
151 * Do for each value of M in MVAL.
152 *
153 DO 60 IM = 1, NM
154 M = MVAL( IM )
155 *
156 * Do for each value of P in PVAL.
157 *
158 DO 50 IP = 1, NP
159 P = PVAL( IP )
160 *
161 * Do for each value of N in NVAL.
162 *
163 DO 40 IN = 1, NN
164 N = NVAL( IN )
165 *
166 DO 30 IMAT = 1, NTYPES
167 *
168 * Do the tests only if DOTYPE( IMAT ) is true.
169 *
170 IF( .NOT.DOTYPE( IMAT ) )
171 $ GO TO 30
172 *
173 * Test CGGRQF
174 *
175 * Set up parameters with SLATB9 and generate test
176 * matrices A and B with CLATMS.
177 *
178 CALL SLATB9( 'GRQ', IMAT, M, P, N, TYPE, KLA, KUA,
179 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
180 $ CNDNMA, CNDNMB, DISTA, DISTB )
181 *
182 CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA,
183 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A,
184 $ LDA, WORK, IINFO )
185 IF( IINFO.NE.0 ) THEN
186 WRITE( NOUT, FMT = 9999 )IINFO
187 INFO = ABS( IINFO )
188 GO TO 30
189 END IF
190 *
191 CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB,
192 $ CNDNMB, BNORM, KLB, KUB, 'No packing', B,
193 $ LDB, WORK, IINFO )
194 IF( IINFO.NE.0 ) THEN
195 WRITE( NOUT, FMT = 9999 )IINFO
196 INFO = ABS( IINFO )
197 GO TO 30
198 END IF
199 *
200 NT = 4
201 *
202 CALL CGRQTS( M, P, N, A, AF, AQ, AR, LDA, TAUA, B, BF,
203 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK,
204 $ RWORK, RESULT )
205 *
206 * Print information about the tests that did not
207 * pass the threshold.
208 *
209 DO 10 I = 1, NT
210 IF( RESULT( I ).GE.THRESH ) THEN
211 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
212 FIRSTT = .FALSE.
213 CALL ALAHDG( NOUT, 'GRQ' )
214 END IF
215 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
216 $ RESULT( I )
217 NFAIL = NFAIL + 1
218 END IF
219 10 CONTINUE
220 NRUN = NRUN + NT
221 *
222 * Test CGGQRF
223 *
224 * Set up parameters with SLATB9 and generate test
225 * matrices A and B with CLATMS.
226 *
227 CALL SLATB9( 'GQR', IMAT, M, P, N, TYPE, KLA, KUA,
228 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
229 $ CNDNMA, CNDNMB, DISTA, DISTB )
230 *
231 CALL CLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA,
232 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A,
233 $ LDA, WORK, IINFO )
234 IF( IINFO.NE.0 ) THEN
235 WRITE( NOUT, FMT = 9999 )IINFO
236 INFO = ABS( IINFO )
237 GO TO 30
238 END IF
239 *
240 CALL CLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEA,
241 $ CNDNMA, BNORM, KLB, KUB, 'No packing', B,
242 $ LDB, WORK, IINFO )
243 IF( IINFO.NE.0 ) THEN
244 WRITE( NOUT, FMT = 9999 )IINFO
245 INFO = ABS( IINFO )
246 GO TO 30
247 END IF
248 *
249 NT = 4
250 *
251 CALL CGQRTS( N, M, P, A, AF, AQ, AR, LDA, TAUA, B, BF,
252 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK,
253 $ RWORK, RESULT )
254 *
255 * Print information about the tests that did not
256 * pass the threshold.
257 *
258 DO 20 I = 1, NT
259 IF( RESULT( I ).GE.THRESH ) THEN
260 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
261 FIRSTT = .FALSE.
262 CALL ALAHDG( NOUT, PATH )
263 END IF
264 WRITE( NOUT, FMT = 9997 )N, M, P, IMAT, I,
265 $ RESULT( I )
266 NFAIL = NFAIL + 1
267 END IF
268 20 CONTINUE
269 NRUN = NRUN + NT
270 *
271 30 CONTINUE
272 40 CONTINUE
273 50 CONTINUE
274 60 CONTINUE
275 *
276 * Print a summary of the results.
277 *
278 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
279 *
280 9999 FORMAT( ' CLATMS in CCKGQR: INFO = ', I5 )
281 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
282 $ ', test ', I2, ', ratio=', G13.6 )
283 9997 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
284 $ ', test ', I2, ', ratio=', G13.6 )
285 RETURN
286 *
287 * End of CCKGQR
288 *
289 END
2 $ THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ,
3 $ BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
11 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
15 REAL RWORK( * )
16 COMPLEX A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
17 $ BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ),
18 $ TAUB( * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CCKGQR tests
25 * CGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B,
26 * CGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B.
27 *
28 * Arguments
29 * =========
30 *
31 * NM (input) INTEGER
32 * The number of values of M contained in the vector MVAL.
33 *
34 * MVAL (input) INTEGER array, dimension (NM)
35 * The values of the matrix row(column) dimension M.
36 *
37 * NP (input) INTEGER
38 * The number of values of P contained in the vector PVAL.
39 *
40 * PVAL (input) INTEGER array, dimension (NP)
41 * The values of the matrix row(column) dimension P.
42 *
43 * NN (input) INTEGER
44 * The number of values of N contained in the vector NVAL.
45 *
46 * NVAL (input) INTEGER array, dimension (NN)
47 * The values of the matrix column(row) dimension N.
48 *
49 * NMATS (input) INTEGER
50 * The number of matrix types to be tested for each combination
51 * of matrix dimensions. If NMATS >= NTYPES (the maximum
52 * number of matrix types), then all the different types are
53 * generated for testing. If NMATS < NTYPES, another input line
54 * is read to get the numbers of the matrix types to be used.
55 *
56 * ISEED (input/output) INTEGER array, dimension (4)
57 * On entry, the seed of the random number generator. The array
58 * elements should be between 0 and 4095, otherwise they will be
59 * reduced mod 4096, and ISEED(4) must be odd.
60 * On exit, the next seed in the random number sequence after
61 * all the test matrices have been generated.
62 *
63 * THRESH (input) REAL
64 * The threshold value for the test ratios. A result is
65 * included in the output file if RESULT >= THRESH. To have
66 * every test ratio printed, use THRESH = 0.
67 *
68 * NMAX (input) INTEGER
69 * The maximum value permitted for M or N, used in dimensioning
70 * the work arrays.
71 *
72 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
73 *
74 * AF (workspace) COMPLEX array, dimension (NMAX*NMAX)
75 *
76 * AQ (workspace) COMPLEX array, dimension (NMAX*NMAX)
77 *
78 * AR (workspace) COMPLEX array, dimension (NMAX*NMAX)
79 *
80 * TAUA (workspace) COMPLEX array, dimension (NMAX)
81 *
82 * B (workspace) COMPLEX array, dimension (NMAX*NMAX)
83 *
84 * BF (workspace) COMPLEX array, dimension (NMAX*NMAX)
85 *
86 * BZ (workspace) COMPLEX array, dimension (NMAX*NMAX)
87 *
88 * BT (workspace) COMPLEX array, dimension (NMAX*NMAX)
89 *
90 * BWK (workspace) COMPLEX array, dimension (NMAX*NMAX)
91 *
92 * TAUB (workspace) COMPLEX array, dimension (NMAX)
93 *
94 * WORK (workspace) COMPLEX array, dimension (NMAX*NMAX)
95 *
96 * RWORK (workspace) REAL array, dimension (NMAX)
97 *
98 * NIN (input) INTEGER
99 * The unit number for input.
100 *
101 * NOUT (input) INTEGER
102 * The unit number for output.
103 *
104 * INFO (output) INTEGER
105 * = 0 : successful exit
106 * > 0 : If CLATMS returns an error code, the absolute value
107 * of it is returned.
108 *
109 * =====================================================================
110 *
111 * .. Parameters ..
112 INTEGER NTESTS
113 PARAMETER ( NTESTS = 7 )
114 INTEGER NTYPES
115 PARAMETER ( NTYPES = 8 )
116 * ..
117 * .. Local Scalars ..
118 LOGICAL FIRSTT
119 CHARACTER DISTA, DISTB, TYPE
120 CHARACTER*3 PATH
121 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
122 $ LDA, LDB, LWORK, M, MODEA, MODEB, N, NFAIL,
123 $ NRUN, NT, P
124 REAL ANORM, BNORM, CNDNMA, CNDNMB
125 * ..
126 * .. Local Arrays ..
127 LOGICAL DOTYPE( NTYPES )
128 REAL RESULT( NTESTS )
129 * ..
130 * .. External Subroutines ..
131 EXTERNAL ALAHDG, ALAREQ, ALASUM, CGQRTS, CGRQTS, CLATMS,
132 $ SLATB9
133 * ..
134 * .. Intrinsic Functions ..
135 INTRINSIC ABS
136 * ..
137 * .. Executable Statements ..
138 *
139 * Initialize constants.
140 *
141 PATH( 1: 3 ) = 'GQR'
142 INFO = 0
143 NRUN = 0
144 NFAIL = 0
145 FIRSTT = .TRUE.
146 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
147 LDA = NMAX
148 LDB = NMAX
149 LWORK = NMAX*NMAX
150 *
151 * Do for each value of M in MVAL.
152 *
153 DO 60 IM = 1, NM
154 M = MVAL( IM )
155 *
156 * Do for each value of P in PVAL.
157 *
158 DO 50 IP = 1, NP
159 P = PVAL( IP )
160 *
161 * Do for each value of N in NVAL.
162 *
163 DO 40 IN = 1, NN
164 N = NVAL( IN )
165 *
166 DO 30 IMAT = 1, NTYPES
167 *
168 * Do the tests only if DOTYPE( IMAT ) is true.
169 *
170 IF( .NOT.DOTYPE( IMAT ) )
171 $ GO TO 30
172 *
173 * Test CGGRQF
174 *
175 * Set up parameters with SLATB9 and generate test
176 * matrices A and B with CLATMS.
177 *
178 CALL SLATB9( 'GRQ', IMAT, M, P, N, TYPE, KLA, KUA,
179 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
180 $ CNDNMA, CNDNMB, DISTA, DISTB )
181 *
182 CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA,
183 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A,
184 $ LDA, WORK, IINFO )
185 IF( IINFO.NE.0 ) THEN
186 WRITE( NOUT, FMT = 9999 )IINFO
187 INFO = ABS( IINFO )
188 GO TO 30
189 END IF
190 *
191 CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB,
192 $ CNDNMB, BNORM, KLB, KUB, 'No packing', B,
193 $ LDB, WORK, IINFO )
194 IF( IINFO.NE.0 ) THEN
195 WRITE( NOUT, FMT = 9999 )IINFO
196 INFO = ABS( IINFO )
197 GO TO 30
198 END IF
199 *
200 NT = 4
201 *
202 CALL CGRQTS( M, P, N, A, AF, AQ, AR, LDA, TAUA, B, BF,
203 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK,
204 $ RWORK, RESULT )
205 *
206 * Print information about the tests that did not
207 * pass the threshold.
208 *
209 DO 10 I = 1, NT
210 IF( RESULT( I ).GE.THRESH ) THEN
211 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
212 FIRSTT = .FALSE.
213 CALL ALAHDG( NOUT, 'GRQ' )
214 END IF
215 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
216 $ RESULT( I )
217 NFAIL = NFAIL + 1
218 END IF
219 10 CONTINUE
220 NRUN = NRUN + NT
221 *
222 * Test CGGQRF
223 *
224 * Set up parameters with SLATB9 and generate test
225 * matrices A and B with CLATMS.
226 *
227 CALL SLATB9( 'GQR', IMAT, M, P, N, TYPE, KLA, KUA,
228 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
229 $ CNDNMA, CNDNMB, DISTA, DISTB )
230 *
231 CALL CLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA,
232 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A,
233 $ LDA, WORK, IINFO )
234 IF( IINFO.NE.0 ) THEN
235 WRITE( NOUT, FMT = 9999 )IINFO
236 INFO = ABS( IINFO )
237 GO TO 30
238 END IF
239 *
240 CALL CLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEA,
241 $ CNDNMA, BNORM, KLB, KUB, 'No packing', B,
242 $ LDB, WORK, IINFO )
243 IF( IINFO.NE.0 ) THEN
244 WRITE( NOUT, FMT = 9999 )IINFO
245 INFO = ABS( IINFO )
246 GO TO 30
247 END IF
248 *
249 NT = 4
250 *
251 CALL CGQRTS( N, M, P, A, AF, AQ, AR, LDA, TAUA, B, BF,
252 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK,
253 $ RWORK, RESULT )
254 *
255 * Print information about the tests that did not
256 * pass the threshold.
257 *
258 DO 20 I = 1, NT
259 IF( RESULT( I ).GE.THRESH ) THEN
260 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
261 FIRSTT = .FALSE.
262 CALL ALAHDG( NOUT, PATH )
263 END IF
264 WRITE( NOUT, FMT = 9997 )N, M, P, IMAT, I,
265 $ RESULT( I )
266 NFAIL = NFAIL + 1
267 END IF
268 20 CONTINUE
269 NRUN = NRUN + NT
270 *
271 30 CONTINUE
272 40 CONTINUE
273 50 CONTINUE
274 60 CONTINUE
275 *
276 * Print a summary of the results.
277 *
278 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
279 *
280 9999 FORMAT( ' CLATMS in CCKGQR: INFO = ', I5 )
281 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
282 $ ', test ', I2, ', ratio=', G13.6 )
283 9997 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
284 $ ', test ', I2, ', ratio=', G13.6 )
285 RETURN
286 *
287 * End of CCKGQR
288 *
289 END