WARNING: xGEQPF is still used in xGGSVP routines.
set(SLINTST schkaa.f
schkeq.f schkgb.f schkge.f schkgt.f
schklq.f schkpb.f schkpo.f schkps.f schkpp.f
- schkpt.f schkq3.f schkql.f schkqp.f schkqr.f schkrq.f
+ schkpt.f schkq3.f schkql.f schkqr.f schkrq.f
schksp.f schksy.f schksy_rook.f schktb.f schktp.f schktr.f
schktz.f
sdrvgt.f sdrvls.f sdrvpb.f
set(CLINTST cchkaa.f
cchkeq.f cchkgb.f cchkge.f cchkgt.f
cchkhe.f cchkhe_rook.f cchkhp.f cchklq.f cchkpb.f
- cchkpo.f cchkps.f cchkpp.f cchkpt.f cchkq3.f cchkql.f cchkqp.f
+ cchkpo.f cchkps.f cchkpp.f cchkpt.f cchkq3.f cchkql.f
cchkqr.f cchkrq.f cchksp.f cchksy.f cchksy_rook.f cchktb.f
cchktp.f cchktr.f cchktz.f
cdrvgt.f cdrvhe.f cdrvhe_rook.f cdrvhp.f
set(DLINTST dchkaa.f
dchkeq.f dchkgb.f dchkge.f dchkgt.f
dchklq.f dchkpb.f dchkpo.f dchkps.f dchkpp.f
- dchkpt.f dchkq3.f dchkql.f dchkqp.f dchkqr.f dchkrq.f
+ dchkpt.f dchkq3.f dchkql.f dchkqr.f dchkrq.f
dchksp.f dchksy.f dchksy_rook.f dchktb.f dchktp.f dchktr.f
dchktz.f
ddrvgt.f ddrvls.f ddrvpb.f
set(ZLINTST zchkaa.f
zchkeq.f zchkgb.f zchkge.f zchkgt.f
zchkhe.f zchkhe_rook.f zchkhp.f zchklq.f zchkpb.f
- zchkpo.f zchkps.f zchkpp.f zchkpt.f zchkq3.f zchkql.f zchkqp.f
+ zchkpo.f zchkps.f zchkpp.f zchkpt.f zchkq3.f zchkql.f
zchkqr.f zchkrq.f zchksp.f zchksy.f zchksy_rook.f zchktb.f
zchktp.f zchktr.f zchktz.f
zdrvgt.f zdrvhe.f zdrvhe_rook.f zdrvhp.f
SLINTST = schkaa.o \
schkeq.o schkgb.o schkge.o schkgt.o \
schklq.o schkpb.o schkpo.o schkps.o schkpp.o \
- schkpt.o schkq3.o schkql.o schkqp.o schkqr.o schkrq.o \
+ schkpt.o schkq3.o schkql.o schkqr.o schkrq.o \
schksp.o schksy.o schksy_rook.o schktb.o schktp.o schktr.o \
schktz.o \
sdrvgt.o sdrvls.o sdrvpb.o \
CLINTST = cchkaa.o \
cchkeq.o cchkgb.o cchkge.o cchkgt.o \
cchkhe.o cchkhe_rook.o cchkhp.o cchklq.o cchkpb.o \
- cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkql.o cchkqp.o \
+ cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkql.o \
cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchktb.o \
cchktp.o cchktr.o cchktz.o \
cdrvgt.o cdrvhe_rook.o cdrvhp.o \
DLINTST = dchkaa.o \
dchkeq.o dchkgb.o dchkge.o dchkgt.o \
dchklq.o dchkpb.o dchkpo.o dchkps.o dchkpp.o \
- dchkpt.o dchkq3.o dchkql.o dchkqp.o dchkqr.o dchkrq.o \
+ dchkpt.o dchkq3.o dchkql.o dchkqr.o dchkrq.o \
dchksp.o dchksy.o dchksy_rook.o dchktb.o dchktp.o dchktr.o \
dchktz.o \
ddrvgt.o ddrvls.o ddrvpb.o \
ZLINTST = zchkaa.o \
zchkeq.o zchkgb.o zchkge.o zchkgt.o \
zchkhe.o zchkhe_rook.o zchkhp.o zchklq.o zchkpb.o \
- zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkql.o zchkqp.o \
+ zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkql.o \
zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchktb.o \
zchktp.o zchktr.o zchktz.o \
zdrvgt.o zdrvhe_rook.o zdrvhp.o \
* .. External Subroutines ..
EXTERNAL ALAREQ, CCHKEQ, CCHKGB, CCHKGE, CCHKGT, CCHKHE,
$ CCHKHE_ROOK, CCHKHP, CCHKLQ, CCHKPB, CCHKPO,
- $ CCHKPS, CCHKPP, CCHKPT, CCHKQ3, CCHKQL, CCHKQP,
+ $ CCHKPS, CCHKPP, CCHKPT, CCHKQ3, CCHKQL,
$ CCHKQR, CCHKRQ, CCHKSP, CCHKSY, CCHKSY_ROOK,
$ CCHKTB, CCHKTP, CCHKTR, CCHKTZ, CDRVGB, CDRVGE,
$ CDRVGT, CDRVHE, CDRVHE_ROOK, CDRVHP, CDRVLS,
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
IF( TSTCHK ) THEN
- CALL CCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
- $ A( 1, 1 ), A( 1, 2 ), S( 1 ),
- $ B( 1, 1 ), WORK, RWORK, IWORK, NOUT )
CALL CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
$ THRESH, A( 1, 1 ), A( 1, 2 ), S( 1 ),
$ B( 1, 1 ), WORK, RWORK, IWORK, NOUT )
+++ /dev/null
-*> \brief \b CCHKQP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE CCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
-* COPYA, S, TAU, WORK, RWORK, IWORK,
-* NOUT )
-*
-* .. Scalar Arguments ..
-* LOGICAL TSTERR
-* INTEGER NM, NN, NOUT
-* REAL THRESH
-* ..
-* .. Array Arguments ..
-* LOGICAL DOTYPE( * )
-* INTEGER IWORK( * ), MVAL( * ), NVAL( * )
-* REAL S( * ), RWORK( * )
-* COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> CCHKQP tests CGEQPF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DOTYPE
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] NM
-*> \verbatim
-*> NM is INTEGER
-*> The number of values of M contained in the vector MVAL.
-*> \endverbatim
-*>
-*> \param[in] MVAL
-*> \verbatim
-*> MVAL is INTEGER array, dimension (NM)
-*> The values of the matrix row dimension M.
-*> \endverbatim
-*>
-*> \param[in] NN
-*> \verbatim
-*> NN is INTEGER
-*> The number of values of N contained in the vector NVAL.
-*> \endverbatim
-*>
-*> \param[in] NVAL
-*> \verbatim
-*> NVAL is INTEGER array, dimension (NN)
-*> The values of the matrix column dimension N.
-*> \endverbatim
-*>
-*> \param[in] THRESH
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] TSTERR
-*> \verbatim
-*> TSTERR is LOGICAL
-*> Flag that indicates whether error exits are to be tested.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[out] COPYA
-*> \verbatim
-*> COPYA is COMPLEX array, dimension (MMAX*NMAX)
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension
-*> (min(MMAX,NMAX))
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is COMPLEX array, dimension (MMAX)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is COMPLEX array, dimension
-*> (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
-*> \endverbatim
-*>
-*> \param[out] RWORK
-*> \verbatim
-*> RWORK is REAL array, dimension (4*NMAX)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (NMAX)
-*> \endverbatim
-*>
-*> \param[in] NOUT
-*> \verbatim
-*> NOUT is INTEGER
-*> The unit number for output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex_lin
-*
-* =====================================================================
- SUBROUTINE CCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
- $ COPYA, S, TAU, WORK, RWORK, IWORK,
- $ NOUT )
-*
-* -- LAPACK test routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL TSTERR
- INTEGER NM, NN, NOUT
- REAL THRESH
-* ..
-* .. Array Arguments ..
- LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- REAL S( * ), RWORK( * )
- COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NTYPES
- PARAMETER ( NTYPES = 6 )
- INTEGER NTESTS
- PARAMETER ( NTESTS = 3 )
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- CHARACTER*3 PATH
- INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INFO, ISTEP, K,
- $ LDA, LWORK, M, MNMIN, MODE, N, NERRS, NFAIL,
- $ NRUN
- REAL EPS
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 )
- REAL RESULT( NTESTS )
-* ..
-* .. External Functions ..
- REAL CQPT01, CQRT11, CQRT12, SLAMCH
- EXTERNAL CQPT01, CQRT11, CQRT12, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL ALAHD, ALASUM, CERRQP, CGEQPF, CLACPY, CLASET,
- $ CLATMS, SLAORD
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC CMPLX, MAX, MIN
-* ..
-* .. Scalars in Common ..
- LOGICAL LERR, OK
- CHARACTER*32 SRNAMT
- INTEGER INFOT, IOUNIT
-* ..
-* .. Common blocks ..
- COMMON / INFOC / INFOT, IOUNIT, OK, LERR
- COMMON / SRNAMC / SRNAMT
-* ..
-* .. Data statements ..
- DATA ISEEDY / 1988, 1989, 1990, 1991 /
-* ..
-* .. Executable Statements ..
-*
-* Initialize constants and the random number seed.
-*
- PATH( 1: 1 ) = 'Complex precision'
- PATH( 2: 3 ) = 'QP'
- NRUN = 0
- NFAIL = 0
- NERRS = 0
- DO 10 I = 1, 4
- ISEED( I ) = ISEEDY( I )
- 10 CONTINUE
- EPS = SLAMCH( 'Epsilon' )
-*
-* Test the error exits
-*
- IF( TSTERR )
- $ CALL CERRQP( PATH, NOUT )
- INFOT = 0
-*
- DO 80 IM = 1, NM
-*
-* Do for each value of M in MVAL.
-*
- M = MVAL( IM )
- LDA = MAX( 1, M )
-*
- DO 70 IN = 1, NN
-*
-* Do for each value of N in NVAL.
-*
- N = NVAL( IN )
- MNMIN = MIN( M, N )
- LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
-*
- DO 60 IMODE = 1, NTYPES
- IF( .NOT.DOTYPE( IMODE ) )
- $ GO TO 60
-*
-* Do for each type of matrix
-* 1: zero matrix
-* 2: one small singular value
-* 3: geometric distribution of singular values
-* 4: first n/2 columns fixed
-* 5: last n/2 columns fixed
-* 6: every second column fixed
-*
- MODE = IMODE
- IF( IMODE.GT.3 )
- $ MODE = 1
-*
-* Generate test matrix of size m by n using
-* singular value distribution indicated by `mode'.
-*
- DO 20 I = 1, N
- IWORK( I ) = 0
- 20 CONTINUE
- IF( IMODE.EQ.1 ) THEN
- CALL CLASET( 'Full', M, N, CMPLX( ZERO ),
- $ CMPLX( ZERO ), COPYA, LDA )
- DO 30 I = 1, MNMIN
- S( I ) = ZERO
- 30 CONTINUE
- ELSE
- CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
- $ MODE, ONE / EPS, ONE, M, N, 'No packing',
- $ COPYA, LDA, WORK, INFO )
- IF( IMODE.GE.4 ) THEN
- IF( IMODE.EQ.4 ) THEN
- ILOW = 1
- ISTEP = 1
- IHIGH = MAX( 1, N / 2 )
- ELSE IF( IMODE.EQ.5 ) THEN
- ILOW = MAX( 1, N / 2 )
- ISTEP = 1
- IHIGH = N
- ELSE IF( IMODE.EQ.6 ) THEN
- ILOW = 1
- ISTEP = 2
- IHIGH = N
- END IF
- DO 40 I = ILOW, IHIGH, ISTEP
- IWORK( I ) = 1
- 40 CONTINUE
- END IF
- CALL SLAORD( 'Decreasing', MNMIN, S, 1 )
- END IF
-*
-* Save A and its singular values
-*
- CALL CLACPY( 'All', M, N, COPYA, LDA, A, LDA )
-*
-* Compute the QR factorization with pivoting of A
-*
- SRNAMT = 'CGEQPF'
- CALL CGEQPF( M, N, A, LDA, IWORK, TAU, WORK, RWORK,
- $ INFO )
-*
-* Compute norm(svd(a) - svd(r))
-*
- RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK, LWORK,
- $ RWORK )
-*
-* Compute norm( A*P - Q*R )
-*
- RESULT( 2 ) = CQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
- $ IWORK, WORK, LWORK )
-*
-* Compute Q'*Q
-*
- RESULT( 3 ) = CQRT11( M, MNMIN, A, LDA, TAU, WORK,
- $ LWORK )
-*
-* Print information about the tests that did not pass
-* the threshold.
-*
- DO 50 K = 1, 3
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9999 )M, N, IMODE, K,
- $ RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 50 CONTINUE
- NRUN = NRUN + 3
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
-*
-* Print a summary of the results.
-*
- CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
-*
- 9999 FORMAT( ' M =', I5, ', N =', I5, ', type ', I2, ', test ', I2,
- $ ', ratio =', G12.5 )
-*
-* End of CCHKQP
-*
- END
*>
*> \verbatim
*>
-*> CERRQP tests the error exits for CGEQPF and CGEQP3.
+*> CERRQP tests the error exits for CGEQP3.
*> \endverbatim
*
* Arguments:
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
- EXTERNAL ALAESM, CGEQP3, CGEQPF, CHKXER
+ EXTERNAL ALAESM, CGEQP3, CHKXER
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*
IF( LSAMEN( 2, C2, 'QP' ) ) THEN
*
-* CGEQPF
-*
- SRNAMT = 'CGEQPF'
- INFOT = 1
- CALL CGEQPF( -1, 0, A, 1, IP, TAU, W, RW, INFO )
- CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL CGEQPF( 0, -1, A, 1, IP, TAU, W, RW, INFO )
- CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL CGEQPF( 2, 0, A, 1, IP, TAU, W, RW, INFO )
- CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
-*
* CGEQP3
*
SRNAMT = 'CGEQP3'
* .. External Subroutines ..
EXTERNAL ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ,
$ DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3,
- $ DCHKQL, DCHKQP, DCHKQR, DCHKRQ, DCHKSP, DCHKSY,
+ $ DCHKQL, DCHKQR, DCHKRQ, DCHKSP, DCHKSY,
$ DCHKSY_ROOK, DCHKTB, DCHKTP, DCHKTR, DCHKTZ,
$ DDRVGB, DDRVGE, DDRVGT, DDRVLS, DDRVPB, DDRVPO,
$ DDRVPP, DDRVPT, DDRVSP, DDRVSY, DDRVSY_ROOK,
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
IF( TSTCHK ) THEN
- CALL DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
- $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
- $ B( 1, 3 ), WORK, IWORK, NOUT )
CALL DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
$ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
$ B( 1, 3 ), WORK, IWORK, NOUT )
+++ /dev/null
-*> \brief \b DCHKQP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
-* COPYA, S, TAU, WORK, IWORK, NOUT )
-*
-* .. Scalar Arguments ..
-* LOGICAL TSTERR
-* INTEGER NM, NN, NOUT
-* DOUBLE PRECISION THRESH
-* ..
-* .. Array Arguments ..
-* LOGICAL DOTYPE( * )
-* INTEGER IWORK( * ), MVAL( * ), NVAL( * )
-* DOUBLE PRECISION A( * ), COPYA( * ), S( * ),
-* $ TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DCHKQP tests DGEQPF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DOTYPE
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] NM
-*> \verbatim
-*> NM is INTEGER
-*> The number of values of M contained in the vector MVAL.
-*> \endverbatim
-*>
-*> \param[in] MVAL
-*> \verbatim
-*> MVAL is INTEGER array, dimension (NM)
-*> The values of the matrix row dimension M.
-*> \endverbatim
-*>
-*> \param[in] NN
-*> \verbatim
-*> NN is INTEGER
-*> The number of values of N contained in the vector NVAL.
-*> \endverbatim
-*>
-*> \param[in] NVAL
-*> \verbatim
-*> NVAL is INTEGER array, dimension (NN)
-*> The values of the matrix column dimension N.
-*> \endverbatim
-*>
-*> \param[in] THRESH
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] TSTERR
-*> \verbatim
-*> TSTERR is LOGICAL
-*> Flag that indicates whether error exits are to be tested.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[out] COPYA
-*> \verbatim
-*> COPYA is DOUBLE PRECISION array, dimension (MMAX*NMAX)
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension
-*> (min(MMAX,NMAX))
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (MMAX)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (MMAX*NMAX + 4*NMAX + MMAX)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (NMAX)
-*> \endverbatim
-*>
-*> \param[in] NOUT
-*> \verbatim
-*> NOUT is INTEGER
-*> The unit number for output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_lin
-*
-* =====================================================================
- SUBROUTINE DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
- $ COPYA, S, TAU, WORK, IWORK, NOUT )
-*
-* -- LAPACK test routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL TSTERR
- INTEGER NM, NN, NOUT
- DOUBLE PRECISION THRESH
-* ..
-* .. Array Arguments ..
- LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- DOUBLE PRECISION A( * ), COPYA( * ), S( * ),
- $ TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NTYPES
- PARAMETER ( NTYPES = 6 )
- INTEGER NTESTS
- PARAMETER ( NTESTS = 3 )
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- CHARACTER*3 PATH
- INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INFO, ISTEP, K,
- $ LDA, LWORK, M, MNMIN, MODE, N, NERRS, NFAIL,
- $ NRUN
- DOUBLE PRECISION EPS
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 )
- DOUBLE PRECISION RESULT( NTESTS )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DQPT01, DQRT11, DQRT12
- EXTERNAL DLAMCH, DQPT01, DQRT11, DQRT12
-* ..
-* .. External Subroutines ..
- EXTERNAL ALAHD, ALASUM, DERRQP, DGEQPF, DLACPY, DLAORD,
- $ DLASET, DLATMS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Scalars in Common ..
- LOGICAL LERR, OK
- CHARACTER*32 SRNAMT
- INTEGER INFOT, IOUNIT
-* ..
-* .. Common blocks ..
- COMMON / INFOC / INFOT, IOUNIT, OK, LERR
- COMMON / SRNAMC / SRNAMT
-* ..
-* .. Data statements ..
- DATA ISEEDY / 1988, 1989, 1990, 1991 /
-* ..
-* .. Executable Statements ..
-*
-* Initialize constants and the random number seed.
-*
- PATH( 1: 1 ) = 'Double precision'
- PATH( 2: 3 ) = 'QP'
- NRUN = 0
- NFAIL = 0
- NERRS = 0
- DO 10 I = 1, 4
- ISEED( I ) = ISEEDY( I )
- 10 CONTINUE
- EPS = DLAMCH( 'Epsilon' )
-*
-* Test the error exits
-*
- IF( TSTERR )
- $ CALL DERRQP( PATH, NOUT )
- INFOT = 0
-*
- DO 80 IM = 1, NM
-*
-* Do for each value of M in MVAL.
-*
- M = MVAL( IM )
- LDA = MAX( 1, M )
-*
- DO 70 IN = 1, NN
-*
-* Do for each value of N in NVAL.
-*
- N = NVAL( IN )
- MNMIN = MIN( M, N )
- LWORK = MAX( 1, M*MAX( M, N ) + 4*MNMIN + MAX( M, N ),
- $ M*N + 2*MNMIN + 4*N )
-*
- DO 60 IMODE = 1, NTYPES
- IF( .NOT.DOTYPE( IMODE ) )
- $ GO TO 60
-*
-* Do for each type of matrix
-* 1: zero matrix
-* 2: one small singular value
-* 3: geometric distribution of singular values
-* 4: first n/2 columns fixed
-* 5: last n/2 columns fixed
-* 6: every second column fixed
-*
- MODE = IMODE
- IF( IMODE.GT.3 )
- $ MODE = 1
-*
-* Generate test matrix of size m by n using
-* singular value distribution indicated by `mode'.
-*
- DO 20 I = 1, N
- IWORK( I ) = 0
- 20 CONTINUE
- IF( IMODE.EQ.1 ) THEN
- CALL DLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA )
- DO 30 I = 1, MNMIN
- S( I ) = ZERO
- 30 CONTINUE
- ELSE
- CALL DLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
- $ MODE, ONE / EPS, ONE, M, N, 'No packing',
- $ COPYA, LDA, WORK, INFO )
- IF( IMODE.GE.4 ) THEN
- IF( IMODE.EQ.4 ) THEN
- ILOW = 1
- ISTEP = 1
- IHIGH = MAX( 1, N / 2 )
- ELSE IF( IMODE.EQ.5 ) THEN
- ILOW = MAX( 1, N / 2 )
- ISTEP = 1
- IHIGH = N
- ELSE IF( IMODE.EQ.6 ) THEN
- ILOW = 1
- ISTEP = 2
- IHIGH = N
- END IF
- DO 40 I = ILOW, IHIGH, ISTEP
- IWORK( I ) = 1
- 40 CONTINUE
- END IF
- CALL DLAORD( 'Decreasing', MNMIN, S, 1 )
- END IF
-*
-* Save A and its singular values
-*
- CALL DLACPY( 'All', M, N, COPYA, LDA, A, LDA )
-*
-* Compute the QR factorization with pivoting of A
-*
- SRNAMT = 'DGEQPF'
- CALL DGEQPF( M, N, A, LDA, IWORK, TAU, WORK, INFO )
-*
-* Compute norm(svd(a) - svd(r))
-*
- RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, LWORK )
-*
-* Compute norm( A*P - Q*R )
-*
- RESULT( 2 ) = DQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
- $ IWORK, WORK, LWORK )
-*
-* Compute Q'*Q
-*
- RESULT( 3 ) = DQRT11( M, MNMIN, A, LDA, TAU, WORK,
- $ LWORK )
-*
-* Print information about the tests that did not pass
-* the threshold.
-*
- DO 50 K = 1, 3
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9999 )M, N, IMODE, K,
- $ RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 50 CONTINUE
- NRUN = NRUN + 3
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
-*
-* Print a summary of the results.
-*
- CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
-*
- 9999 FORMAT( ' M =', I5, ', N =', I5, ', type ', I2, ', test ', I2,
- $ ', ratio =', G12.5 )
-*
-* End of DCHKQP
-*
- END
*>
*> \verbatim
*>
-*> DERRQP tests the error exits for DGEQPF and DGEQP3.
+*> DERRQP tests the error exits for DGEQP3.
*> \endverbatim
*
* Arguments:
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
- EXTERNAL ALAESM, CHKXER, DGEQP3, DGEQPF
+ EXTERNAL ALAESM, CHKXER, DGEQP3
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*
* Test error exits for QR factorization with pivoting
*
-* DGEQPF
-*
- SRNAMT = 'DGEQPF'
- INFOT = 1
- CALL DGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
- CALL CHKXER( 'DGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL DGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
- CALL CHKXER( 'DGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL DGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
- CALL CHKXER( 'DGEQPF', INFOT, NOUT, LERR, OK )
-*
* DGEQP3
*
SRNAMT = 'DGEQP3'
* .. External Subroutines ..
EXTERNAL ALAREQ, SCHKEQ, SCHKGB, SCHKGE, SCHKGT, SCHKLQ,
$ SCHKPB, SCHKPO, SCHKPS, SCHKPP, SCHKPT, SCHKQ3,
- $ SCHKQL, SCHKQP, SCHKQR, SCHKRQ, SCHKSP, SCHKSY,
+ $ SCHKQL, SCHKQR, SCHKRQ, SCHKSP, SCHKSY,
$ SCHKSY_ROOK, SCHKTB, SCHKTP, SCHKTR, SCHKTZ,
$ SDRVGB, SDRVGE, SDRVGT, SDRVLS, SDRVPB, SDRVPO,
$ SDRVPP, SDRVPT, SDRVSP, SDRVSY, SDRVSY_ROOK,
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
IF( TSTCHK ) THEN
- CALL SCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
- $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
- $ B( 1, 3 ), WORK, IWORK, NOUT )
CALL SCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
$ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
$ B( 1, 3 ), WORK, IWORK, NOUT )
+++ /dev/null
-*> \brief \b SCHKQP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
-* COPYA, S, TAU, WORK, IWORK, NOUT )
-*
-* .. Scalar Arguments ..
-* LOGICAL TSTERR
-* INTEGER NM, NN, NOUT
-* REAL THRESH
-* ..
-* .. Array Arguments ..
-* LOGICAL DOTYPE( * )
-* INTEGER IWORK( * ), MVAL( * ), NVAL( * )
-* REAL A( * ), COPYA( * ), S( * ),
-* $ TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SCHKQP tests SGEQPF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DOTYPE
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] NM
-*> \verbatim
-*> NM is INTEGER
-*> The number of values of M contained in the vector MVAL.
-*> \endverbatim
-*>
-*> \param[in] MVAL
-*> \verbatim
-*> MVAL is INTEGER array, dimension (NM)
-*> The values of the matrix row dimension M.
-*> \endverbatim
-*>
-*> \param[in] NN
-*> \verbatim
-*> NN is INTEGER
-*> The number of values of N contained in the vector NVAL.
-*> \endverbatim
-*>
-*> \param[in] NVAL
-*> \verbatim
-*> NVAL is INTEGER array, dimension (NN)
-*> The values of the matrix column dimension N.
-*> \endverbatim
-*>
-*> \param[in] THRESH
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] TSTERR
-*> \verbatim
-*> TSTERR is LOGICAL
-*> Flag that indicates whether error exits are to be tested.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[out] COPYA
-*> \verbatim
-*> COPYA is REAL array, dimension (MMAX*NMAX)
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension
-*> (min(MMAX,NMAX))
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (MMAX)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (MMAX*NMAX + 4*NMAX + MMAX)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (NMAX)
-*> \endverbatim
-*>
-*> \param[in] NOUT
-*> \verbatim
-*> NOUT is INTEGER
-*> The unit number for output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup single_lin
-*
-* =====================================================================
- SUBROUTINE SCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
- $ COPYA, S, TAU, WORK, IWORK, NOUT )
-*
-* -- LAPACK test routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL TSTERR
- INTEGER NM, NN, NOUT
- REAL THRESH
-* ..
-* .. Array Arguments ..
- LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- REAL A( * ), COPYA( * ), S( * ),
- $ TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NTYPES
- PARAMETER ( NTYPES = 6 )
- INTEGER NTESTS
- PARAMETER ( NTESTS = 3 )
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- CHARACTER*3 PATH
- INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INFO, ISTEP, K,
- $ LDA, LWORK, M, MNMIN, MODE, N, NERRS, NFAIL,
- $ NRUN
- REAL EPS
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 )
- REAL RESULT( NTESTS )
-* ..
-* .. External Functions ..
- REAL SLAMCH, SQPT01, SQRT11, SQRT12
- EXTERNAL SLAMCH, SQPT01, SQRT11, SQRT12
-* ..
-* .. External Subroutines ..
- EXTERNAL ALAHD, ALASUM, SERRQP, SGEQPF, SLACPY, SLAORD,
- $ SLASET, SLATMS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Scalars in Common ..
- LOGICAL LERR, OK
- CHARACTER*32 SRNAMT
- INTEGER INFOT, IOUNIT
-* ..
-* .. Common blocks ..
- COMMON / INFOC / INFOT, IOUNIT, OK, LERR
- COMMON / SRNAMC / SRNAMT
-* ..
-* .. Data statements ..
- DATA ISEEDY / 1988, 1989, 1990, 1991 /
-* ..
-* .. Executable Statements ..
-*
-* Initialize constants and the random number seed.
-*
- PATH( 1: 1 ) = 'Single precision'
- PATH( 2: 3 ) = 'QP'
- NRUN = 0
- NFAIL = 0
- NERRS = 0
- DO 10 I = 1, 4
- ISEED( I ) = ISEEDY( I )
- 10 CONTINUE
- EPS = SLAMCH( 'Epsilon' )
-*
-* Test the error exits
-*
- IF( TSTERR )
- $ CALL SERRQP( PATH, NOUT )
- INFOT = 0
-*
- DO 80 IM = 1, NM
-*
-* Do for each value of M in MVAL.
-*
- M = MVAL( IM )
- LDA = MAX( 1, M )
-*
- DO 70 IN = 1, NN
-*
-* Do for each value of N in NVAL.
-*
- N = NVAL( IN )
- MNMIN = MIN( M, N )
- LWORK = MAX( 1, M*MAX( M, N ) + 4*MNMIN + MAX( M, N ),
- $ M*N + 2*MNMIN + 4*N )
-*
- DO 60 IMODE = 1, NTYPES
- IF( .NOT.DOTYPE( IMODE ) )
- $ GO TO 60
-*
-* Do for each type of matrix
-* 1: zero matrix
-* 2: one small singular value
-* 3: geometric distribution of singular values
-* 4: first n/2 columns fixed
-* 5: last n/2 columns fixed
-* 6: every second column fixed
-*
- MODE = IMODE
- IF( IMODE.GT.3 )
- $ MODE = 1
-*
-* Generate test matrix of size m by n using
-* singular value distribution indicated by `mode'.
-*
- DO 20 I = 1, N
- IWORK( I ) = 0
- 20 CONTINUE
- IF( IMODE.EQ.1 ) THEN
- CALL SLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA )
- DO 30 I = 1, MNMIN
- S( I ) = ZERO
- 30 CONTINUE
- ELSE
- CALL SLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
- $ MODE, ONE / EPS, ONE, M, N, 'No packing',
- $ COPYA, LDA, WORK, INFO )
- IF( IMODE.GE.4 ) THEN
- IF( IMODE.EQ.4 ) THEN
- ILOW = 1
- ISTEP = 1
- IHIGH = MAX( 1, N / 2 )
- ELSE IF( IMODE.EQ.5 ) THEN
- ILOW = MAX( 1, N / 2 )
- ISTEP = 1
- IHIGH = N
- ELSE IF( IMODE.EQ.6 ) THEN
- ILOW = 1
- ISTEP = 2
- IHIGH = N
- END IF
- DO 40 I = ILOW, IHIGH, ISTEP
- IWORK( I ) = 1
- 40 CONTINUE
- END IF
- CALL SLAORD( 'Decreasing', MNMIN, S, 1 )
- END IF
-*
-* Save A and its singular values
-*
- CALL SLACPY( 'All', M, N, COPYA, LDA, A, LDA )
-*
-* Compute the QR factorization with pivoting of A
-*
- SRNAMT = 'SGEQPF'
- CALL SGEQPF( M, N, A, LDA, IWORK, TAU, WORK, INFO )
-*
-* Compute norm(svd(a) - svd(r))
-*
- RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, LWORK )
-*
-* Compute norm( A*P - Q*R )
-*
- RESULT( 2 ) = SQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
- $ IWORK, WORK, LWORK )
-*
-* Compute Q'*Q
-*
- RESULT( 3 ) = SQRT11( M, MNMIN, A, LDA, TAU, WORK,
- $ LWORK )
-*
-* Print information about the tests that did not pass
-* the threshold.
-*
- DO 50 K = 1, 3
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9999 )M, N, IMODE, K,
- $ RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 50 CONTINUE
- NRUN = NRUN + 3
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
-*
-* Print a summary of the results.
-*
- CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
-*
- 9999 FORMAT( ' M =', I5, ', N =', I5, ', type ', I2, ', test ', I2,
- $ ', ratio =', G12.5 )
-*
-* End of SCHKQP
-*
- END
*>
*> \verbatim
*>
-*> SERRQP tests the error exits for SGEQPF and SGEQP3.
+*> SERRQP tests the error exits for SGEQP3.
*> \endverbatim
*
* Arguments:
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
- EXTERNAL ALAESM, CHKXER, SGEQP3, SGEQPF
+ EXTERNAL ALAESM, CHKXER, SGEQP3
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*
* Test error exits for QR factorization with pivoting
*
-* SGEQPF
-*
- SRNAMT = 'SGEQPF'
- INFOT = 1
- CALL SGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
- CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL SGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
- CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL SGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
- CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
-*
* SGEQP3
*
SRNAMT = 'SGEQP3'
* .. External Subroutines ..
EXTERNAL ALAREQ, ZCHKEQ, ZCHKGB, ZCHKGE, ZCHKGT, ZCHKHE,
$ ZCHKHE_ROOK, ZCHKHP, ZCHKLQ, ZCHKPB, ZCHKPO,
- $ ZCHKPS, ZCHKPP, ZCHKPT, ZCHKQ3, ZCHKQL, ZCHKQP,
+ $ ZCHKPS, ZCHKPP, ZCHKPT, ZCHKQ3, ZCHKQL,
$ ZCHKQR, ZCHKRQ, ZCHKSP, ZCHKSY, ZCHKSY_ROOK,
$ ZCHKTB, ZCHKTP, ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE,
$ ZDRVGT, ZDRVHE, ZDRVHE_ROOK, ZDRVHP, ZDRVLS,
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
IF( TSTCHK ) THEN
- CALL ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
- $ A( 1, 1 ), A( 1, 2 ), S( 1 ),
- $ B( 1, 1 ), WORK, RWORK, IWORK, NOUT )
CALL ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
$ THRESH, A( 1, 1 ), A( 1, 2 ), S( 1 ),
$ B( 1, 1 ), WORK, RWORK, IWORK,
+++ /dev/null
-*> \brief \b ZCHKQP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
-* COPYA, S, TAU, WORK, RWORK, IWORK,
-* NOUT )
-*
-* .. Scalar Arguments ..
-* LOGICAL TSTERR
-* INTEGER NM, NN, NOUT
-* DOUBLE PRECISION THRESH
-* ..
-* .. Array Arguments ..
-* LOGICAL DOTYPE( * )
-* INTEGER IWORK( * ), MVAL( * ), NVAL( * )
-* DOUBLE PRECISION S( * ), RWORK( * )
-* COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ZCHKQP tests ZGEQPF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DOTYPE
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] NM
-*> \verbatim
-*> NM is INTEGER
-*> The number of values of M contained in the vector MVAL.
-*> \endverbatim
-*>
-*> \param[in] MVAL
-*> \verbatim
-*> MVAL is INTEGER array, dimension (NM)
-*> The values of the matrix row dimension M.
-*> \endverbatim
-*>
-*> \param[in] NN
-*> \verbatim
-*> NN is INTEGER
-*> The number of values of N contained in the vector NVAL.
-*> \endverbatim
-*>
-*> \param[in] NVAL
-*> \verbatim
-*> NVAL is INTEGER array, dimension (NN)
-*> The values of the matrix column dimension N.
-*> \endverbatim
-*>
-*> \param[in] THRESH
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[in] TSTERR
-*> \verbatim
-*> TSTERR is LOGICAL
-*> Flag that indicates whether error exits are to be tested.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> 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.
-*> \endverbatim
-*>
-*> \param[out] COPYA
-*> \verbatim
-*> COPYA is COMPLEX*16 array, dimension (MMAX*NMAX)
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension
-*> (min(MMAX,NMAX))
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is COMPLEX*16 array, dimension (MMAX)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is COMPLEX*16 array, dimension
-*> (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
-*> \endverbatim
-*>
-*> \param[out] RWORK
-*> \verbatim
-*> RWORK is DOUBLE PRECISION array, dimension (4*NMAX)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (NMAX)
-*> \endverbatim
-*>
-*> \param[in] NOUT
-*> \verbatim
-*> NOUT is INTEGER
-*> The unit number for output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_lin
-*
-* =====================================================================
- SUBROUTINE ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
- $ COPYA, S, TAU, WORK, RWORK, IWORK,
- $ NOUT )
-*
-* -- LAPACK test routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL TSTERR
- INTEGER NM, NN, NOUT
- DOUBLE PRECISION THRESH
-* ..
-* .. Array Arguments ..
- LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- DOUBLE PRECISION S( * ), RWORK( * )
- COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NTYPES
- PARAMETER ( NTYPES = 6 )
- INTEGER NTESTS
- PARAMETER ( NTESTS = 3 )
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- CHARACTER*3 PATH
- INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INFO, ISTEP, K,
- $ LDA, LWORK, M, MNMIN, MODE, N, NERRS, NFAIL,
- $ NRUN
- DOUBLE PRECISION EPS
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 )
- DOUBLE PRECISION RESULT( NTESTS )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, ZQPT01, ZQRT11, ZQRT12
- EXTERNAL DLAMCH, ZQPT01, ZQRT11, ZQRT12
-* ..
-* .. External Subroutines ..
- EXTERNAL ALAHD, ALASUM, DLAORD, ZERRQP, ZGEQPF, ZLACPY,
- $ ZLASET, ZLATMS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCMPLX, MAX, MIN
-* ..
-* .. Scalars in Common ..
- LOGICAL LERR, OK
- CHARACTER*32 SRNAMT
- INTEGER INFOT, IOUNIT
-* ..
-* .. Common blocks ..
- COMMON / INFOC / INFOT, IOUNIT, OK, LERR
- COMMON / SRNAMC / SRNAMT
-* ..
-* .. Data statements ..
- DATA ISEEDY / 1988, 1989, 1990, 1991 /
-* ..
-* .. Executable Statements ..
-*
-* Initialize constants and the random number seed.
-*
- PATH( 1: 1 ) = 'Zomplex precision'
- PATH( 2: 3 ) = 'QP'
- NRUN = 0
- NFAIL = 0
- NERRS = 0
- DO 10 I = 1, 4
- ISEED( I ) = ISEEDY( I )
- 10 CONTINUE
- EPS = DLAMCH( 'Epsilon' )
-*
-* Test the error exits
-*
- IF( TSTERR )
- $ CALL ZERRQP( PATH, NOUT )
- INFOT = 0
-*
- DO 80 IM = 1, NM
-*
-* Do for each value of M in MVAL.
-*
- M = MVAL( IM )
- LDA = MAX( 1, M )
-*
- DO 70 IN = 1, NN
-*
-* Do for each value of N in NVAL.
-*
- N = NVAL( IN )
- MNMIN = MIN( M, N )
- LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
-*
- DO 60 IMODE = 1, NTYPES
- IF( .NOT.DOTYPE( IMODE ) )
- $ GO TO 60
-*
-* Do for each type of matrix
-* 1: zero matrix
-* 2: one small singular value
-* 3: geometric distribution of singular values
-* 4: first n/2 columns fixed
-* 5: last n/2 columns fixed
-* 6: every second column fixed
-*
- MODE = IMODE
- IF( IMODE.GT.3 )
- $ MODE = 1
-*
-* Generate test matrix of size m by n using
-* singular value distribution indicated by `mode'.
-*
- DO 20 I = 1, N
- IWORK( I ) = 0
- 20 CONTINUE
- IF( IMODE.EQ.1 ) THEN
- CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ),
- $ DCMPLX( ZERO ), COPYA, LDA )
- DO 30 I = 1, MNMIN
- S( I ) = ZERO
- 30 CONTINUE
- ELSE
- CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
- $ MODE, ONE / EPS, ONE, M, N, 'No packing',
- $ COPYA, LDA, WORK, INFO )
- IF( IMODE.GE.4 ) THEN
- IF( IMODE.EQ.4 ) THEN
- ILOW = 1
- ISTEP = 1
- IHIGH = MAX( 1, N / 2 )
- ELSE IF( IMODE.EQ.5 ) THEN
- ILOW = MAX( 1, N / 2 )
- ISTEP = 1
- IHIGH = N
- ELSE IF( IMODE.EQ.6 ) THEN
- ILOW = 1
- ISTEP = 2
- IHIGH = N
- END IF
- DO 40 I = ILOW, IHIGH, ISTEP
- IWORK( I ) = 1
- 40 CONTINUE
- END IF
- CALL DLAORD( 'Decreasing', MNMIN, S, 1 )
- END IF
-*
-* Save A and its singular values
-*
- CALL ZLACPY( 'All', M, N, COPYA, LDA, A, LDA )
-*
-* Compute the QR factorization with pivoting of A
-*
- SRNAMT = 'ZGEQPF'
- CALL ZGEQPF( M, N, A, LDA, IWORK, TAU, WORK, RWORK,
- $ INFO )
-*
-* Compute norm(svd(a) - svd(r))
-*
- RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, LWORK,
- $ RWORK )
-*
-* Compute norm( A*P - Q*R )
-*
- RESULT( 2 ) = ZQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
- $ IWORK, WORK, LWORK )
-*
-* Compute Q'*Q
-*
- RESULT( 3 ) = ZQRT11( M, MNMIN, A, LDA, TAU, WORK,
- $ LWORK )
-*
-* Print information about the tests that did not pass
-* the threshold.
-*
- DO 50 K = 1, 3
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9999 )M, N, IMODE, K,
- $ RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 50 CONTINUE
- NRUN = NRUN + 3
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
-*
-* Print a summary of the results.
-*
- CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
-*
- 9999 FORMAT( ' M =', I5, ', N =', I5, ', type ', I2, ', test ', I2,
- $ ', ratio =', G12.5 )
-*
-* End of ZCHKQP
-*
- END
*>
*> \verbatim
*>
-*> ZERRQP tests the error exits for ZGEQPF and CGEQP3.
+*> ZERRQP tests the error exits for ZGEQP3.
*> \endverbatim
*
* Arguments:
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
- EXTERNAL ALAESM, CHKXER, ZGEQP3, ZGEQPF
+ EXTERNAL ALAESM, CHKXER, ZGEQP3
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*
IF( LSAMEN( 2, C2, 'QP' ) ) THEN
*
-* ZGEQPF
-*
- SRNAMT = 'ZGEQPF'
- INFOT = 1
- CALL ZGEQPF( -1, 0, A, 1, IP, TAU, W, RW, INFO )
- CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZGEQPF( 0, -1, A, 1, IP, TAU, W, RW, INFO )
- CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEQPF( 2, 0, A, 1, IP, TAU, W, RW, INFO )
- CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
-*
* ZGEQP3
*
SRNAMT = 'ZGEQP3'
projects / platform / upstream / lapack.git / commitdiff