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

SCHKTZ

Purpose:

 SCHKTZ tests 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 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 REAL 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 REAL array, dimension (MMAX*NMAX)
[out]	S	S is REAL array, dimension (min(MMAX,NMAX))
[out]	TAU	TAU is REAL array, dimension (MMAX)
[out]	WORK	WORK is REAL 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 schktz.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               a( * ), copya( * ), s( * ),
     $                   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               slamch, sqrt12, srzt01, srzt02
      EXTERNAL           slamch, sqrt12, srzt01, srzt02
*     ..
*     .. External Subroutines ..
      EXTERNAL           alahd, alasum, serrtz, sgeqr2, slacpy, slaord,
     $                   slaset, slatms, stzrzf
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          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 ) = 'Single 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 serrtz( 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, m*n+2*mnmin+4*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 STZRQF
*
*                 Generate test matrix of size m by n using
*                 singular value distribution indicated by `mode'.
*
                  IF( mode.EQ.0 ) THEN
                     CALL slaset( 'Full', m, n, zero, zero, a, lda )
                     DO 30 i = 1, mnmin
                        s( i ) = zero
   30                CONTINUE
                  ELSE
                     CALL slatms( m, n, 'Uniform', iseed,
     $                            'Nonsymmetric', s, imode,
     $                            one / eps, one, m, n, 'No packing', a,
     $                            lda, work, info )
                     CALL sgeqr2( m, n, a, lda, work, work( mnmin+1 ),
     $                            info )
                     CALL slaset( 'Lower', m-1, n, zero, zero, a( 2 ),
     $                            lda )
                     CALL slaord( 'Decreasing', mnmin, s, 1 )
                  END IF
*
*                 Save A and its singular values
*
                  CALL slacpy( 'All', m, n, a, lda, copya, lda )
*
*                 Call STZRZF to reduce the upper trapezoidal matrix to
*                 upper triangular form.
*
                  srnamt = 'STZRZF'
                  CALL stzrzf( m, n, a, lda, tau, work, lwork, info )
*
*                 Compute norm(svd(a) - svd(r))
*
                  result( 1 ) = sqrt12( m, m, a, lda, s, work,
     $                          lwork )
*
*                 Compute norm( A - R*Q )
*
                  result( 2 ) = srzt01( m, n, copya, a, lda, tau, work,
     $                          lwork )
*
*                 Compute norm(Q'*Q - I).
*
                  result( 3 ) = srzt02( 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 SCHKTZ
*

Here is the call graph for this function:

Here is the caller graph for this function: