LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
dchktz.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine dchktz (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
 DCHKTZ More...
 

Function/Subroutine Documentation

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 DTZRQF and STZRZF.
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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 134 of file dchktz.f.

134 *
135 * -- LAPACK test routine (version 3.4.0) --
136 * -- LAPACK is a software package provided by Univ. of Tennessee, --
137 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138 * November 2011
139 *
140 * .. Scalar Arguments ..
141  LOGICAL tsterr
142  INTEGER nm, nn, nout
143  DOUBLE PRECISION thresh
144 * ..
145 * .. Array Arguments ..
146  LOGICAL dotype( * )
147  INTEGER mval( * ), nval( * )
148  DOUBLE PRECISION a( * ), copya( * ), s( * ),
149  $ tau( * ), work( * )
150 * ..
151 *
152 * =====================================================================
153 *
154 * .. Parameters ..
155  INTEGER ntypes
156  parameter( ntypes = 3 )
157  INTEGER ntests
158  parameter( ntests = 6 )
159  DOUBLE PRECISION one, zero
160  parameter( one = 1.0d0, zero = 0.0d0 )
161 * ..
162 * .. Local Scalars ..
163  CHARACTER*3 path
164  INTEGER i, im, imode, in, info, k, lda, lwork, m,
165  $ mnmin, mode, n, nerrs, nfail, nrun
166  DOUBLE PRECISION eps
167 * ..
168 * .. Local Arrays ..
169  INTEGER iseed( 4 ), iseedy( 4 )
170  DOUBLE PRECISION result( ntests )
171 * ..
172 * .. External Functions ..
173  DOUBLE PRECISION dlamch, dqrt12, drzt01, drzt02, dtzt01, dtzt02
174  EXTERNAL dlamch, dqrt12, drzt01, drzt02, dtzt01, dtzt02
175 * ..
176 * .. External Subroutines ..
177  EXTERNAL alahd, alasum, derrtz, dgeqr2, dlacpy, dlaord,
179 * ..
180 * .. Intrinsic Functions ..
181  INTRINSIC max, min
182 * ..
183 * .. Scalars in Common ..
184  LOGICAL lerr, ok
185  CHARACTER*32 srnamt
186  INTEGER infot, iounit
187 * ..
188 * .. Common blocks ..
189  COMMON / infoc / infot, iounit, ok, lerr
190  COMMON / srnamc / srnamt
191 * ..
192 * .. Data statements ..
193  DATA iseedy / 1988, 1989, 1990, 1991 /
194 * ..
195 * .. Executable Statements ..
196 *
197 * Initialize constants and the random number seed.
198 *
199  path( 1: 1 ) = 'Double precision'
200  path( 2: 3 ) = 'TZ'
201  nrun = 0
202  nfail = 0
203  nerrs = 0
204  DO 10 i = 1, 4
205  iseed( i ) = iseedy( i )
206  10 CONTINUE
207  eps = dlamch( 'Epsilon' )
208 *
209 * Test the error exits
210 *
211  IF( tsterr )
212  $ CALL derrtz( path, nout )
213  infot = 0
214 *
215  DO 70 im = 1, nm
216 *
217 * Do for each value of M in MVAL.
218 *
219  m = mval( im )
220  lda = max( 1, m )
221 *
222  DO 60 in = 1, nn
223 *
224 * Do for each value of N in NVAL for which M .LE. N.
225 *
226  n = nval( in )
227  mnmin = min( m, n )
228  lwork = max( 1, n*n+4*m+n, m*n+2*mnmin+4*n )
229 *
230  IF( m.LE.n ) THEN
231  DO 50 imode = 1, ntypes
232  IF( .NOT.dotype( imode ) )
233  $ GO TO 50
234 *
235 * Do for each type of singular value distribution.
236 * 0: zero matrix
237 * 1: one small singular value
238 * 2: exponential distribution
239 *
240  mode = imode - 1
241 *
242 * Test DTZRQF
243 *
244 * Generate test matrix of size m by n using
245 * singular value distribution indicated by `mode'.
246 *
247  IF( mode.EQ.0 ) THEN
248  CALL dlaset( 'Full', m, n, zero, zero, a, lda )
249  DO 20 i = 1, mnmin
250  s( i ) = zero
251  20 CONTINUE
252  ELSE
253  CALL dlatms( m, n, 'Uniform', iseed,
254  $ 'Nonsymmetric', s, imode,
255  $ one / eps, one, m, n, 'No packing', a,
256  $ lda, work, info )
257  CALL dgeqr2( m, n, a, lda, work, work( mnmin+1 ),
258  $ info )
259  CALL dlaset( 'Lower', m-1, n, zero, zero, a( 2 ),
260  $ lda )
261  CALL dlaord( 'Decreasing', mnmin, s, 1 )
262  END IF
263 *
264 * Save A and its singular values
265 *
266  CALL dlacpy( 'All', m, n, a, lda, copya, lda )
267 *
268 * Call DTZRQF to reduce the upper trapezoidal matrix to
269 * upper triangular form.
270 *
271  srnamt = 'DTZRQF'
272  CALL dtzrqf( m, n, a, lda, tau, info )
273 *
274 * Compute norm(svd(a) - svd(r))
275 *
276  result( 1 ) = dqrt12( m, m, a, lda, s, work,
277  $ lwork )
278 *
279 * Compute norm( A - R*Q )
280 *
281  result( 2 ) = dtzt01( m, n, copya, a, lda, tau, work,
282  $ lwork )
283 *
284 * Compute norm(Q'*Q - I).
285 *
286  result( 3 ) = dtzt02( m, n, a, lda, tau, work, lwork )
287 *
288 * Test DTZRZF
289 *
290 * Generate test matrix of size m by n using
291 * singular value distribution indicated by `mode'.
292 *
293  IF( mode.EQ.0 ) THEN
294  CALL dlaset( 'Full', m, n, zero, zero, a, lda )
295  DO 30 i = 1, mnmin
296  s( i ) = zero
297  30 CONTINUE
298  ELSE
299  CALL dlatms( m, n, 'Uniform', iseed,
300  $ 'Nonsymmetric', s, imode,
301  $ one / eps, one, m, n, 'No packing', a,
302  $ lda, work, info )
303  CALL dgeqr2( m, n, a, lda, work, work( mnmin+1 ),
304  $ info )
305  CALL dlaset( 'Lower', m-1, n, zero, zero, a( 2 ),
306  $ lda )
307  CALL dlaord( 'Decreasing', mnmin, s, 1 )
308  END IF
309 *
310 * Save A and its singular values
311 *
312  CALL dlacpy( 'All', m, n, a, lda, copya, lda )
313 *
314 * Call DTZRZF to reduce the upper trapezoidal matrix to
315 * upper triangular form.
316 *
317  srnamt = 'DTZRZF'
318  CALL dtzrzf( m, n, a, lda, tau, work, lwork, info )
319 *
320 * Compute norm(svd(a) - svd(r))
321 *
322  result( 4 ) = dqrt12( m, m, a, lda, s, work,
323  $ lwork )
324 *
325 * Compute norm( A - R*Q )
326 *
327  result( 5 ) = drzt01( m, n, copya, a, lda, tau, work,
328  $ lwork )
329 *
330 * Compute norm(Q'*Q - I).
331 *
332  result( 6 ) = drzt02( m, n, a, lda, tau, work, lwork )
333 *
334 * Print information about the tests that did not pass
335 * the threshold.
336 *
337  DO 40 k = 1, 6
338  IF( result( k ).GE.thresh ) THEN
339  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
340  $ CALL alahd( nout, path )
341  WRITE( nout, fmt = 9999 )m, n, imode, k,
342  $ result( k )
343  nfail = nfail + 1
344  END IF
345  40 CONTINUE
346  nrun = nrun + 6
347  50 CONTINUE
348  END IF
349  60 CONTINUE
350  70 CONTINUE
351 *
352 * Print a summary of the results.
353 *
354  CALL alasum( path, nout, nfail, nrun, nerrs )
355 *
356  9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
357  $ ', ratio =', g12.5 )
358 *
359 * End if DCHKTZ
360 *
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
subroutine dtzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DTZRZF
Definition: dtzrzf.f:153
double precision function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
Definition: dqrt12.f:91
subroutine dlaord(JOB, N, X, INCX)
DLAORD
Definition: dlaord.f:75
double precision function dtzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
DTZT01
Definition: dtzt01.f:100
double precision function drzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
DRZT01
Definition: drzt01.f:100
double precision function dtzt02(M, N, AF, LDA, TAU, WORK, LWORK)
DTZT02
Definition: dtzt02.f:93
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
double precision function drzt02(M, N, AF, LDA, TAU, WORK, LWORK)
DRZT02
Definition: drzt02.f:93
subroutine derrtz(PATH, NUNIT)
DERRTZ
Definition: derrtz.f:56
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
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:123
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
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:112
subroutine dtzrqf(M, N, A, LDA, TAU, INFO)
DTZRQF
Definition: dtzrqf.f:140

Here is the call graph for this function:

Here is the caller graph for this function: