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