LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

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*
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
xlaenv
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
alahd
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
sgeqp3
subroutine sgeqp3(m, n, a, lda, jpvt, tau, work, lwork, info)
SGEQP3
Definition sgeqp3.f:151
slacpy
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
slamch
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
slaset
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
icopy
subroutine icopy(n, sx, incx, sy, incy)
ICOPY
Definition icopy.f:75
slaord
subroutine slaord(job, n, x, incx)
SLAORD
Definition slaord.f:73
slatms
subroutine slatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
SLATMS
Definition slatms.f:321
sqpt01
real function sqpt01(m, n, k, a, af, lda, tau, jpvt, work, lwork)
SQPT01
Definition sqpt01.f:121
sqrt11
real function sqrt11(m, k, a, lda, tau, work, lwork)
SQRT11
Definition sqrt11.f:98
sqrt12
real function sqrt12(m, n, a, lda, s, work, lwork)
SQRT12
Definition sqrt12.f:89
Here is the call graph for this function:
Here is the caller graph for this function: