LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cchktz()

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 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
December 2016

Definition at line 139 of file cchktz.f.

139 *
140 * -- LAPACK test routine (version 3.7.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 * December 2016
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 = 3 )
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 ..
178  REAL cqrt12, crzt01, crzt02, slamch
179  EXTERNAL cqrt12, crzt01, crzt02, slamch
180 * ..
181 * .. External Subroutines ..
182  EXTERNAL alahd, alasum, cerrtz, cgeqr2, clacpy, claset,
183  $ clatms, ctzrzf, slaord
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 CTZRZF
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 30 i = 1, mnmin
256  s( i ) = zero
257  30 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 CTZRZF to reduce the upper trapezoidal matrix to
275 * upper triangular form.
276 *
277  srnamt = 'CTZRZF'
278  CALL ctzrzf( m, n, a, lda, tau, work, lwork, 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 ) = crzt01( m, n, copya, a, lda, tau, work,
288  $ lwork )
289 *
290 * Compute norm(Q'*Q - I).
291 *
292  result( 3 ) = crzt02( m, n, a, lda, tau, work, lwork )
293 *
294 * Print information about the tests that did not pass
295 * the threshold.
296 *
297  DO 40 k = 1, ntests
298  IF( result( k ).GE.thresh ) THEN
299  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
300  $ CALL alahd( nout, path )
301  WRITE( nout, fmt = 9999 )m, n, imode, k,
302  $ result( k )
303  nfail = nfail + 1
304  END IF
305  40 CONTINUE
306  nrun = nrun + 3
307  50 CONTINUE
308  END IF
309  60 CONTINUE
310  70 CONTINUE
311 *
312 * Print a summary of the results.
313 *
314  CALL alasum( path, nout, nfail, nrun, nerrs )
315 *
316  9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
317  $ ', ratio =', g12.5 )
318 *
319 * End if CCHKTZ
320 *
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine cerrtz(PATH, NUNIT)
CERRTZ
Definition: cerrtz.f:56
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
real function crzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
CRZT01
Definition: crzt01.f:100
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
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
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
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
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
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
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: