*> \brief \b DCHKQP3RK * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * $ NNB, NBVAL, NXVAL, THRESH, A, COPYA, * $ B, COPYB, S, TAU, * $ WORK, IWORK, NOUT ) * IMPLICIT NONE * * -- LAPACK test routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. * INTEGER NM, NN, NNS, NNB, NOUT * DOUBLE PRECISION THRESH * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) * INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), * $ NVAL( * ), NXVAL( * ) * DOUBLE PRECISION A( * ), COPYA( * ), B( * ), COPYB( * ), * $ S( * ), TAU( * ), WORK( * ) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> DCHKQP3RK tests DGEQP3RK. *> \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] NNS *> \verbatim *> NNS is INTEGER *> The number of values of NRHS contained in the vector NSVAL. *> \endverbatim *> *> \param[in] NSVAL *> \verbatim *> NSVAL is INTEGER array, dimension (NNS) *> The values of the number of right hand sides NRHS. *> \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] 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[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] B *> \verbatim *> B is DOUBLE PRECISION array, dimension (MMAX*NSMAX) *> where MMAX is the maximum value of M in MVAL and NSMAX is the *> maximum value of NRHS in NSVAL. *> \endverbatim *> *> \param[out] COPYB *> \verbatim *> COPYB is DOUBLE PRECISION array, dimension (MMAX*NSMAX) *> \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 (2*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. * *> \ingroup double_lin * * ===================================================================== SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, $ NNB, NBVAL, NXVAL, THRESH, A, COPYA, $ B, COPYB, S, TAU, $ WORK, IWORK, NOUT ) IMPLICIT NONE * * -- LAPACK test routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. INTEGER NM, NN, NNB, NNS, NOUT DOUBLE PRECISION THRESH * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER IWORK( * ), NBVAL( * ), MVAL( * ), NVAL( * ), $ NSVAL( * ), NXVAL( * ) DOUBLE PRECISION A( * ), COPYA( * ), B( * ), COPYB( * ), $ S( * ), TAU( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. INTEGER NTYPES PARAMETER ( NTYPES = 19 ) INTEGER NTESTS PARAMETER ( NTESTS = 5 ) DOUBLE PRECISION ONE, ZERO, BIGNUM PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0, $ BIGNUM = 1.0D+38 ) * .. * .. Local Scalars .. CHARACTER DIST, TYPE CHARACTER*3 PATH INTEGER I, IHIGH, ILOW, IM, IMAT, IN, INC_ZERO, $ INB, IND_OFFSET_GEN, $ IND_IN, IND_OUT, INS, INFO, $ ISTEP, J, J_INC, J_FIRST_NZ, JB_ZERO, $ KFACT, KL, KMAX, KU, LDA, LW, LWORK, $ LWORK_MQR, M, MINMN, MINMNB_GEN, MODE, N, $ NB, NB_ZERO, NERRS, NFAIL, NB_GEN, NRHS, $ NRUN, NX, T DOUBLE PRECISION ANORM, CNDNUM, EPS, ABSTOL, RELTOL, $ DTEMP, MAXC2NRMK, RELMAXC2NRMK * .. * .. Local Arrays .. INTEGER ISEED( 4 ), ISEEDY( 4 ) DOUBLE PRECISION RESULT( NTESTS ), RDUMMY( 1 ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DQPT01, DQRT11, DQRT12, DLANGE, $ DLAPY2 EXTERNAL DLAMCH, DQPT01, DQRT11, DQRT12, DLANGE * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, DAXPY, DGEQP3RK, $ DLACPY, DLAORD, DLASET, DLATB4, DLATMS, $ DORMQR, DSWAP, ICOPY, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, MOD * .. * .. 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 ) = 'QK' NRUN = 0 NFAIL = 0 NERRS = 0 DO I = 1, 4 ISEED( I ) = ISEEDY( I ) END DO EPS = DLAMCH( 'Epsilon' ) INFOT = 0 * DO IM = 1, NM * * Do for each value of M in MVAL. * M = MVAL( IM ) LDA = MAX( 1, M ) * DO IN = 1, NN * * Do for each value of N in NVAL. * N = NVAL( IN ) MINMN = MIN( M, N ) LWORK = MAX( 1, M*MAX( M, N )+4*MINMN+MAX( M, N ), $ M*N + 2*MINMN + 4*N ) * DO INS = 1, NNS NRHS = NSVAL( INS ) * * Set up parameters with DLATB4 and generate * M-by-NRHS B matrix with DLATMS. * IMAT = 14: * Random matrix, CNDNUM = 2, NORM = ONE, * MODE = 3 (geometric distribution of singular values). * CALL DLATB4( PATH, 14, M, NRHS, TYPE, KL, KU, ANORM, $ MODE, CNDNUM, DIST ) * SRNAMT = 'DLATMS' CALL DLATMS( M, NRHS, DIST, ISEED, TYPE, S, MODE, $ CNDNUM, ANORM, KL, KU, 'No packing', $ COPYB, LDA, WORK, INFO ) * * Check error code from DLATMS. * IF( INFO.NE.0 ) THEN CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, $ NRHS, -1, -1, -1, 6, NFAIL, NERRS, $ NOUT ) CYCLE END IF * DO IMAT = 1, NTYPES * * Do the tests only if DOTYPE( IMAT ) is true. * IF( .NOT.DOTYPE( IMAT ) ) $ CYCLE * * The type of distribution used to generate the random * eigen-/singular values: * ( 'S' for symmetric distribution ) => UNIFORM( -1, 1 ) * * Do for each type of NON-SYMMETRIC matrix: CNDNUM NORM MODE * 1. Zero matrix * 2. Random, Diagonal, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 3. Random, Upper triangular, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 4. Random, Lower triangular, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 5. Random, First column is zero, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 6. Random, Last MINMN column is zero, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 7. Random, Last N column is zero, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 8. Random, Middle column in MINMN is zero, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 9. Random, First half of MINMN columns are zero, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 10. Random, Last columns are zero starting from MINMN/2+1, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 11. Random, Half MINMN columns in the middle are zero starting * from MINMN/2-(MINMN/2)/2+1, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 12. Random, Odd columns are ZERO, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 13. Random, Even columns are ZERO, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 14. Random, CNDNUM = 2 CNDNUM = 2 ONE 3 ( geometric distribution of singular values ) * 15. Random, CNDNUM = sqrt(0.1/EPS) CNDNUM = BADC1 = sqrt(0.1/EPS) ONE 3 ( geometric distribution of singular values ) * 16. Random, CNDNUM = 0.1/EPS CNDNUM = BADC2 = 0.1/EPS ONE 3 ( geometric distribution of singular values ) * 17. Random, CNDNUM = 0.1/EPS, CNDNUM = BADC2 = 0.1/EPS ONE 2 ( one small singular value, S(N)=1/CNDNUM ) * one small singular value S(N)=1/CNDNUM * 18. Random, CNDNUM = 2, scaled near underflow CNDNUM = 2 SMALL = SAFMIN * 19. Random, CNDNUM = 2, scaled near overflow CNDNUM = 2 LARGE = 1.0/( 0.25 * ( SAFMIN / EPS ) ) 3 ( geometric distribution of singular values ) * IF( IMAT.EQ.1 ) THEN * * Matrix 1: Zero matrix * CALL DLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA ) DO I = 1, MINMN S( I ) = ZERO END DO * ELSE IF( (IMAT.GE.2 .AND. IMAT.LE.4 ) $ .OR. (IMAT.GE.14 .AND. IMAT.LE.19 ) ) THEN * * Matrices 2-5. * * 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, S, MODE, $ CNDNUM, ANORM, KL, KU, 'No packing', $ COPYA, 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 ) CYCLE END IF * CALL DLAORD( 'Decreasing', MINMN, S, 1 ) * ELSE IF( MINMN.GE.2 $ .AND. IMAT.GE.5 .AND. IMAT.LE.13 ) THEN * * Rectangular matrices 5-13 that contain zero columns, * only for matrices MINMN >=2. * * JB_ZERO is the column index of ZERO block. * NB_ZERO is the column block size of ZERO block. * NB_GEN is the column blcok size of the * generated block. * J_INC in the non_zero column index increment * for matrix 12 and 13. * J_FIRS_NZ is the index of the first non-zero * column. * IF( IMAT.EQ.5 ) THEN * * First column is zero. * JB_ZERO = 1 NB_ZERO = 1 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.6 ) THEN * * Last column MINMN is zero. * JB_ZERO = MINMN NB_ZERO = 1 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.7 ) THEN * * Last column N is zero. * JB_ZERO = N NB_ZERO = 1 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.8 ) THEN * * Middle column in MINMN is zero. * JB_ZERO = MINMN / 2 + 1 NB_ZERO = 1 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.9 ) THEN * * First half of MINMN columns is zero. * JB_ZERO = 1 NB_ZERO = MINMN / 2 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.10 ) THEN * * Last columns are zero columns, * starting from (MINMN / 2 + 1) column. * JB_ZERO = MINMN / 2 + 1 NB_ZERO = N - JB_ZERO + 1 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.11 ) THEN * * Half of the columns in the middle of MINMN * columns is zero, starting from * MINMN/2 - (MINMN/2)/2 + 1 column. * JB_ZERO = MINMN / 2 - (MINMN / 2) / 2 + 1 NB_ZERO = MINMN / 2 NB_GEN = N - NB_ZERO * ELSE IF( IMAT.EQ.12 ) THEN * * Odd-numbered columns are zero, * NB_GEN = N / 2 NB_ZERO = N - NB_GEN J_INC = 2 J_FIRST_NZ = 2 * ELSE IF( IMAT.EQ.13 ) THEN * * Even-numbered columns are zero. * NB_ZERO = N / 2 NB_GEN = N - NB_ZERO J_INC = 2 J_FIRST_NZ = 1 * END IF * * * 1) Set the first NB_ZERO columns in COPYA(1:M,1:N) * to zero. * CALL DLASET( 'Full', M, NB_ZERO, ZERO, ZERO, $ COPYA, LDA ) * * 2) Generate an M-by-(N-NB_ZERO) matrix with the * chosen singular value distribution * in COPYA(1:M,NB_ZERO+1:N). * CALL DLATB4( PATH, IMAT, M, NB_GEN, TYPE, KL, KU, $ ANORM, MODE, CNDNUM, DIST ) * SRNAMT = 'DLATMS' * IND_OFFSET_GEN = NB_ZERO * LDA * CALL DLATMS( M, NB_GEN, DIST, ISEED, TYPE, S, MODE, $ CNDNUM, ANORM, KL, KU, 'No packing', $ COPYA( IND_OFFSET_GEN + 1 ), LDA, $ WORK, INFO ) * * Check error code from DLATMS. * IF( INFO.NE.0 ) THEN CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, $ NB_GEN, -1, -1, -1, IMAT, NFAIL, $ NERRS, NOUT ) CYCLE END IF * * 3) Swap the gererated colums from the right side * NB_GEN-size block in COPYA into correct column * positions. * IF( IMAT.EQ.6 $ .OR. IMAT.EQ.7 $ .OR. IMAT.EQ.8 $ .OR. IMAT.EQ.10 $ .OR. IMAT.EQ.11 ) THEN * * Move by swapping the generated columns * from the right NB_GEN-size block from * (NB_ZERO+1:NB_ZERO+JB_ZERO) * into columns (1:JB_ZERO-1). * DO J = 1, JB_ZERO-1, 1 CALL DSWAP( M, $ COPYA( ( NB_ZERO+J-1)*LDA+1), 1, $ COPYA( (J-1)*LDA + 1 ), 1 ) END DO * ELSE IF( IMAT.EQ.12 .OR. IMAT.EQ.13 ) THEN * * ( IMAT = 12, Odd-numbered ZERO columns. ) * Swap the generated columns from the right * NB_GEN-size block into the even zero colums in the * left NB_ZERO-size block. * * ( IMAT = 13, Even-numbered ZERO columns. ) * Swap the generated columns from the right * NB_GEN-size block into the odd zero colums in the * left NB_ZERO-size block. * DO J = 1, NB_GEN, 1 IND_OUT = ( NB_ZERO+J-1 )*LDA + 1 IND_IN = ( J_INC*(J-1)+(J_FIRST_NZ-1) )*LDA $ + 1 CALL DSWAP( M, $ COPYA( IND_OUT ), 1, $ COPYA( IND_IN), 1 ) END DO * END IF * * 5) Order the singular values generated by * DLAMTS in decreasing order and add trailing zeros * that correspond to zero columns. * The total number of singular values is MINMN. * MINMNB_GEN = MIN( M, NB_GEN ) * DO I = MINMNB_GEN+1, MINMN S( I ) = ZERO END DO * ELSE * * IF(MINMN.LT.2) skip this size for this matrix type. * CYCLE END IF * * Initialize a copy array for a pivot array for DGEQP3RK. * DO I = 1, N IWORK( I ) = 0 END DO * DO INB = 1, NNB * * Do for each pair of values (NB,NX) in NBVAL and NXVAL. * NB = NBVAL( INB ) CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be * KMAX = MIN(M,N) * DO KMAX = 0, MIN(M,N)+1 * * Get a working copy of COPYA into A( 1:M,1:N ). * Get a working copy of COPYB into A( 1:M, (N+1):NRHS ). * Get a working copy of COPYB into into B( 1:M, 1:NRHS ). * Get a working copy of IWORK(1:N) awith zeroes into * which is going to be used as pivot array IWORK( N+1:2N ). * NOTE: IWORK(2N+1:3N) is going to be used as a WORK array * for the routine. * CALL DLACPY( 'All', M, N, COPYA, LDA, A, LDA ) CALL DLACPY( 'All', M, NRHS, COPYB, LDA, $ A( LDA*N + 1 ), LDA ) CALL DLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) DO I = 1, NTESTS RESULT( I ) = ZERO END DO * ABSTOL = -1.0 RELTOL = -1.0 * * Compute the QR factorization with pivoting of A * LW = MAX( 1, MAX( 2*N + NB*( N+NRHS+1 ), $ 3*N + NRHS - 1 ) ) * * Compute DGEQP3RK factorization of A. * SRNAMT = 'DGEQP3RK' CALL DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, $ A, LDA, KFACT, MAXC2NRMK, $ RELMAXC2NRMK, IWORK( N+1 ), TAU, $ WORK, LW, IWORK( 2*N+1 ), INFO ) * * Check error code from DGEQP3RK. * IF( INFO.LT.0 ) $ CALL ALAERH( PATH, 'DGEQP3RK', INFO, 0, ' ', $ M, N, NX, -1, NB, IMAT, $ NFAIL, NERRS, NOUT ) * * Compute test 1: * * This test in only for the full rank factorization of * the matrix A. * * Array S(1:min(M,N)) contains svd(A) the sigular values * of the original matrix A in decreasing absolute value * order. The test computes svd(R), the vector sigular * values of the upper trapezoid of A(1:M,1:N) that * contains the factor R, in decreasing order. The test * returns the ratio: * * 2-norm(svd(R) - svd(A)) / ( max(M,N) * 2-norm(svd(A)) * EPS ) * IF( KFACT.EQ.MINMN ) THEN * RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * NRUN = NRUN + 1 * * End test 1 * END IF * * Compute test 2: * * The test returns the ratio: * * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU, $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * * The test returns the ratio: * * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = DQRT11( M, KFACT, A, LDA, TAU, WORK, $ LWORK ) * NRUN = NRUN + 2 * * Compute test 4: * * This test is only for the factorizations with the * rank greater than 2. * The elements on the diagonal of R should be non- * increasing. * * The test returns the ratio: * * Returns 1.0D+100 if abs(R(K+1,K+1)) > abs(R(K,K)), * K=1:KFACT-1 * IF( MIN(KFACT, MINMN).GE.2 ) THEN * DO J = 1, KFACT-1, 1 DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN RESULT( 4 ) = BIGNUM END IF * END DO * NRUN = NRUN + 1 * * End test 4. * END IF * * Compute test 5: * * This test in only for matrix A with min(M,N) > 0. * * The test returns the ratio: * * 1-norm(Q**T * B - Q**T * B ) / * ( M * EPS ) * * (1) Compute B:=Q**T * B in the matrix B. * IF( MINMN.GT.0 ) THEN * LWORK_MQR = MAX(1, NRHS) CALL DORMQR( 'Left', 'Transpose', $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL DAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, $ B( ( I-1 )*LDA+1 ), 1 ) END DO * RESULT( 5 ) = ABS( $ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) ) * NRUN = NRUN + 1 * * End compute test 5. * END IF * * Print information about the tests that did not * pass the threshold. * DO T = 1, NTESTS IF( RESULT( T ).GE.THRESH ) THEN IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) $ CALL ALAHD( NOUT, PATH ) WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, $ IMAT, T, RESULT( T ) NFAIL = NFAIL + 1 END IF END DO * * END DO KMAX = 1, MIN(M,N)+1 * END DO * * END DO for INB = 1, NNB * END DO * * END DO for IMAT = 1, NTYPES * END DO * * END DO for INS = 1, NNS * END DO * * END DO for IN = 1, NN * END DO * * END DO for IM = 1, NM * END DO * * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) * 9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NRHS =', I5, $ ', KMAX =', I5, ', ABSTOL =', G12.5, $ ', RELTOL =', G12.5, ', NB =', I4, ', NX =', I4, $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 ) * * End of DCHKQP3RK * END