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

Go to the source code of this file.

Functions/Subroutines

subroutine cchktz (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, NOUT)
 CCHKTZ More...
 

Function/Subroutine Documentation

subroutine cchktz ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
real  THRESH,
logical  TSTERR,
complex, dimension( * )  A,
complex, dimension( * )  COPYA,
real, dimension( * )  S,
complex, dimension( * )  TAU,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  NOUT 
)

CCHKTZ

Purpose:
 CCHKTZ tests CTZRQF and CTZRZF.
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 REAL
          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 COMPLEX 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 COMPLEX array, dimension (MMAX*NMAX)
[out]S
          S is REAL array, dimension
                      (min(MMAX,NMAX))
[out]TAU
          TAU is COMPLEX array, dimension (MMAX)
[out]WORK
          WORK is COMPLEX array, dimension
                      (MMAX*NMAX + 4*NMAX + MMAX)
[out]RWORK
          RWORK is REAL array, dimension (2*NMAX)
[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 139 of file cchktz.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: