LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ schktz()

 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.```

Definition at line 130 of file schktz.f.

132 *
133 * -- LAPACK test routine --
134 * -- LAPACK is a software package provided by Univ. of Tennessee, --
135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 *
137 * .. Scalar Arguments ..
138  LOGICAL TSTERR
139  INTEGER NM, NN, NOUT
140  REAL THRESH
141 * ..
142 * .. Array Arguments ..
143  LOGICAL DOTYPE( * )
144  INTEGER MVAL( * ), NVAL( * )
145  REAL A( * ), COPYA( * ), S( * ),
146  \$ TAU( * ), WORK( * )
147 * ..
148 *
149 * =====================================================================
150 *
151 * .. Parameters ..
152  INTEGER NTYPES
153  parameter( ntypes = 3 )
154  INTEGER NTESTS
155  parameter( ntests = 3 )
156  REAL ONE, ZERO
157  parameter( one = 1.0e0, zero = 0.0e0 )
158 * ..
159 * .. Local Scalars ..
160  CHARACTER*3 PATH
161  INTEGER I, IM, IMODE, IN, INFO, K, LDA, LWORK, M,
162  \$ MNMIN, MODE, N, NERRS, NFAIL, NRUN
163  REAL EPS
164 * ..
165 * .. Local Arrays ..
166  INTEGER ISEED( 4 ), ISEEDY( 4 )
167  REAL RESULT( NTESTS )
168 * ..
169 * .. External Functions ..
170  REAL SLAMCH, SQRT12, SRZT01, SRZT02
171  EXTERNAL slamch, sqrt12, srzt01, srzt02
172 * ..
173 * .. External Subroutines ..
174  EXTERNAL alahd, alasum, serrtz, sgeqr2, slacpy, slaord,
175  \$ slaset, slatms, stzrzf
176 * ..
177 * .. Intrinsic Functions ..
178  INTRINSIC max, min
179 * ..
180 * .. Scalars in Common ..
181  LOGICAL LERR, OK
182  CHARACTER*32 SRNAMT
183  INTEGER INFOT, IOUNIT
184 * ..
185 * .. Common blocks ..
186  COMMON / infoc / infot, iounit, ok, lerr
187  COMMON / srnamc / srnamt
188 * ..
189 * .. Data statements ..
190  DATA iseedy / 1988, 1989, 1990, 1991 /
191 * ..
192 * .. Executable Statements ..
193 *
194 * Initialize constants and the random number seed.
195 *
196  path( 1: 1 ) = 'Single precision'
197  path( 2: 3 ) = 'TZ'
198  nrun = 0
199  nfail = 0
200  nerrs = 0
201  DO 10 i = 1, 4
202  iseed( i ) = iseedy( i )
203  10 CONTINUE
204  eps = slamch( 'Epsilon' )
205 *
206 * Test the error exits
207 *
208  IF( tsterr )
209  \$ CALL serrtz( path, nout )
210  infot = 0
211 *
212  DO 70 im = 1, nm
213 *
214 * Do for each value of M in MVAL.
215 *
216  m = mval( im )
217  lda = max( 1, m )
218 *
219  DO 60 in = 1, nn
220 *
221 * Do for each value of N in NVAL for which M .LE. N.
222 *
223  n = nval( in )
224  mnmin = min( m, n )
225  lwork = max( 1, n*n+4*m+n, m*n+2*mnmin+4*n )
226 *
227  IF( m.LE.n ) THEN
228  DO 50 imode = 1, ntypes
229  IF( .NOT.dotype( imode ) )
230  \$ GO TO 50
231 *
232 * Do for each type of singular value distribution.
233 * 0: zero matrix
234 * 1: one small singular value
235 * 2: exponential distribution
236 *
237  mode = imode - 1
238 *
239 * Test STZRQF
240 *
241 * Generate test matrix of size m by n using
242 * singular value distribution indicated by `mode'.
243 *
244  IF( mode.EQ.0 ) THEN
245  CALL slaset( 'Full', m, n, zero, zero, a, lda )
246  DO 30 i = 1, mnmin
247  s( i ) = zero
248  30 CONTINUE
249  ELSE
250  CALL slatms( m, n, 'Uniform', iseed,
251  \$ 'Nonsymmetric', s, imode,
252  \$ one / eps, one, m, n, 'No packing', a,
253  \$ lda, work, info )
254  CALL sgeqr2( m, n, a, lda, work, work( mnmin+1 ),
255  \$ info )
256  CALL slaset( 'Lower', m-1, n, zero, zero, a( 2 ),
257  \$ lda )
258  CALL slaord( 'Decreasing', mnmin, s, 1 )
259  END IF
260 *
261 * Save A and its singular values
262 *
263  CALL slacpy( 'All', m, n, a, lda, copya, lda )
264 *
265 * Call STZRZF to reduce the upper trapezoidal matrix to
266 * upper triangular form.
267 *
268  srnamt = 'STZRZF'
269  CALL stzrzf( m, n, a, lda, tau, work, lwork, info )
270 *
271 * Compute norm(svd(a) - svd(r))
272 *
273  result( 1 ) = sqrt12( m, m, a, lda, s, work,
274  \$ lwork )
275 *
276 * Compute norm( A - R*Q )
277 *
278  result( 2 ) = srzt01( m, n, copya, a, lda, tau, work,
279  \$ lwork )
280 *
281 * Compute norm(Q'*Q - I).
282 *
283  result( 3 ) = srzt02( m, n, a, lda, tau, work, lwork )
284 *
285 * Print information about the tests that did not pass
286 * the threshold.
287 *
288  DO 40 k = 1, ntests
289  IF( result( k ).GE.thresh ) THEN
290  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
291  \$ CALL alahd( nout, path )
292  WRITE( nout, fmt = 9999 )m, n, imode, k,
293  \$ result( k )
294  nfail = nfail + 1
295  END IF
296  40 CONTINUE
297  nrun = nrun + 3
298  50 CONTINUE
299  END IF
300  60 CONTINUE
301  70 CONTINUE
302 *
303 * Print a summary of the results.
304 *
305  CALL alasum( path, nout, nfail, nrun, nerrs )
306 *
307  9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
308  \$ ', ratio =', g12.5 )
309 *
310 * End if SCHKTZ
311 *
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: slaset.f:110
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:103
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:321
subroutine sgeqr2(M, N, A, LDA, TAU, WORK, INFO)
SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
Definition: sgeqr2.f:130
subroutine stzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
STZRZF
Definition: stzrzf.f:151
real function srzt02(M, N, AF, LDA, TAU, WORK, LWORK)
SRZT02
Definition: srzt02.f:91
real function srzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
SRZT01
Definition: srzt01.f:98
subroutine slaord(JOB, N, X, INCX)
SLAORD
Definition: slaord.f:73
real function sqrt12(M, N, A, LDA, S, WORK, LWORK)
SQRT12
Definition: sqrt12.f:89
subroutine serrtz(PATH, NUNIT)
SERRTZ
Definition: serrtz.f:54
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: