From e12970ddbe1bf4bf8763dcea1e41462291d65ee7 Mon Sep 17 00:00:00 2001 From: "philippe.theveny" Date: Thu, 6 Aug 2015 20:57:14 +0000 Subject: Remove deprecated xGEQPF from the test suite. WARNING: xGEQPF is still used in xGGSVP routines. --- TESTING/LIN/CMakeLists.txt | 8 +- TESTING/LIN/Makefile | 8 +- TESTING/LIN/cchkaa.f | 5 +- TESTING/LIN/cchkqp.f | 347 --------------------------------------------- TESTING/LIN/cerrqp.f | 17 +-- TESTING/LIN/dchkaa.f | 5 +- TESTING/LIN/dchkqp.f | 338 ------------------------------------------- TESTING/LIN/derrqp.f | 17 +-- TESTING/LIN/schkaa.f | 5 +- TESTING/LIN/schkqp.f | 338 ------------------------------------------- TESTING/LIN/serrqp.f | 17 +-- TESTING/LIN/zchkaa.f | 5 +- TESTING/LIN/zchkqp.f | 347 --------------------------------------------- TESTING/LIN/zerrqp.f | 17 +-- 14 files changed, 20 insertions(+), 1454 deletions(-) delete mode 100644 TESTING/LIN/cchkqp.f delete mode 100644 TESTING/LIN/dchkqp.f delete mode 100644 TESTING/LIN/schkqp.f delete mode 100644 TESTING/LIN/zchkqp.f (limited to 'TESTING/LIN') diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt index 2fc14e61..7c36ab3a 100644 --- a/TESTING/LIN/CMakeLists.txt +++ b/TESTING/LIN/CMakeLists.txt @@ -9,7 +9,7 @@ set(DZLNTST dlaord.f ) 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 @@ -45,7 +45,7 @@ endif() 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 @@ -86,7 +86,7 @@ endif() 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 @@ -124,7 +124,7 @@ endif() 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 diff --git a/TESTING/LIN/Makefile b/TESTING/LIN/Makefile index 32e65f93..09d514e5 100644 --- a/TESTING/LIN/Makefile +++ b/TESTING/LIN/Makefile @@ -50,7 +50,7 @@ DZLNTST= dlaord.o 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 \ @@ -87,7 +87,7 @@ endif 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 \ @@ -128,7 +128,7 @@ endif 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 \ @@ -166,7 +166,7 @@ endif 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 \ diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index c2b5fad1..1b1c3405 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -160,7 +160,7 @@ * .. 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, @@ -920,9 +920,6 @@ 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 ) diff --git a/TESTING/LIN/cchkqp.f b/TESTING/LIN/cchkqp.f deleted file mode 100644 index 28d83750..00000000 --- a/TESTING/LIN/cchkqp.f +++ /dev/null @@ -1,347 +0,0 @@ -*> \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 diff --git a/TESTING/LIN/cerrqp.f b/TESTING/LIN/cerrqp.f index dc0343f9..919b3b6b 100644 --- a/TESTING/LIN/cerrqp.f +++ b/TESTING/LIN/cerrqp.f @@ -21,7 +21,7 @@ *> *> \verbatim *> -*> CERRQP tests the error exits for CGEQPF and CGEQP3. +*> CERRQP tests the error exits for CGEQP3. *> \endverbatim * * Arguments: @@ -85,7 +85,7 @@ EXTERNAL LSAMEN * .. * .. External Subroutines .. - EXTERNAL ALAESM, CGEQP3, CGEQPF, CHKXER + EXTERNAL ALAESM, CGEQP3, CHKXER * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -115,19 +115,6 @@ * 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' diff --git a/TESTING/LIN/dchkaa.f b/TESTING/LIN/dchkaa.f index 43076b36..bd9fe1e4 100644 --- a/TESTING/LIN/dchkaa.f +++ b/TESTING/LIN/dchkaa.f @@ -157,7 +157,7 @@ * .. 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, @@ -814,9 +814,6 @@ 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 ) diff --git a/TESTING/LIN/dchkqp.f b/TESTING/LIN/dchkqp.f deleted file mode 100644 index 6d7609a1..00000000 --- a/TESTING/LIN/dchkqp.f +++ /dev/null @@ -1,338 +0,0 @@ -*> \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 diff --git a/TESTING/LIN/derrqp.f b/TESTING/LIN/derrqp.f index f437d667..d383bf42 100644 --- a/TESTING/LIN/derrqp.f +++ b/TESTING/LIN/derrqp.f @@ -21,7 +21,7 @@ *> *> \verbatim *> -*> DERRQP tests the error exits for DGEQPF and DGEQP3. +*> DERRQP tests the error exits for DGEQP3. *> \endverbatim * * Arguments: @@ -83,7 +83,7 @@ EXTERNAL LSAMEN * .. * .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, DGEQP3, DGEQPF + EXTERNAL ALAESM, CHKXER, DGEQP3 * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -110,19 +110,6 @@ * * 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' diff --git a/TESTING/LIN/schkaa.f b/TESTING/LIN/schkaa.f index cbf16e61..ad1b1335 100644 --- a/TESTING/LIN/schkaa.f +++ b/TESTING/LIN/schkaa.f @@ -157,7 +157,7 @@ * .. 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, @@ -814,9 +814,6 @@ 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 ) diff --git a/TESTING/LIN/schkqp.f b/TESTING/LIN/schkqp.f deleted file mode 100644 index 4bb5aae1..00000000 --- a/TESTING/LIN/schkqp.f +++ /dev/null @@ -1,338 +0,0 @@ -*> \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 diff --git a/TESTING/LIN/serrqp.f b/TESTING/LIN/serrqp.f index dc4d3645..ff321e67 100644 --- a/TESTING/LIN/serrqp.f +++ b/TESTING/LIN/serrqp.f @@ -21,7 +21,7 @@ *> *> \verbatim *> -*> SERRQP tests the error exits for SGEQPF and SGEQP3. +*> SERRQP tests the error exits for SGEQP3. *> \endverbatim * * Arguments: @@ -83,7 +83,7 @@ EXTERNAL LSAMEN * .. * .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, SGEQP3, SGEQPF + EXTERNAL ALAESM, CHKXER, SGEQP3 * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -110,19 +110,6 @@ * * 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' diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f index 1c8c6ca7..9df78006 100644 --- a/TESTING/LIN/zchkaa.f +++ b/TESTING/LIN/zchkaa.f @@ -160,7 +160,7 @@ * .. 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, @@ -916,9 +916,6 @@ 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, diff --git a/TESTING/LIN/zchkqp.f b/TESTING/LIN/zchkqp.f deleted file mode 100644 index f075b167..00000000 --- a/TESTING/LIN/zchkqp.f +++ /dev/null @@ -1,347 +0,0 @@ -*> \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 diff --git a/TESTING/LIN/zerrqp.f b/TESTING/LIN/zerrqp.f index ce6ae393..064ec5f3 100644 --- a/TESTING/LIN/zerrqp.f +++ b/TESTING/LIN/zerrqp.f @@ -21,7 +21,7 @@ *> *> \verbatim *> -*> ZERRQP tests the error exits for ZGEQPF and CGEQP3. +*> ZERRQP tests the error exits for ZGEQP3. *> \endverbatim * * Arguments: @@ -85,7 +85,7 @@ EXTERNAL LSAMEN * .. * .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, ZGEQP3, ZGEQPF + EXTERNAL ALAESM, CHKXER, ZGEQP3 * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -115,19 +115,6 @@ * 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' -- cgit v1.2.3