 LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ schkq3()

 subroutine schkq3 ( logical, dimension( * ) DOTYPE, integer NM, integer, dimension( * ) MVAL, integer NN, integer, dimension( * ) NVAL, integer NNB, integer, dimension( * ) NBVAL, integer, dimension( * ) NXVAL, real THRESH, real, dimension( * ) A, real, dimension( * ) COPYA, real, dimension( * ) S, real, dimension( * ) TAU, real, dimension( * ) WORK, integer, dimension( * ) IWORK, integer NOUT )

SCHKQ3

Purpose:
` SCHKQ3 tests SGEQP3.`
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] NNB ``` NNB is INTEGER The number of values of NB and NX contained in the vectors NBVAL and NXVAL. The blocking parameters are used in pairs (NB,NX).``` [in] NBVAL ``` NBVAL is INTEGER array, dimension (NNB) The values of the blocksize NB.``` [in] NXVAL ``` NXVAL is INTEGER array, dimension (NNB) The values of the crossover point NX.``` [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.``` [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)``` [out] IWORK ` IWORK is INTEGER array, dimension (2*NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```

Definition at line 150 of file schkq3.f.

153 *
154 * -- LAPACK test routine --
155 * -- LAPACK is a software package provided by Univ. of Tennessee, --
156 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
157 *
158 * .. Scalar Arguments ..
159  INTEGER NM, NN, NNB, NOUT
160  REAL THRESH
161 * ..
162 * .. Array Arguments ..
163  LOGICAL DOTYPE( * )
164  INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
165  \$ NXVAL( * )
166  REAL A( * ), COPYA( * ), S( * ),
167  \$ TAU( * ), WORK( * )
168 * ..
169 *
170 * =====================================================================
171 *
172 * .. Parameters ..
173  INTEGER NTYPES
174  parameter( ntypes = 6 )
175  INTEGER NTESTS
176  parameter( ntests = 3 )
177  REAL ONE, ZERO
178  parameter( one = 1.0e0, zero = 0.0e0 )
179 * ..
180 * .. Local Scalars ..
181  CHARACTER*3 PATH
182  INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO,
183  \$ ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N,
184  \$ NB, NERRS, NFAIL, NRUN, NX
185  REAL EPS
186 * ..
187 * .. Local Arrays ..
188  INTEGER ISEED( 4 ), ISEEDY( 4 )
189  REAL RESULT( NTESTS )
190 * ..
191 * .. External Functions ..
192  REAL SLAMCH, SQPT01, SQRT11, SQRT12
193  EXTERNAL slamch, sqpt01, sqrt11, sqrt12
194 * ..
195 * .. External Subroutines ..
196  EXTERNAL alahd, alasum, icopy, sgeqp3, slacpy, slaord,
197  \$ slaset, slatms, xlaenv
198 * ..
199 * .. Intrinsic Functions ..
200  INTRINSIC max, min
201 * ..
202 * .. Scalars in Common ..
203  LOGICAL LERR, OK
204  CHARACTER*32 SRNAMT
205  INTEGER INFOT, IOUNIT
206 * ..
207 * .. Common blocks ..
208  COMMON / infoc / infot, iounit, ok, lerr
209  COMMON / srnamc / srnamt
210 * ..
211 * .. Data statements ..
212  DATA iseedy / 1988, 1989, 1990, 1991 /
213 * ..
214 * .. Executable Statements ..
215 *
216 * Initialize constants and the random number seed.
217 *
218  path( 1: 1 ) = 'Single precision'
219  path( 2: 3 ) = 'Q3'
220  nrun = 0
221  nfail = 0
222  nerrs = 0
223  DO 10 i = 1, 4
224  iseed( i ) = iseedy( i )
225  10 CONTINUE
226  eps = slamch( 'Epsilon' )
227  infot = 0
228 *
229  DO 90 im = 1, nm
230 *
231 * Do for each value of M in MVAL.
232 *
233  m = mval( im )
234  lda = max( 1, m )
235 *
236  DO 80 in = 1, nn
237 *
238 * Do for each value of N in NVAL.
239 *
240  n = nval( in )
241  mnmin = min( m, n )
242  lwork = max( 1, m*max( m, n )+4*mnmin+max( m, n ),
243  \$ m*n + 2*mnmin + 4*n )
244 *
245  DO 70 imode = 1, ntypes
246  IF( .NOT.dotype( imode ) )
247  \$ GO TO 70
248 *
249 * Do for each type of matrix
250 * 1: zero matrix
251 * 2: one small singular value
252 * 3: geometric distribution of singular values
253 * 4: first n/2 columns fixed
254 * 5: last n/2 columns fixed
255 * 6: every second column fixed
256 *
257  mode = imode
258  IF( imode.GT.3 )
259  \$ mode = 1
260 *
261 * Generate test matrix of size m by n using
262 * singular value distribution indicated by `mode'.
263 *
264  DO 20 i = 1, n
265  iwork( i ) = 0
266  20 CONTINUE
267  IF( imode.EQ.1 ) THEN
268  CALL slaset( 'Full', m, n, zero, zero, copya, lda )
269  DO 30 i = 1, mnmin
270  s( i ) = zero
271  30 CONTINUE
272  ELSE
273  CALL slatms( m, n, 'Uniform', iseed, 'Nonsymm', s,
274  \$ mode, one / eps, one, m, n, 'No packing',
275  \$ copya, lda, work, info )
276  IF( imode.GE.4 ) THEN
277  IF( imode.EQ.4 ) THEN
278  ilow = 1
279  istep = 1
280  ihigh = max( 1, n / 2 )
281  ELSE IF( imode.EQ.5 ) THEN
282  ilow = max( 1, n / 2 )
283  istep = 1
284  ihigh = n
285  ELSE IF( imode.EQ.6 ) THEN
286  ilow = 1
287  istep = 2
288  ihigh = n
289  END IF
290  DO 40 i = ilow, ihigh, istep
291  iwork( i ) = 1
292  40 CONTINUE
293  END IF
294  CALL slaord( 'Decreasing', mnmin, s, 1 )
295  END IF
296 *
297  DO 60 inb = 1, nnb
298 *
299 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
300 *
301  nb = nbval( inb )
302  CALL xlaenv( 1, nb )
303  nx = nxval( inb )
304  CALL xlaenv( 3, nx )
305 *
306 * Get a working copy of COPYA into A and a copy of
307 * vector IWORK.
308 *
309  CALL slacpy( 'All', m, n, copya, lda, a, lda )
310  CALL icopy( n, iwork( 1 ), 1, iwork( n+1 ), 1 )
311 *
312 * Compute the QR factorization with pivoting of A
313 *
314  lw = max( 1, 2*n+nb*( n+1 ) )
315 *
316 * Compute the QP3 factorization of A
317 *
318  srnamt = 'SGEQP3'
319  CALL sgeqp3( m, n, a, lda, iwork( n+1 ), tau, work,
320  \$ lw, info )
321 *
322 * Compute norm(svd(a) - svd(r))
323 *
324  result( 1 ) = sqrt12( m, n, a, lda, s, work,
325  \$ lwork )
326 *
327 * Compute norm( A*P - Q*R )
328 *
329  result( 2 ) = sqpt01( m, n, mnmin, copya, a, lda, tau,
330  \$ iwork( n+1 ), work, lwork )
331 *
332 * Compute Q'*Q
333 *
334  result( 3 ) = sqrt11( m, mnmin, a, lda, tau, work,
335  \$ lwork )
336 *
337 * Print information about the tests that did not pass
338 * the threshold.
339 *
340  DO 50 k = 1, ntests
341  IF( result( k ).GE.thresh ) THEN
342  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
343  \$ CALL alahd( nout, path )
344  WRITE( nout, fmt = 9999 )'SGEQP3', m, n, nb,
345  \$ imode, k, result( k )
346  nfail = nfail + 1
347  END IF
348  50 CONTINUE
349  nrun = nrun + ntests
350 *
351  60 CONTINUE
352  70 CONTINUE
353  80 CONTINUE
354  90 CONTINUE
355 *
356 * Print a summary of the results.
357 *
358  CALL alasum( path, nout, nfail, nrun, nerrs )
359 *
360  9999 FORMAT( 1x, a, ' M =', i5, ', N =', i5, ', NB =', i4, ', type ',
361  \$ i2, ', test ', i2, ', ratio =', g12.5 )
362 *
363 * End of SCHKQ3
364 *
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 xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine icopy(N, SX, INCX, SY, INCY)
ICOPY
Definition: icopy.f:75
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:321
subroutine sgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
SGEQP3
Definition: sgeqp3.f:151
subroutine slaord(JOB, N, X, INCX)
SLAORD
Definition: slaord.f:73
real function sqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
SQPT01
Definition: sqpt01.f:120
real function sqrt12(M, N, A, LDA, S, WORK, LWORK)
SQRT12
Definition: sqrt12.f:89
real function sqrt11(M, K, A, LDA, TAU, WORK, LWORK)
SQRT11
Definition: sqrt11.f:98
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: