*> \brief \b SCHKLQ * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE SCHKLQ( 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 * REAL THRESH * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) * INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), * $ NXVAL( * ) * REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), * $ B( * ), RWORK( * ), TAU( * ), WORK( * ), * $ X( * ), XACT( * ) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> SCHKLQ tests SGELQF, SORGLQ and SORMLQ. *> \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 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[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 REAL array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AF *> \verbatim *> AF is REAL array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AQ *> \verbatim *> AQ is REAL array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AL *> \verbatim *> AL is REAL array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AC *> \verbatim *> AC is REAL array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] B *> \verbatim *> B is REAL array, dimension (NMAX*NRHS) *> \endverbatim *> *> \param[out] X *> \verbatim *> X is REAL array, dimension (NMAX*NRHS) *> \endverbatim *> *> \param[out] XACT *> \verbatim *> XACT is REAL array, dimension (NMAX*NRHS) *> \endverbatim *> *> \param[out] TAU *> \verbatim *> TAU is REAL array, dimension (NMAX) *> \endverbatim *> *> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] RWORK *> \verbatim *> RWORK is REAL 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 2015 * *> \ingroup single_lin * * ===================================================================== SUBROUTINE SCHKLQ( 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.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2015 * * .. Scalar Arguments .. LOGICAL TSTERR INTEGER NM, NMAX, NN, NNB, NOUT, NRHS REAL THRESH * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), $ B( * ), RWORK( * ), TAU( * ), WORK( * ), $ X( * ), XACT( * ) * .. * * ===================================================================== * * .. Parameters .. INTEGER NTESTS PARAMETER ( NTESTS = 7 ) INTEGER NTYPES PARAMETER ( NTYPES = 8 ) REAL ZERO PARAMETER ( ZERO = 0.0E0 ) * .. * .. 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 REAL ANORM, CNDNUM * .. * .. Local Arrays .. INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) REAL RESULT( NTESTS ) * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGELQS, SGET02, $ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02, $ SLQT03, 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 ) = 'Single 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 SERRLQ( 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 SLATB4 and generate a test matrix * with SLATMS. * CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, $ CNDNUM, DIST ) * SRNAMT = 'SLATMS' CALL SLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, $ WORK, INFO ) * * Check error code from SLATMS. * IF( INFO.NE.0 ) THEN CALL ALAERH( PATH, 'SLATMS', 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 SLQT01; other values are * used in the calls of SLQT02, 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 SGELQF * CALL SLQT01( M, N, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE IF( M.LE.N ) THEN * * Test SORGLQ, using factorization * returned by SLQT01 * CALL SLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * * Test SORMLQ, using factorization returned * by SLQT01 * CALL SLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) NT = NT + 4 * * If M>=N and K=N, call SGELQS 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 = 'SLARHS' CALL SLARHS( PATH, 'New', 'Full', $ 'No transpose', M, N, 0, 0, $ NRHS, A, LDA, XACT, LDA, B, LDA, $ ISEED, INFO ) * CALL SLACPY( 'Full', M, NRHS, B, LDA, X, $ LDA ) SRNAMT = 'SGELQS' CALL SGELQS( M, N, NRHS, AF, LDA, TAU, X, $ LDA, WORK, LWORK, INFO ) * * Check error code from SGELQS. * IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'SGELQS', INFO, 0, ' ', $ M, N, NRHS, -1, NB, IMAT, $ NFAIL, NERRS, NOUT ) * CALL SGET02( 'No transpose', M, N, NRHS, A, $ LDA, X, LDA, B, LDA, RWORK, $ RESULT( 7 ) ) NT = NT + 1 END IF 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 SCHKLQ * END