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

November 2015

Definition at line 139 of file cchktz.f.

*
*  -- LAPACK test routine (version 3.6.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2015
*
*     .. Scalar Arguments ..
      LOGICAL            tsterr
      INTEGER            nm, nn, nout
      REAL               thresh
*     ..
*     .. Array Arguments ..
      LOGICAL            dotype( * )
      INTEGER            mval( * ), nval( * )
      REAL               s( * ), rwork( * )
      COMPLEX            a( * ), copya( * ), tau( * ), work( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            ntypes
      parameter                ( ntypes = 3 )
      INTEGER            ntests
      parameter                ( ntests = 3 )
      REAL               one, zero
      parameter                ( one = 1.0e0, zero = 0.0e0 )
*     ..
*     .. Local Scalars ..
      CHARACTER*3        path
      INTEGER            i, im, imode, in, info, k, lda, lwork, m,
     $                   mnmin, mode, n, nerrs, nfail, nrun
      REAL               eps
*     ..
*     .. Local Arrays ..
      INTEGER            iseed( 4 ), iseedy( 4 )
      REAL               result( ntests )
*     ..
*     .. External Functions ..
      REAL               cqrt12, crzt01, crzt02, slamch
      EXTERNAL           cqrt12, crzt01, crzt02, slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           alahd, alasum, cerrtz, cgeqr2, clacpy, claset,
     $                   clatms, ctzrzf, slaord
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          cmplx, max, min
*     ..
*     .. Scalars in Common ..
      LOGICAL            lerr, ok
      CHARACTER*32       srnamt
      INTEGER            infot, iounit
*     ..
*     .. Common blocks ..
      COMMON             / infoc / infot, iounit, ok, lerr
      COMMON             / srnamc / srnamt
*     ..
*     .. Data statements ..
      DATA               iseedy / 1988, 1989, 1990, 1991 /
*     ..
*     .. Executable Statements ..
*
*     Initialize constants and the random number seed.
*
      path( 1: 1 ) = 'Complex precision'
      path( 2: 3 ) = 'TZ'
      nrun = 0
      nfail = 0
      nerrs = 0
      DO 10 i = 1, 4
         iseed( i ) = iseedy( i )
   10 CONTINUE
      eps = slamch( 'Epsilon' )
*
*     Test the error exits
*
      IF( tsterr )
     $   CALL cerrtz( path, nout )
      infot = 0
*
      DO 70 im = 1, nm
*
*        Do for each value of M in MVAL.
*
         m = mval( im )
         lda = max( 1, m )
*
         DO 60 in = 1, nn
*
*           Do for each value of N in NVAL for which M .LE. N.
*
            n = nval( in )
            mnmin = min( m, n )
            lwork = max( 1, n*n+4*m+n )
*
            IF( m.LE.n ) THEN
               DO 50 imode = 1, ntypes
                  IF( .NOT.dotype( imode ) )
     $               GO TO 50
*
*                 Do for each type of singular value distribution.
*                    0:  zero matrix
*                    1:  one small singular value
*                    2:  exponential distribution
*
                  mode = imode - 1
*
*                 Test CTZRZF
*
*                 Generate test matrix of size m by n using
*                 singular value distribution indicated by `mode'.
*
                  IF( mode.EQ.0 ) THEN
                     CALL claset( 'Full', m, n, cmplx( zero ),
     $                            cmplx( zero ), a, lda )
                     DO 30 i = 1, mnmin
                        s( i ) = zero
   30                CONTINUE
                  ELSE
                     CALL clatms( m, n, 'Uniform', iseed,
     $                            'Nonsymmetric', s, imode,
     $                            one / eps, one, m, n, 'No packing', a,
     $                            lda, work, info )
                     CALL cgeqr2( m, n, a, lda, work, work( mnmin+1 ),
     $                            info )
                     CALL claset( 'Lower', m-1, n, cmplx( zero ),
     $                            cmplx( zero ), a( 2 ), lda )
                     CALL slaord( 'Decreasing', mnmin, s, 1 )
                  END IF
*
*                 Save A and its singular values
*
                  CALL clacpy( 'All', m, n, a, lda, copya, lda )
*
*                 Call CTZRZF to reduce the upper trapezoidal matrix to
*                 upper triangular form.
*
                  srnamt = 'CTZRZF'
                  CALL ctzrzf( m, n, a, lda, tau, work, lwork, info )
*
*                 Compute norm(svd(a) - svd(r))
*
                  result( 1 ) = cqrt12( m, m, a, lda, s, work,
     $                          lwork, rwork )
*
*                 Compute norm( A - R*Q )
*
                  result( 2 ) = crzt01( m, n, copya, a, lda, tau, work,
     $                          lwork )
*
*                 Compute norm(Q'*Q - I).
*
                  result( 3 ) = crzt02( m, n, a, lda, tau, work, lwork )
*
*                 Print information about the tests that did not pass
*                 the threshold.
*
                  DO 40 k = 1, ntests
                     IF( result( k ).GE.thresh ) THEN
                        IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
     $                     CALL alahd( nout, path )
                        WRITE( nout, fmt = 9999 )m, n, imode, k,
     $                     result( k )
                        nfail = nfail + 1
                     END IF
   40             CONTINUE
                  nrun = nrun + 3
   50          CONTINUE
            END IF
   60    CONTINUE
   70 CONTINUE
*
*     Print a summary of the results.
*
      CALL alasum( path, nout, nfail, nrun, nerrs )
*
 9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
     $      ', ratio =', g12.5 )
*
*     End if CCHKTZ
*

Here is the call graph for this function:

Here is the caller graph for this function: