LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ dchktz()

 subroutine dchktz ( logical, dimension( * ) DOTYPE, integer NM, integer, dimension( * ) MVAL, integer NN, integer, dimension( * ) NVAL, double precision THRESH, logical TSTERR, double precision, dimension( * ) A, double precision, dimension( * ) COPYA, double precision, dimension( * ) S, double precision, dimension( * ) TAU, double precision, dimension( * ) WORK, integer NOUT )

DCHKTZ

Purpose:
` DCHKTZ tests DTZRZF.`
Parameters
 [in] DOTYPE ``` DOTYPE is LOGICAL array, dimension (NTYPES) The matrix types to be used for testing. Matrices of type j (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.``` [in] NM ``` NM is INTEGER The number of values of M contained in the vector MVAL.``` [in] MVAL ``` MVAL is INTEGER array, dimension (NM) The values of the matrix row dimension M.``` [in] NN ``` NN is INTEGER The number of values of N contained in the vector NVAL.``` [in] NVAL ``` NVAL is INTEGER array, dimension (NN) The values of the matrix column dimension N.``` [in] THRESH ``` THRESH is DOUBLE PRECISION The threshold value for the test ratios. A result is included in the output file if RESULT >= THRESH. To have every test ratio printed, use THRESH = 0.``` [in] TSTERR ``` TSTERR is LOGICAL Flag that indicates whether error exits are to be tested.``` [out] A ``` A is DOUBLE PRECISION array, dimension (MMAX*NMAX) where MMAX is the maximum value of M in MVAL and NMAX is the maximum value of N in NVAL.``` [out] COPYA ` COPYA is DOUBLE PRECISION array, dimension (MMAX*NMAX)` [out] S ``` S is DOUBLE PRECISION array, dimension (min(MMAX,NMAX))``` [out] TAU ` TAU is DOUBLE PRECISION array, dimension (MMAX)` [out] WORK ``` WORK is DOUBLE PRECISION array, dimension (MMAX*NMAX + 4*NMAX + MMAX)``` [in] NOUT ``` NOUT is INTEGER The unit number for output.```

Definition at line 130 of file dchktz.f.

132*
133* -- LAPACK test routine --
134* -- LAPACK is a software package provided by Univ. of Tennessee, --
135* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136*
137* .. Scalar Arguments ..
138 LOGICAL TSTERR
139 INTEGER NM, NN, NOUT
140 DOUBLE PRECISION THRESH
141* ..
142* .. Array Arguments ..
143 LOGICAL DOTYPE( * )
144 INTEGER MVAL( * ), NVAL( * )
145 DOUBLE PRECISION A( * ), COPYA( * ), S( * ),
146 \$ TAU( * ), WORK( * )
147* ..
148*
149* =====================================================================
150*
151* .. Parameters ..
152 INTEGER NTYPES
153 parameter( ntypes = 3 )
154 INTEGER NTESTS
155 parameter( ntests = 3 )
156 DOUBLE PRECISION ONE, ZERO
157 parameter( one = 1.0d0, zero = 0.0d0 )
158* ..
159* .. Local Scalars ..
160 CHARACTER*3 PATH
161 INTEGER I, IM, IMODE, IN, INFO, K, LDA, LWORK, M,
162 \$ MNMIN, MODE, N, NERRS, NFAIL, NRUN
163 DOUBLE PRECISION EPS
164* ..
165* .. Local Arrays ..
166 INTEGER ISEED( 4 ), ISEEDY( 4 )
167 DOUBLE PRECISION RESULT( NTESTS )
168* ..
169* .. External Functions ..
170 DOUBLE PRECISION DLAMCH, DQRT12, DRZT01, DRZT02
171 EXTERNAL dlamch, dqrt12, drzt01, drzt02
172* ..
173* .. External Subroutines ..
174 EXTERNAL alahd, alasum, derrtz, dgeqr2, dlacpy, dlaord,
176* ..
177* .. Intrinsic Functions ..
178 INTRINSIC max, min
179* ..
180* .. Scalars in Common ..
181 LOGICAL LERR, OK
182 CHARACTER*32 SRNAMT
183 INTEGER INFOT, IOUNIT
184* ..
185* .. Common blocks ..
186 COMMON / infoc / infot, iounit, ok, lerr
187 COMMON / srnamc / srnamt
188* ..
189* .. Data statements ..
190 DATA iseedy / 1988, 1989, 1990, 1991 /
191* ..
192* .. Executable Statements ..
193*
194* Initialize constants and the random number seed.
195*
196 path( 1: 1 ) = 'Double precision'
197 path( 2: 3 ) = 'TZ'
198 nrun = 0
199 nfail = 0
200 nerrs = 0
201 DO 10 i = 1, 4
202 iseed( i ) = iseedy( i )
203 10 CONTINUE
204 eps = dlamch( 'Epsilon' )
205*
206* Test the error exits
207*
208 IF( tsterr )
209 \$ CALL derrtz( path, nout )
210 infot = 0
211*
212 DO 70 im = 1, nm
213*
214* Do for each value of M in MVAL.
215*
216 m = mval( im )
217 lda = max( 1, m )
218*
219 DO 60 in = 1, nn
220*
221* Do for each value of N in NVAL for which M .LE. N.
222*
223 n = nval( in )
224 mnmin = min( m, n )
225 lwork = max( 1, n*n+4*m+n, m*n+2*mnmin+4*n )
226*
227 IF( m.LE.n ) THEN
228 DO 50 imode = 1, ntypes
229 IF( .NOT.dotype( imode ) )
230 \$ GO TO 50
231*
232* Do for each type of singular value distribution.
233* 0: zero matrix
234* 1: one small singular value
235* 2: exponential distribution
236*
237 mode = imode - 1
238*
239* Test DTZRQF
240*
241* Generate test matrix of size m by n using
242* singular value distribution indicated by `mode'.
243*
244 IF( mode.EQ.0 ) THEN
245 CALL dlaset( 'Full', m, n, zero, zero, a, lda )
246 DO 30 i = 1, mnmin
247 s( i ) = zero
248 30 CONTINUE
249 ELSE
250 CALL dlatms( m, n, 'Uniform', iseed,
251 \$ 'Nonsymmetric', s, imode,
252 \$ one / eps, one, m, n, 'No packing', a,
253 \$ lda, work, info )
254 CALL dgeqr2( m, n, a, lda, work, work( mnmin+1 ),
255 \$ info )
256 CALL dlaset( 'Lower', m-1, n, zero, zero, a( 2 ),
257 \$ lda )
258 CALL dlaord( 'Decreasing', mnmin, s, 1 )
259 END IF
260*
261* Save A and its singular values
262*
263 CALL dlacpy( 'All', m, n, a, lda, copya, lda )
264*
265* Call DTZRZF to reduce the upper trapezoidal matrix to
266* upper triangular form.
267*
268 srnamt = 'DTZRZF'
269 CALL dtzrzf( m, n, a, lda, tau, work, lwork, info )
270*
271* Compute norm(svd(a) - svd(r))
272*
273 result( 1 ) = dqrt12( m, m, a, lda, s, work,
274 \$ lwork )
275*
276* Compute norm( A - R*Q )
277*
278 result( 2 ) = drzt01( m, n, copya, a, lda, tau, work,
279 \$ lwork )
280*
281* Compute norm(Q'*Q - I).
282*
283 result( 3 ) = drzt02( m, n, a, lda, tau, work, lwork )
284*
285* Print information about the tests that did not pass
286* the threshold.
287*
288 DO 40 k = 1, ntests
289 IF( result( k ).GE.thresh ) THEN
290 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
291 \$ CALL alahd( nout, path )
292 WRITE( nout, fmt = 9999 )m, n, imode, k,
293 \$ result( k )
294 nfail = nfail + 1
295 END IF
296 40 CONTINUE
297 nrun = nrun + 3
298 50 CONTINUE
299 END IF
300 60 CONTINUE
301 70 CONTINUE
302*
303* Print a summary of the results.
304*
305 CALL alasum( path, nout, nfail, nrun, nerrs )
306*
307 9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
308 \$ ', ratio =', g12.5 )
309*
310* End if DCHKTZ
311*
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:103
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:110
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
double precision function drzt02(M, N, AF, LDA, TAU, WORK, LWORK)
DRZT02
Definition: drzt02.f:91
double precision function drzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
DRZT01
Definition: drzt01.f:98
subroutine derrtz(PATH, NUNIT)
DERRTZ
Definition: derrtz.f:54
subroutine dlaord(JOB, N, X, INCX)
DLAORD
Definition: dlaord.f:73
double precision function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
Definition: dqrt12.f:89
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:321
subroutine dgeqr2(M, N, A, LDA, TAU, WORK, INFO)
DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
Definition: dgeqr2.f:130
subroutine dtzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DTZRZF
Definition: dtzrzf.f:151
Here is the call graph for this function:
Here is the caller graph for this function: