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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

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

ZCHKQP

Purpose:
 ZCHKQP tests ZGEQPF.
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 COMPLEX*16 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*16 array, dimension (MMAX*NMAX)
[out]S
          S is DOUBLE PRECISION array, dimension
                      (min(MMAX,NMAX))
[out]TAU
          TAU is COMPLEX*16 array, dimension (MMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkqp.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  DOUBLE PRECISION thresh
156 * ..
157 * .. Array Arguments ..
158  LOGICAL dotype( * )
159  INTEGER iwork( * ), mval( * ), nval( * )
160  DOUBLE PRECISION s( * ), rwork( * )
161  COMPLEX*16 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  DOUBLE PRECISION one, zero
172  parameter( one = 1.0d0, zero = 0.0d0 )
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  DOUBLE PRECISION eps
180 * ..
181 * .. Local Arrays ..
182  INTEGER iseed( 4 ), iseedy( 4 )
183  DOUBLE PRECISION result( ntests )
184 * ..
185 * .. External Functions ..
186  DOUBLE PRECISION dlamch, zqpt01, zqrt11, zqrt12
187  EXTERNAL dlamch, zqpt01, zqrt11, zqrt12
188 * ..
189 * .. External Subroutines ..
190  EXTERNAL alahd, alasum, dlaord, zerrqp, zgeqpf, zlacpy,
191  $ zlaset, zlatms
192 * ..
193 * .. Intrinsic Functions ..
194  INTRINSIC dcmplx, 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 ) = 'Zomplex 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 = dlamch( 'Epsilon' )
221 *
222 * Test the error exits
223 *
224  IF( tsterr )
225  $ CALL zerrqp( 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 zlaset( 'Full', m, n, dcmplx( zero ),
267  $ dcmplx( zero ), copya, lda )
268  DO 30 i = 1, mnmin
269  s( i ) = zero
270  30 CONTINUE
271  ELSE
272  CALL zlatms( 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 dlaord( 'Decreasing', mnmin, s, 1 )
294  END IF
295 *
296 * Save A and its singular values
297 *
298  CALL zlacpy( 'All', m, n, copya, lda, a, lda )
299 *
300 * Compute the QR factorization with pivoting of A
301 *
302  srnamt = 'ZGEQPF'
303  CALL zgeqpf( m, n, a, lda, iwork, tau, work, rwork,
304  $ info )
305 *
306 * Compute norm(svd(a) - svd(r))
307 *
308  result( 1 ) = zqrt12( m, n, a, lda, s, work, lwork,
309  $ rwork )
310 *
311 * Compute norm( A*P - Q*R )
312 *
313  result( 2 ) = zqpt01( m, n, mnmin, copya, a, lda, tau,
314  $ iwork, work, lwork )
315 *
316 * Compute Q'*Q
317 *
318  result( 3 ) = zqrt11( 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 ZCHKQP
346 *
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
double precision function zqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
ZQPT01
Definition: zqpt01.f:122
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
double precision function zqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
ZQRT12
Definition: zqrt12.f:99
subroutine zerrqp(PATH, NUNIT)
ZERRQP
Definition: zerrqp.f:56
subroutine dlaord(JOB, N, X, INCX)
DLAORD
Definition: dlaord.f:75
subroutine zgeqpf(M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO)
ZGEQPF
Definition: zgeqpf.f:150
double precision function zqrt11(M, K, A, LDA, TAU, WORK, LWORK)
ZQRT11
Definition: zqrt11.f:100
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function: