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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

subroutine cchkqp ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
real  THRESH,
logical  TSTERR,
complex, dimension( * )  A,
complex, dimension( * )  COPYA,
real, dimension( * )  S,
complex, dimension( * )  TAU,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKQP

Purpose:
 CCHKQP tests CGEQPF.
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 COMPLEX 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 COMPLEX array, dimension (MMAX*NMAX)
[out]S
          S is REAL array, dimension
                      (min(MMAX,NMAX))
[out]TAU
          TAU is COMPLEX array, dimension (MMAX)
[out]WORK
          WORK is COMPLEX array, dimension
                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
[out]RWORK
          RWORK is REAL array, dimension (4*NMAX)
[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 146 of file cchkqp.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: