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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

subroutine dchkqp ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
double precision  THRESH,
logical  TSTERR,
double precision, dimension( * )  A,
double precision, dimension( * )  COPYA,
double precision, dimension( * )  S,
double precision, dimension( * )  TAU,
double precision, dimension( * )  WORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DCHKQP

Purpose:
 DCHKQP tests DGEQPF.
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 DOUBLE PRECISION
          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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (MMAX*NMAX)
[out]S
          S is DOUBLE PRECISION array, dimension
                      (min(MMAX,NMAX))
[out]TAU
          TAU is DOUBLE PRECISION array, dimension (MMAX)
[out]WORK
          WORK is DOUBLE PRECISION 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 dchkqp.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  DOUBLE PRECISION thresh
149 * ..
150 * .. Array Arguments ..
151  LOGICAL dotype( * )
152  INTEGER iwork( * ), mval( * ), nval( * )
153  DOUBLE PRECISION 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  DOUBLE PRECISION one, zero
165  parameter( one = 1.0d0, zero = 0.0d0 )
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  DOUBLE PRECISION eps
173 * ..
174 * .. Local Arrays ..
175  INTEGER iseed( 4 ), iseedy( 4 )
176  DOUBLE PRECISION result( ntests )
177 * ..
178 * .. External Functions ..
179  DOUBLE PRECISION dlamch, dqpt01, dqrt11, dqrt12
180  EXTERNAL dlamch, dqpt01, dqrt11, dqrt12
181 * ..
182 * .. External Subroutines ..
183  EXTERNAL alahd, alasum, derrqp, dgeqpf, dlacpy, dlaord,
184  $ dlaset, dlatms
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 ) = 'Double 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 = dlamch( 'Epsilon' )
214 *
215 * Test the error exits
216 *
217  IF( tsterr )
218  $ CALL derrqp( 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 dlaset( 'Full', m, n, zero, zero, copya, lda )
261  DO 30 i = 1, mnmin
262  s( i ) = zero
263  30 CONTINUE
264  ELSE
265  CALL dlatms( 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 dlaord( 'Decreasing', mnmin, s, 1 )
287  END IF
288 *
289 * Save A and its singular values
290 *
291  CALL dlacpy( 'All', m, n, copya, lda, a, lda )
292 *
293 * Compute the QR factorization with pivoting of A
294 *
295  srnamt = 'DGEQPF'
296  CALL dgeqpf( m, n, a, lda, iwork, tau, work, info )
297 *
298 * Compute norm(svd(a) - svd(r))
299 *
300  result( 1 ) = dqrt12( m, n, a, lda, s, work, lwork )
301 *
302 * Compute norm( A*P - Q*R )
303 *
304  result( 2 ) = dqpt01( m, n, mnmin, copya, a, lda, tau,
305  $ iwork, work, lwork )
306 *
307 * Compute Q'*Q
308 *
309  result( 3 ) = dqrt11( 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 DCHKQP
337 *
subroutine derrqp(PATH, NUNIT)
DERRQP
Definition: derrqp.f:56
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
double precision function dqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
DQPT01
Definition: dqpt01.f:122
double precision function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
Definition: dqrt12.f:91
subroutine dlaord(JOB, N, X, INCX)
DLAORD
Definition: dlaord.f:75
double precision function dqrt11(M, K, A, LDA, TAU, WORK, LWORK)
DQRT11
Definition: dqrt11.f:100
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine dgeqpf(M, N, A, LDA, JPVT, TAU, WORK, INFO)
DGEQPF
Definition: dgeqpf.f:144
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112

Here is the call graph for this function:

Here is the caller graph for this function: