LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 134 of file dchktz.f.

134 *
135 * -- LAPACK test routine (version 3.6.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 2015
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 = 3 )
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
174  EXTERNAL dlamch, dqrt12, drzt01, drzt02
175 * ..
176 * .. External Subroutines ..
177  EXTERNAL alahd, alasum, derrtz, dgeqr2, dlacpy, dlaord,
178  $ dlaset, dlatms, dtzrzf
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 30 i = 1, mnmin
250  s( i ) = zero
251  30 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 DTZRZF to reduce the upper trapezoidal matrix to
269 * upper triangular form.
270 *
271  srnamt = 'DTZRZF'
272  CALL dtzrzf( m, n, a, lda, tau, work, lwork, 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 ) = drzt01( m, n, copya, a, lda, tau, work,
282  $ lwork )
283 *
284 * Compute norm(Q'*Q - I).
285 *
286  result( 3 ) = drzt02( m, n, a, lda, tau, work, lwork )
287 *
288 * Print information about the tests that did not pass
289 * the threshold.
290 *
291  DO 40 k = 1, ntests
292  IF( result( k ).GE.thresh ) THEN
293  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
294  $ CALL alahd( nout, path )
295  WRITE( nout, fmt = 9999 )m, n, imode, k,
296  $ result( k )
297  nfail = nfail + 1
298  END IF
299  40 CONTINUE
300  nrun = nrun + 3
301  50 CONTINUE
302  END IF
303  60 CONTINUE
304  70 CONTINUE
305 *
306 * Print a summary of the results.
307 *
308  CALL alasum( path, nout, nfail, nrun, nerrs )
309 *
310  9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
311  $ ', ratio =', g12.5 )
312 *
313 * End if DCHKTZ
314 *
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 alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine derrtz(PATH, NUNIT)
DERRTZ
Definition: derrtz.f:56
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
double precision function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
Definition: dqrt12.f:91
subroutine dtzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DTZRZF
Definition: dtzrzf.f:153
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 dlaord(JOB, N, X, INCX)
DLAORD
Definition: dlaord.f:75
double precision function drzt02(M, N, AF, LDA, TAU, WORK, LWORK)
DRZT02
Definition: drzt02.f:93
double precision function drzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
DRZT01
Definition: drzt01.f:100
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75

Here is the call graph for this function:

Here is the caller graph for this function: