LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
schkqp.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine schkqp (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, IWORK, NOUT)
 SCHKQP More...
 

Function/Subroutine Documentation

subroutine schkqp ( 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, dimension( * )  IWORK,
integer  NOUT 
)

SCHKQP

Purpose:
 SCHKQP tests SGEQPF.
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)
[out]IWORK
          IWORK is INTEGER array, dimension (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 2011

Definition at line 139 of file schkqp.f.

139 *
140 * -- LAPACK test routine (version 3.4.0) --
141 * -- LAPACK is a software package provided by Univ. of Tennessee, --
142 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
143 * November 2011
144 *
145 * .. Scalar Arguments ..
146  LOGICAL tsterr
147  INTEGER nm, nn, nout
148  REAL thresh
149 * ..
150 * .. Array Arguments ..
151  LOGICAL dotype( * )
152  INTEGER iwork( * ), mval( * ), nval( * )
153  REAL a( * ), copya( * ), s( * ),
154  $ tau( * ), work( * )
155 * ..
156 *
157 * =====================================================================
158 *
159 * .. Parameters ..
160  INTEGER ntypes
161  parameter( ntypes = 6 )
162  INTEGER ntests
163  parameter( ntests = 3 )
164  REAL one, zero
165  parameter( one = 1.0e0, zero = 0.0e0 )
166 * ..
167 * .. Local Scalars ..
168  CHARACTER*3 path
169  INTEGER i, ihigh, ilow, im, imode, in, info, istep, k,
170  $ lda, lwork, m, mnmin, mode, n, nerrs, nfail,
171  $ nrun
172  REAL eps
173 * ..
174 * .. Local Arrays ..
175  INTEGER iseed( 4 ), iseedy( 4 )
176  REAL result( ntests )
177 * ..
178 * .. External Functions ..
179  REAL slamch, sqpt01, sqrt11, sqrt12
180  EXTERNAL slamch, sqpt01, sqrt11, sqrt12
181 * ..
182 * .. External Subroutines ..
183  EXTERNAL alahd, alasum, serrqp, sgeqpf, slacpy, slaord,
184  $ slaset, slatms
185 * ..
186 * .. Intrinsic Functions ..
187  INTRINSIC max, min
188 * ..
189 * .. Scalars in Common ..
190  LOGICAL lerr, ok
191  CHARACTER*32 srnamt
192  INTEGER infot, iounit
193 * ..
194 * .. Common blocks ..
195  COMMON / infoc / infot, iounit, ok, lerr
196  COMMON / srnamc / srnamt
197 * ..
198 * .. Data statements ..
199  DATA iseedy / 1988, 1989, 1990, 1991 /
200 * ..
201 * .. Executable Statements ..
202 *
203 * Initialize constants and the random number seed.
204 *
205  path( 1: 1 ) = 'Single precision'
206  path( 2: 3 ) = 'QP'
207  nrun = 0
208  nfail = 0
209  nerrs = 0
210  DO 10 i = 1, 4
211  iseed( i ) = iseedy( i )
212  10 CONTINUE
213  eps = slamch( 'Epsilon' )
214 *
215 * Test the error exits
216 *
217  IF( tsterr )
218  $ CALL serrqp( path, nout )
219  infot = 0
220 *
221  DO 80 im = 1, nm
222 *
223 * Do for each value of M in MVAL.
224 *
225  m = mval( im )
226  lda = max( 1, m )
227 *
228  DO 70 in = 1, nn
229 *
230 * Do for each value of N in NVAL.
231 *
232  n = nval( in )
233  mnmin = min( m, n )
234  lwork = max( 1, m*max( m, n ) + 4*mnmin + max( m, n ),
235  $ m*n + 2*mnmin + 4*n )
236 *
237  DO 60 imode = 1, ntypes
238  IF( .NOT.dotype( imode ) )
239  $ GO TO 60
240 *
241 * Do for each type of matrix
242 * 1: zero matrix
243 * 2: one small singular value
244 * 3: geometric distribution of singular values
245 * 4: first n/2 columns fixed
246 * 5: last n/2 columns fixed
247 * 6: every second column fixed
248 *
249  mode = imode
250  IF( imode.GT.3 )
251  $ mode = 1
252 *
253 * Generate test matrix of size m by n using
254 * singular value distribution indicated by `mode'.
255 *
256  DO 20 i = 1, n
257  iwork( i ) = 0
258  20 CONTINUE
259  IF( imode.EQ.1 ) THEN
260  CALL slaset( 'Full', m, n, zero, zero, copya, lda )
261  DO 30 i = 1, mnmin
262  s( i ) = zero
263  30 CONTINUE
264  ELSE
265  CALL slatms( m, n, 'Uniform', iseed, 'Nonsymm', s,
266  $ mode, one / eps, one, m, n, 'No packing',
267  $ copya, lda, work, info )
268  IF( imode.GE.4 ) THEN
269  IF( imode.EQ.4 ) THEN
270  ilow = 1
271  istep = 1
272  ihigh = max( 1, n / 2 )
273  ELSE IF( imode.EQ.5 ) THEN
274  ilow = max( 1, n / 2 )
275  istep = 1
276  ihigh = n
277  ELSE IF( imode.EQ.6 ) THEN
278  ilow = 1
279  istep = 2
280  ihigh = n
281  END IF
282  DO 40 i = ilow, ihigh, istep
283  iwork( i ) = 1
284  40 CONTINUE
285  END IF
286  CALL slaord( 'Decreasing', mnmin, s, 1 )
287  END IF
288 *
289 * Save A and its singular values
290 *
291  CALL slacpy( 'All', m, n, copya, lda, a, lda )
292 *
293 * Compute the QR factorization with pivoting of A
294 *
295  srnamt = 'SGEQPF'
296  CALL sgeqpf( m, n, a, lda, iwork, tau, work, info )
297 *
298 * Compute norm(svd(a) - svd(r))
299 *
300  result( 1 ) = sqrt12( m, n, a, lda, s, work, lwork )
301 *
302 * Compute norm( A*P - Q*R )
303 *
304  result( 2 ) = sqpt01( m, n, mnmin, copya, a, lda, tau,
305  $ iwork, work, lwork )
306 *
307 * Compute Q'*Q
308 *
309  result( 3 ) = sqrt11( m, mnmin, a, lda, tau, work,
310  $ lwork )
311 *
312 * Print information about the tests that did not pass
313 * the threshold.
314 *
315  DO 50 k = 1, 3
316  IF( result( k ).GE.thresh ) THEN
317  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
318  $ CALL alahd( nout, path )
319  WRITE( nout, fmt = 9999 )m, n, imode, k,
320  $ result( k )
321  nfail = nfail + 1
322  END IF
323  50 CONTINUE
324  nrun = nrun + 3
325  60 CONTINUE
326  70 CONTINUE
327  80 CONTINUE
328 *
329 * Print a summary of the results.
330 *
331  CALL alasum( path, nout, nfail, nrun, nerrs )
332 *
333  9999 FORMAT( ' M =', i5, ', N =', i5, ', type ', i2, ', test ', i2,
334  $ ', ratio =', g12.5 )
335 *
336 * End of SCHKQP
337 *
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:112
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
real function sqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
SQPT01
Definition: sqpt01.f:122
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
real function sqrt12(M, N, A, LDA, S, WORK, LWORK)
SQRT12
Definition: sqrt12.f:91
subroutine serrqp(PATH, NUNIT)
SERRQP
Definition: serrqp.f:56
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine slaord(JOB, N, X, INCX)
SLAORD
Definition: slaord.f:75
subroutine sgeqpf(M, N, A, LDA, JPVT, TAU, WORK, INFO)
SGEQPF
Definition: sgeqpf.f:144
real function sqrt11(M, K, A, LDA, TAU, WORK, LWORK)
SQRT11
Definition: sqrt11.f:100

Here is the call graph for this function:

Here is the caller graph for this function: