1 SUBROUTINE ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
2 $ THRESH, A, COPYA, S, COPYS, TAU, WORK, RWORK,
3 $ IWORK, NOUT )
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 NM, NN, NNB, NOUT
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 LOGICAL DOTYPE( * )
15 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
16 $ NXVAL( * )
17 DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * )
18 COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZCHKQ3 tests ZGEQP3.
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NM (input) INTEGER
35 * The number of values of M contained in the vector MVAL.
36 *
37 * MVAL (input) INTEGER array, dimension (NM)
38 * The values of the matrix row dimension M.
39 *
40 * NN (input) INTEGER
41 * The number of values of N contained in the vector NVAL.
42 *
43 * NVAL (input) INTEGER array, dimension (NN)
44 * The values of the matrix column dimension N.
45 *
46 * NNB (input) INTEGER
47 * The number of values of NB and NX contained in the
48 * vectors NBVAL and NXVAL. The blocking parameters are used
49 * in pairs (NB,NX).
50 *
51 * NBVAL (input) INTEGER array, dimension (NNB)
52 * The values of the blocksize NB.
53 *
54 * NXVAL (input) INTEGER array, dimension (NNB)
55 * The values of the crossover point NX.
56 *
57 * THRESH (input) DOUBLE PRECISION
58 * The threshold value for the test ratios. A result is
59 * included in the output file if RESULT >= THRESH. To have
60 * every test ratio printed, use THRESH = 0.
61 *
62 * A (workspace) COMPLEX*16 array, dimension (MMAX*NMAX)
63 * where MMAX is the maximum value of M in MVAL and NMAX is the
64 * maximum value of N in NVAL.
65 *
66 * COPYA (workspace) COMPLEX*16 array, dimension (MMAX*NMAX)
67 *
68 * S (workspace) DOUBLE PRECISION array, dimension
69 * (min(MMAX,NMAX))
70 *
71 * COPYS (workspace) DOUBLE PRECISION array, dimension
72 * (min(MMAX,NMAX))
73 *
74 * TAU (workspace) COMPLEX*16 array, dimension (MMAX)
75 *
76 * WORK (workspace) COMPLEX*16 array, dimension
77 * (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
78 *
79 * RWORK (workspace) DOUBLE PRECISION array, dimension (4*NMAX)
80 *
81 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
82 *
83 * NOUT (input) INTEGER
84 * The unit number for output.
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 INTEGER NTYPES
90 PARAMETER ( NTYPES = 6 )
91 INTEGER NTESTS
92 PARAMETER ( NTESTS = 3 )
93 DOUBLE PRECISION ONE, ZERO
94 COMPLEX*16 CZERO
95 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0,
96 $ CZERO = ( 0.0D+0, 0.0D+0 ) )
97 * ..
98 * .. Local Scalars ..
99 CHARACTER*3 PATH
100 INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO,
101 $ ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N,
102 $ NB, NERRS, NFAIL, NRUN, NX
103 DOUBLE PRECISION EPS
104 * ..
105 * .. Local Arrays ..
106 INTEGER ISEED( 4 ), ISEEDY( 4 )
107 DOUBLE PRECISION RESULT( NTESTS )
108 * ..
109 * .. External Functions ..
110 DOUBLE PRECISION DLAMCH, ZQPT01, ZQRT11, ZQRT12
111 EXTERNAL DLAMCH, ZQPT01, ZQRT11, ZQRT12
112 * ..
113 * .. External Subroutines ..
114 EXTERNAL ALAHD, ALASUM, DLAORD, ICOPY, XLAENV, ZGEQP3,
115 $ ZLACPY, ZLASET, ZLATMS
116 * ..
117 * .. Intrinsic Functions ..
118 INTRINSIC MAX, MIN
119 * ..
120 * .. Scalars in Common ..
121 LOGICAL LERR, OK
122 CHARACTER*32 SRNAMT
123 INTEGER INFOT, IOUNIT
124 * ..
125 * .. Common blocks ..
126 COMMON / INFOC / INFOT, IOUNIT, OK, LERR
127 COMMON / SRNAMC / SRNAMT
128 * ..
129 * .. Data statements ..
130 DATA ISEEDY / 1988, 1989, 1990, 1991 /
131 * ..
132 * .. Executable Statements ..
133 *
134 * Initialize constants and the random number seed.
135 *
136 PATH( 1: 1 ) = 'Zomplex precision'
137 PATH( 2: 3 ) = 'Q3'
138 NRUN = 0
139 NFAIL = 0
140 NERRS = 0
141 DO 10 I = 1, 4
142 ISEED( I ) = ISEEDY( I )
143 10 CONTINUE
144 EPS = DLAMCH( 'Epsilon' )
145 INFOT = 0
146 *
147 DO 90 IM = 1, NM
148 *
149 * Do for each value of M in MVAL.
150 *
151 M = MVAL( IM )
152 LDA = MAX( 1, M )
153 *
154 DO 80 IN = 1, NN
155 *
156 * Do for each value of N in NVAL.
157 *
158 N = NVAL( IN )
159 MNMIN = MIN( M, N )
160 LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
161 *
162 DO 70 IMODE = 1, NTYPES
163 IF( .NOT.DOTYPE( IMODE ) )
164 $ GO TO 70
165 *
166 * Do for each type of matrix
167 * 1: zero matrix
168 * 2: one small singular value
169 * 3: geometric distribution of singular values
170 * 4: first n/2 columns fixed
171 * 5: last n/2 columns fixed
172 * 6: every second column fixed
173 *
174 MODE = IMODE
175 IF( IMODE.GT.3 )
176 $ MODE = 1
177 *
178 * Generate test matrix of size m by n using
179 * singular value distribution indicated by `mode'.
180 *
181 DO 20 I = 1, N
182 IWORK( I ) = 0
183 20 CONTINUE
184 IF( IMODE.EQ.1 ) THEN
185 CALL ZLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA )
186 DO 30 I = 1, MNMIN
187 COPYS( I ) = ZERO
188 30 CONTINUE
189 ELSE
190 CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS,
191 $ MODE, ONE / EPS, ONE, M, N, 'No packing',
192 $ COPYA, LDA, WORK, INFO )
193 IF( IMODE.GE.4 ) THEN
194 IF( IMODE.EQ.4 ) THEN
195 ILOW = 1
196 ISTEP = 1
197 IHIGH = MAX( 1, N / 2 )
198 ELSE IF( IMODE.EQ.5 ) THEN
199 ILOW = MAX( 1, N / 2 )
200 ISTEP = 1
201 IHIGH = N
202 ELSE IF( IMODE.EQ.6 ) THEN
203 ILOW = 1
204 ISTEP = 2
205 IHIGH = N
206 END IF
207 DO 40 I = ILOW, IHIGH, ISTEP
208 IWORK( I ) = 1
209 40 CONTINUE
210 END IF
211 CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 )
212 END IF
213 *
214 DO 60 INB = 1, NNB
215 *
216 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
217 *
218 NB = NBVAL( INB )
219 CALL XLAENV( 1, NB )
220 NX = NXVAL( INB )
221 CALL XLAENV( 3, NX )
222 *
223 * Save A and its singular values and a copy of
224 * vector IWORK.
225 *
226 CALL ZLACPY( 'All', M, N, COPYA, LDA, A, LDA )
227 CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
228 *
229 * Workspace needed.
230 *
231 LW = NB*( N+1 )
232 *
233 SRNAMT = 'ZGEQP3'
234 CALL ZGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK,
235 $ LW, RWORK, INFO )
236 *
237 * Compute norm(svd(a) - svd(r))
238 *
239 RESULT( 1 ) = ZQRT12( M, N, A, LDA, COPYS, WORK,
240 $ LWORK, RWORK )
241 *
242 * Compute norm( A*P - Q*R )
243 *
244 RESULT( 2 ) = ZQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
245 $ IWORK( N+1 ), WORK, LWORK )
246 *
247 * Compute Q'*Q
248 *
249 RESULT( 3 ) = ZQRT11( M, MNMIN, A, LDA, TAU, WORK,
250 $ LWORK )
251 *
252 * Print information about the tests that did not pass
253 * the threshold.
254 *
255 DO 50 K = 1, NTESTS
256 IF( RESULT( K ).GE.THRESH ) THEN
257 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
258 $ CALL ALAHD( NOUT, PATH )
259 WRITE( NOUT, FMT = 9999 )'ZGEQP3', M, N, NB,
260 $ IMODE, K, RESULT( K )
261 NFAIL = NFAIL + 1
262 END IF
263 50 CONTINUE
264 NRUN = NRUN + NTESTS
265 *
266 60 CONTINUE
267 70 CONTINUE
268 80 CONTINUE
269 90 CONTINUE
270 *
271 * Print a summary of the results.
272 *
273 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
274 *
275 9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ',
276 $ I2, ', test ', I2, ', ratio =', G12.5 )
277 *
278 * End of ZCHKQ3
279 *
280 END
2 $ THRESH, A, COPYA, S, COPYS, TAU, WORK, RWORK,
3 $ IWORK, NOUT )
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 NM, NN, NNB, NOUT
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 LOGICAL DOTYPE( * )
15 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
16 $ NXVAL( * )
17 DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * )
18 COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZCHKQ3 tests ZGEQP3.
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NM (input) INTEGER
35 * The number of values of M contained in the vector MVAL.
36 *
37 * MVAL (input) INTEGER array, dimension (NM)
38 * The values of the matrix row dimension M.
39 *
40 * NN (input) INTEGER
41 * The number of values of N contained in the vector NVAL.
42 *
43 * NVAL (input) INTEGER array, dimension (NN)
44 * The values of the matrix column dimension N.
45 *
46 * NNB (input) INTEGER
47 * The number of values of NB and NX contained in the
48 * vectors NBVAL and NXVAL. The blocking parameters are used
49 * in pairs (NB,NX).
50 *
51 * NBVAL (input) INTEGER array, dimension (NNB)
52 * The values of the blocksize NB.
53 *
54 * NXVAL (input) INTEGER array, dimension (NNB)
55 * The values of the crossover point NX.
56 *
57 * THRESH (input) DOUBLE PRECISION
58 * The threshold value for the test ratios. A result is
59 * included in the output file if RESULT >= THRESH. To have
60 * every test ratio printed, use THRESH = 0.
61 *
62 * A (workspace) COMPLEX*16 array, dimension (MMAX*NMAX)
63 * where MMAX is the maximum value of M in MVAL and NMAX is the
64 * maximum value of N in NVAL.
65 *
66 * COPYA (workspace) COMPLEX*16 array, dimension (MMAX*NMAX)
67 *
68 * S (workspace) DOUBLE PRECISION array, dimension
69 * (min(MMAX,NMAX))
70 *
71 * COPYS (workspace) DOUBLE PRECISION array, dimension
72 * (min(MMAX,NMAX))
73 *
74 * TAU (workspace) COMPLEX*16 array, dimension (MMAX)
75 *
76 * WORK (workspace) COMPLEX*16 array, dimension
77 * (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
78 *
79 * RWORK (workspace) DOUBLE PRECISION array, dimension (4*NMAX)
80 *
81 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
82 *
83 * NOUT (input) INTEGER
84 * The unit number for output.
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 INTEGER NTYPES
90 PARAMETER ( NTYPES = 6 )
91 INTEGER NTESTS
92 PARAMETER ( NTESTS = 3 )
93 DOUBLE PRECISION ONE, ZERO
94 COMPLEX*16 CZERO
95 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0,
96 $ CZERO = ( 0.0D+0, 0.0D+0 ) )
97 * ..
98 * .. Local Scalars ..
99 CHARACTER*3 PATH
100 INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO,
101 $ ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N,
102 $ NB, NERRS, NFAIL, NRUN, NX
103 DOUBLE PRECISION EPS
104 * ..
105 * .. Local Arrays ..
106 INTEGER ISEED( 4 ), ISEEDY( 4 )
107 DOUBLE PRECISION RESULT( NTESTS )
108 * ..
109 * .. External Functions ..
110 DOUBLE PRECISION DLAMCH, ZQPT01, ZQRT11, ZQRT12
111 EXTERNAL DLAMCH, ZQPT01, ZQRT11, ZQRT12
112 * ..
113 * .. External Subroutines ..
114 EXTERNAL ALAHD, ALASUM, DLAORD, ICOPY, XLAENV, ZGEQP3,
115 $ ZLACPY, ZLASET, ZLATMS
116 * ..
117 * .. Intrinsic Functions ..
118 INTRINSIC MAX, MIN
119 * ..
120 * .. Scalars in Common ..
121 LOGICAL LERR, OK
122 CHARACTER*32 SRNAMT
123 INTEGER INFOT, IOUNIT
124 * ..
125 * .. Common blocks ..
126 COMMON / INFOC / INFOT, IOUNIT, OK, LERR
127 COMMON / SRNAMC / SRNAMT
128 * ..
129 * .. Data statements ..
130 DATA ISEEDY / 1988, 1989, 1990, 1991 /
131 * ..
132 * .. Executable Statements ..
133 *
134 * Initialize constants and the random number seed.
135 *
136 PATH( 1: 1 ) = 'Zomplex precision'
137 PATH( 2: 3 ) = 'Q3'
138 NRUN = 0
139 NFAIL = 0
140 NERRS = 0
141 DO 10 I = 1, 4
142 ISEED( I ) = ISEEDY( I )
143 10 CONTINUE
144 EPS = DLAMCH( 'Epsilon' )
145 INFOT = 0
146 *
147 DO 90 IM = 1, NM
148 *
149 * Do for each value of M in MVAL.
150 *
151 M = MVAL( IM )
152 LDA = MAX( 1, M )
153 *
154 DO 80 IN = 1, NN
155 *
156 * Do for each value of N in NVAL.
157 *
158 N = NVAL( IN )
159 MNMIN = MIN( M, N )
160 LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
161 *
162 DO 70 IMODE = 1, NTYPES
163 IF( .NOT.DOTYPE( IMODE ) )
164 $ GO TO 70
165 *
166 * Do for each type of matrix
167 * 1: zero matrix
168 * 2: one small singular value
169 * 3: geometric distribution of singular values
170 * 4: first n/2 columns fixed
171 * 5: last n/2 columns fixed
172 * 6: every second column fixed
173 *
174 MODE = IMODE
175 IF( IMODE.GT.3 )
176 $ MODE = 1
177 *
178 * Generate test matrix of size m by n using
179 * singular value distribution indicated by `mode'.
180 *
181 DO 20 I = 1, N
182 IWORK( I ) = 0
183 20 CONTINUE
184 IF( IMODE.EQ.1 ) THEN
185 CALL ZLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA )
186 DO 30 I = 1, MNMIN
187 COPYS( I ) = ZERO
188 30 CONTINUE
189 ELSE
190 CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS,
191 $ MODE, ONE / EPS, ONE, M, N, 'No packing',
192 $ COPYA, LDA, WORK, INFO )
193 IF( IMODE.GE.4 ) THEN
194 IF( IMODE.EQ.4 ) THEN
195 ILOW = 1
196 ISTEP = 1
197 IHIGH = MAX( 1, N / 2 )
198 ELSE IF( IMODE.EQ.5 ) THEN
199 ILOW = MAX( 1, N / 2 )
200 ISTEP = 1
201 IHIGH = N
202 ELSE IF( IMODE.EQ.6 ) THEN
203 ILOW = 1
204 ISTEP = 2
205 IHIGH = N
206 END IF
207 DO 40 I = ILOW, IHIGH, ISTEP
208 IWORK( I ) = 1
209 40 CONTINUE
210 END IF
211 CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 )
212 END IF
213 *
214 DO 60 INB = 1, NNB
215 *
216 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
217 *
218 NB = NBVAL( INB )
219 CALL XLAENV( 1, NB )
220 NX = NXVAL( INB )
221 CALL XLAENV( 3, NX )
222 *
223 * Save A and its singular values and a copy of
224 * vector IWORK.
225 *
226 CALL ZLACPY( 'All', M, N, COPYA, LDA, A, LDA )
227 CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
228 *
229 * Workspace needed.
230 *
231 LW = NB*( N+1 )
232 *
233 SRNAMT = 'ZGEQP3'
234 CALL ZGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK,
235 $ LW, RWORK, INFO )
236 *
237 * Compute norm(svd(a) - svd(r))
238 *
239 RESULT( 1 ) = ZQRT12( M, N, A, LDA, COPYS, WORK,
240 $ LWORK, RWORK )
241 *
242 * Compute norm( A*P - Q*R )
243 *
244 RESULT( 2 ) = ZQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
245 $ IWORK( N+1 ), WORK, LWORK )
246 *
247 * Compute Q'*Q
248 *
249 RESULT( 3 ) = ZQRT11( M, MNMIN, A, LDA, TAU, WORK,
250 $ LWORK )
251 *
252 * Print information about the tests that did not pass
253 * the threshold.
254 *
255 DO 50 K = 1, NTESTS
256 IF( RESULT( K ).GE.THRESH ) THEN
257 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
258 $ CALL ALAHD( NOUT, PATH )
259 WRITE( NOUT, FMT = 9999 )'ZGEQP3', M, N, NB,
260 $ IMODE, K, RESULT( K )
261 NFAIL = NFAIL + 1
262 END IF
263 50 CONTINUE
264 NRUN = NRUN + NTESTS
265 *
266 60 CONTINUE
267 70 CONTINUE
268 80 CONTINUE
269 90 CONTINUE
270 *
271 * Print a summary of the results.
272 *
273 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
274 *
275 9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ',
276 $ I2, ', test ', I2, ', ratio =', G12.5 )
277 *
278 * End of ZCHKQ3
279 *
280 END