*> \brief \b DCHKLQ * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, * B, X, XACT, TAU, WORK, RWORK, NOUT ) * * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NMAX, NN, NNB, NOUT, NRHS * DOUBLE PRECISION THRESH * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) * INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), * $ NXVAL( * ) * DOUBLE PRECISION A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), * $ B( * ), RWORK( * ), TAU( * ), WORK( * ), * $ X( * ), XACT( * ) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> DCHKLQ tests DGELQF, DORGLQ and DORMLQ. *> \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] NNB *> \verbatim *> NNB is INTEGER *> The number of values of NB and NX contained in the *> vectors NBVAL and NXVAL. The blocking parameters are used *> in pairs (NB,NX). *> \endverbatim *> *> \param[in] NBVAL *> \verbatim *> NBVAL is INTEGER array, dimension (NNB) *> The values of the blocksize NB. *> \endverbatim *> *> \param[in] NXVAL *> \verbatim *> NXVAL is INTEGER array, dimension (NNB) *> The values of the crossover point NX. *> \endverbatim *> *> \param[in] NRHS *> \verbatim *> NRHS is INTEGER *> The number of right hand side vectors to be generated for *> each linear system. *> \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[in] NMAX *> \verbatim *> NMAX is INTEGER *> The maximum value permitted for M or N, used in dimensioning *> the work arrays. *> \endverbatim *> *> \param[out] A *> \verbatim *> A is DOUBLE PRECISION array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AF *> \verbatim *> AF is DOUBLE PRECISION array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AQ *> \verbatim *> AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AL *> \verbatim *> AL is DOUBLE PRECISION array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AC *> \verbatim *> AC is DOUBLE PRECISION array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] B *> \verbatim *> B is DOUBLE PRECISION array, dimension (NMAX*NRHS) *> \endverbatim *> *> \param[out] X *> \verbatim *> X is DOUBLE PRECISION array, dimension (NMAX*NRHS) *> \endverbatim *> *> \param[out] XACT *> \verbatim *> XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS) *> \endverbatim *> *> \param[out] TAU *> \verbatim *> TAU is DOUBLE PRECISION array, dimension (NMAX) *> \endverbatim *> *> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION 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 DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, $ B, X, XACT, TAU, WORK, RWORK, 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, NMAX, NN, NNB, NOUT, NRHS DOUBLE PRECISION THRESH * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) DOUBLE PRECISION A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), $ B( * ), RWORK( * ), TAU( * ), WORK( * ), $ X( * ), XACT( * ) * .. * * ===================================================================== * * .. Parameters .. INTEGER NTESTS PARAMETER ( NTESTS = 7 ) INTEGER NTYPES PARAMETER ( NTYPES = 8 ) DOUBLE PRECISION ZERO PARAMETER ( ZERO = 0.0D0 ) * .. * .. Local Scalars .. CHARACTER DIST, TYPE CHARACTER*3 PATH INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, $ NRUN, NT, NX DOUBLE PRECISION ANORM, CNDNUM * .. * .. Local Arrays .. INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) DOUBLE PRECISION RESULT( NTESTS ) * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELQS, DGET02, $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02, $ DLQT03, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK CHARACTER*32 SRNAMT INTEGER INFOT, NUNIT * .. * .. Common blocks .. COMMON / INFOC / INFOT, NUNIT, 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 ) = 'LQ' NRUN = 0 NFAIL = 0 NERRS = 0 DO 10 I = 1, 4 ISEED( I ) = ISEEDY( I ) 10 CONTINUE * * Test the error exits * IF( TSTERR ) $ CALL DERRLQ( PATH, NOUT ) INFOT = 0 CALL XLAENV( 2, 2 ) * LDA = NMAX LWORK = NMAX*MAX( NMAX, NRHS ) * * Do for each value of M in MVAL. * DO 70 IM = 1, NM M = MVAL( IM ) * * Do for each value of N in NVAL. * DO 60 IN = 1, NN N = NVAL( IN ) MINMN = MIN( M, N ) DO 50 IMAT = 1, NTYPES * * Do the tests only if DOTYPE( IMAT ) is true. * IF( .NOT.DOTYPE( IMAT ) ) $ GO TO 50 * * Set up parameters with DLATB4 and generate a test matrix * with DLATMS. * CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, $ CNDNUM, DIST ) * SRNAMT = 'DLATMS' CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, $ WORK, INFO ) * * Check error code from DLATMS. * IF( INFO.NE.0 ) THEN CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1, $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) GO TO 50 END IF * * Set some values for K: the first value must be MINMN, * corresponding to the call of DLQT01; other values are * used in the calls of DLQT02, and must not exceed MINMN. * KVAL( 1 ) = MINMN KVAL( 2 ) = 0 KVAL( 3 ) = 1 KVAL( 4 ) = MINMN / 2 IF( MINMN.EQ.0 ) THEN NK = 1 ELSE IF( MINMN.EQ.1 ) THEN NK = 2 ELSE IF( MINMN.LE.3 ) THEN NK = 3 ELSE NK = 4 END IF * * Do for each value of K in KVAL * DO 40 IK = 1, NK K = KVAL( IK ) * * Do for each pair of values (NB,NX) in NBVAL and NXVAL. * DO 30 INB = 1, NNB NB = NBVAL( INB ) CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) DO I = 1, NTESTS RESULT( I ) = ZERO END DO NT = 2 IF( IK.EQ.1 ) THEN * * Test DGELQF * CALL DLQT01( M, N, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE IF( M.LE.N ) THEN * * Test DORGLQ, using factorization * returned by DLQT01 * CALL DLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE RESULT( 1 ) = ZERO RESULT( 2 ) = ZERO END IF IF( M.GE.K ) THEN * * Test DORMLQ, using factorization returned * by DLQT01 * CALL DLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) NT = NT + 4 * * If M>=N and K=N, call DGELQS to solve a system * with NRHS right hand sides and compute the * residual. * IF( K.EQ.M .AND. INB.EQ.1 ) THEN * * Generate a solution and set the right * hand side. * SRNAMT = 'DLARHS' CALL DLARHS( PATH, 'New', 'Full', $ 'No transpose', M, N, 0, 0, $ NRHS, A, LDA, XACT, LDA, B, LDA, $ ISEED, INFO ) * CALL DLACPY( 'Full', M, NRHS, B, LDA, X, $ LDA ) SRNAMT = 'DGELQS' CALL DGELQS( M, N, NRHS, AF, LDA, TAU, X, $ LDA, WORK, LWORK, INFO ) * * Check error code from DGELQS. * IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ', $ M, N, NRHS, -1, NB, IMAT, $ NFAIL, NERRS, NOUT ) * CALL DGET02( 'No transpose', M, N, NRHS, A, $ LDA, X, LDA, B, LDA, RWORK, $ RESULT( 7 ) ) NT = NT + 1 ELSE RESULT( 7 ) = ZERO END IF ELSE RESULT( 3 ) = ZERO RESULT( 4 ) = ZERO RESULT( 5 ) = ZERO RESULT( 6 ) = ZERO END IF * * Print information about the tests that did not * pass the threshold. * DO 20 I = 1, NT IF( RESULT( I ).GE.THRESH ) THEN IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) $ CALL ALAHD( NOUT, PATH ) WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, $ IMAT, I, RESULT( I ) NFAIL = NFAIL + 1 END IF 20 CONTINUE NRUN = NRUN + NT 30 CONTINUE 40 CONTINUE 50 CONTINUE 60 CONTINUE 70 CONTINUE * * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) * 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) RETURN * * End of DCHKLQ * END