LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dchkqr.f
Go to the documentation of this file.
00001 *> \brief \b DCHKQR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00012 *                          NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
00013 *                          B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       LOGICAL            TSTERR
00017 *       INTEGER            NM, NMAX, NN, NNB, NOUT, NRHS
00018 *       DOUBLE PRECISION   THRESH
00019 *       ..
00020 *       .. Array Arguments ..
00021 *       LOGICAL            DOTYPE( * )
00022 *       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
00023 *      $                   NXVAL( * )
00024 *       DOUBLE PRECISION   A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
00025 *      $                   B( * ), RWORK( * ), TAU( * ), WORK( * ),
00026 *      $                   X( * ), XACT( * )
00027 *       ..
00028 *  
00029 *
00030 *> \par Purpose:
00031 *  =============
00032 *>
00033 *> \verbatim
00034 *>
00035 *> DCHKQR tests DGEQRF, DORGQR and DORMQR.
00036 *> \endverbatim
00037 *
00038 *  Arguments:
00039 *  ==========
00040 *
00041 *> \param[in] DOTYPE
00042 *> \verbatim
00043 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00044 *>          The matrix types to be used for testing.  Matrices of type j
00045 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00046 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00047 *> \endverbatim
00048 *>
00049 *> \param[in] NM
00050 *> \verbatim
00051 *>          NM is INTEGER
00052 *>          The number of values of M contained in the vector MVAL.
00053 *> \endverbatim
00054 *>
00055 *> \param[in] MVAL
00056 *> \verbatim
00057 *>          MVAL is INTEGER array, dimension (NM)
00058 *>          The values of the matrix row dimension M.
00059 *> \endverbatim
00060 *>
00061 *> \param[in] NN
00062 *> \verbatim
00063 *>          NN is INTEGER
00064 *>          The number of values of N contained in the vector NVAL.
00065 *> \endverbatim
00066 *>
00067 *> \param[in] NVAL
00068 *> \verbatim
00069 *>          NVAL is INTEGER array, dimension (NN)
00070 *>          The values of the matrix column dimension N.
00071 *> \endverbatim
00072 *>
00073 *> \param[in] NNB
00074 *> \verbatim
00075 *>          NNB is INTEGER
00076 *>          The number of values of NB and NX contained in the
00077 *>          vectors NBVAL and NXVAL.  The blocking parameters are used
00078 *>          in pairs (NB,NX).
00079 *> \endverbatim
00080 *>
00081 *> \param[in] NBVAL
00082 *> \verbatim
00083 *>          NBVAL is INTEGER array, dimension (NNB)
00084 *>          The values of the blocksize NB.
00085 *> \endverbatim
00086 *>
00087 *> \param[in] NXVAL
00088 *> \verbatim
00089 *>          NXVAL is INTEGER array, dimension (NNB)
00090 *>          The values of the crossover point NX.
00091 *> \endverbatim
00092 *>
00093 *> \param[in] NRHS
00094 *> \verbatim
00095 *>          NRHS is INTEGER
00096 *>          The number of right hand side vectors to be generated for
00097 *>          each linear system.
00098 *> \endverbatim
00099 *>
00100 *> \param[in] THRESH
00101 *> \verbatim
00102 *>          THRESH is DOUBLE PRECISION
00103 *>          The threshold value for the test ratios.  A result is
00104 *>          included in the output file if RESULT >= THRESH.  To have
00105 *>          every test ratio printed, use THRESH = 0.
00106 *> \endverbatim
00107 *>
00108 *> \param[in] TSTERR
00109 *> \verbatim
00110 *>          TSTERR is LOGICAL
00111 *>          Flag that indicates whether error exits are to be tested.
00112 *> \endverbatim
00113 *>
00114 *> \param[in] NMAX
00115 *> \verbatim
00116 *>          NMAX is INTEGER
00117 *>          The maximum value permitted for M or N, used in dimensioning
00118 *>          the work arrays.
00119 *> \endverbatim
00120 *>
00121 *> \param[out] A
00122 *> \verbatim
00123 *>          A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00124 *> \endverbatim
00125 *>
00126 *> \param[out] AF
00127 *> \verbatim
00128 *>          AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00129 *> \endverbatim
00130 *>
00131 *> \param[out] AQ
00132 *> \verbatim
00133 *>          AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00134 *> \endverbatim
00135 *>
00136 *> \param[out] AR
00137 *> \verbatim
00138 *>          AR is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00139 *> \endverbatim
00140 *>
00141 *> \param[out] AC
00142 *> \verbatim
00143 *>          AC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00144 *> \endverbatim
00145 *>
00146 *> \param[out] B
00147 *> \verbatim
00148 *>          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00149 *> \endverbatim
00150 *>
00151 *> \param[out] X
00152 *> \verbatim
00153 *>          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00154 *> \endverbatim
00155 *>
00156 *> \param[out] XACT
00157 *> \verbatim
00158 *>          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00159 *> \endverbatim
00160 *>
00161 *> \param[out] TAU
00162 *> \verbatim
00163 *>          TAU is DOUBLE PRECISION array, dimension (NMAX)
00164 *> \endverbatim
00165 *>
00166 *> \param[out] WORK
00167 *> \verbatim
00168 *>          WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00169 *> \endverbatim
00170 *>
00171 *> \param[out] RWORK
00172 *> \verbatim
00173 *>          RWORK is DOUBLE PRECISION array, dimension (NMAX)
00174 *> \endverbatim
00175 *>
00176 *> \param[out] IWORK
00177 *> \verbatim
00178 *>          IWORK is INTEGER array, dimension (NMAX)
00179 *> \endverbatim
00180 *>
00181 *> \param[in] NOUT
00182 *> \verbatim
00183 *>          NOUT is INTEGER
00184 *>          The unit number for output.
00185 *> \endverbatim
00186 *
00187 *  Authors:
00188 *  ========
00189 *
00190 *> \author Univ. of Tennessee 
00191 *> \author Univ. of California Berkeley 
00192 *> \author Univ. of Colorado Denver 
00193 *> \author NAG Ltd. 
00194 *
00195 *> \date November 2011
00196 *
00197 *> \ingroup double_lin
00198 *
00199 *  =====================================================================
00200       SUBROUTINE DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00201      $                   NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
00202      $                   B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
00203 *
00204 *  -- LAPACK test routine (version 3.4.0) --
00205 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00206 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00207 *     November 2011
00208 *
00209 *     .. Scalar Arguments ..
00210       LOGICAL            TSTERR
00211       INTEGER            NM, NMAX, NN, NNB, NOUT, NRHS
00212       DOUBLE PRECISION   THRESH
00213 *     ..
00214 *     .. Array Arguments ..
00215       LOGICAL            DOTYPE( * )
00216       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
00217      $                   NXVAL( * )
00218       DOUBLE PRECISION   A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
00219      $                   B( * ), RWORK( * ), TAU( * ), WORK( * ),
00220      $                   X( * ), XACT( * )
00221 *     ..
00222 *
00223 *  =====================================================================
00224 *
00225 *     .. Parameters ..
00226       INTEGER            NTESTS
00227       PARAMETER          ( NTESTS = 9 )
00228       INTEGER            NTYPES
00229       PARAMETER          ( NTYPES = 8 )
00230       DOUBLE PRECISION   ZERO
00231       PARAMETER          ( ZERO = 0.0D0 )
00232 *     ..
00233 *     .. Local Scalars ..
00234       CHARACTER          DIST, TYPE
00235       CHARACTER*3        PATH
00236       INTEGER            I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
00237      $                   LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK,
00238      $                   NRUN, NT, NX
00239       DOUBLE PRECISION   ANORM, CNDNUM
00240 *     ..
00241 *     .. Local Arrays ..
00242       INTEGER            ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
00243       DOUBLE PRECISION   RESULT( NTESTS )
00244 *     ..
00245 *     .. External Functions ..
00246       LOGICAL            DGENND
00247       EXTERNAL           DGENND
00248 *     ..
00249 *     .. External Subroutines ..
00250       EXTERNAL           ALAERH, ALAHD, ALASUM, DERRQR, DGEQRS, DGET02,
00251      $                   DLACPY, DLARHS, DLATB4, DLATMS, DQRT01, 
00252      $                   DQRT01P, DQRT02, DQRT03, XLAENV
00253 *     ..
00254 *     .. Intrinsic Functions ..
00255       INTRINSIC          MAX, MIN
00256 *     ..
00257 *     .. Scalars in Common ..
00258       LOGICAL            LERR, OK
00259       CHARACTER*32       SRNAMT
00260       INTEGER            INFOT, NUNIT
00261 *     ..
00262 *     .. Common blocks ..
00263       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00264       COMMON             / SRNAMC / SRNAMT
00265 *     ..
00266 *     .. Data statements ..
00267       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00268 *     ..
00269 *     .. Executable Statements ..
00270 *
00271 *     Initialize constants and the random number seed.
00272 *
00273       PATH( 1: 1 ) = 'Double precision'
00274       PATH( 2: 3 ) = 'QR'
00275       NRUN = 0
00276       NFAIL = 0
00277       NERRS = 0
00278       DO 10 I = 1, 4
00279          ISEED( I ) = ISEEDY( I )
00280    10 CONTINUE
00281 *
00282 *     Test the error exits
00283 *
00284       IF( TSTERR )
00285      $   CALL DERRQR( PATH, NOUT )
00286       INFOT = 0
00287       CALL XLAENV( 2, 2 )
00288 *
00289       LDA = NMAX
00290       LWORK = NMAX*MAX( NMAX, NRHS )
00291 *
00292 *     Do for each value of M in MVAL.
00293 *
00294       DO 70 IM = 1, NM
00295          M = MVAL( IM )
00296 *
00297 *        Do for each value of N in NVAL.
00298 *
00299          DO 60 IN = 1, NN
00300             N = NVAL( IN )
00301             MINMN = MIN( M, N )
00302             DO 50 IMAT = 1, NTYPES
00303 *
00304 *              Do the tests only if DOTYPE( IMAT ) is true.
00305 *
00306                IF( .NOT.DOTYPE( IMAT ) )
00307      $            GO TO 50
00308 *
00309 *              Set up parameters with DLATB4 and generate a test matrix
00310 *              with DLATMS.
00311 *
00312                CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
00313      $                      CNDNUM, DIST )
00314 *
00315                SRNAMT = 'DLATMS'
00316                CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
00317      $                      CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
00318      $                      WORK, INFO )
00319 *
00320 *              Check error code from DLATMS.
00321 *
00322                IF( INFO.NE.0 ) THEN
00323                   CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1,
00324      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00325                   GO TO 50
00326                END IF
00327 *
00328 *              Set some values for K: the first value must be MINMN,
00329 *              corresponding to the call of DQRT01; other values are
00330 *              used in the calls of DQRT02, and must not exceed MINMN.
00331 *
00332                KVAL( 1 ) = MINMN
00333                KVAL( 2 ) = 0
00334                KVAL( 3 ) = 1
00335                KVAL( 4 ) = MINMN / 2
00336                IF( MINMN.EQ.0 ) THEN
00337                   NK = 1
00338                ELSE IF( MINMN.EQ.1 ) THEN
00339                   NK = 2
00340                ELSE IF( MINMN.LE.3 ) THEN
00341                   NK = 3
00342                ELSE
00343                   NK = 4
00344                END IF
00345 *
00346 *              Do for each value of K in KVAL
00347 *
00348                DO 40 IK = 1, NK
00349                   K = KVAL( IK )
00350 *
00351 *                 Do for each pair of values (NB,NX) in NBVAL and NXVAL.
00352 *
00353                   DO 30 INB = 1, NNB
00354                      NB = NBVAL( INB )
00355                      CALL XLAENV( 1, NB )
00356                      NX = NXVAL( INB )
00357                      CALL XLAENV( 3, NX )
00358                      DO I = 1, NTESTS
00359                         RESULT( I ) = ZERO
00360                      END DO
00361                      NT = 2
00362                      IF( IK.EQ.1 ) THEN
00363 *
00364 *                       Test DGEQRF
00365 *
00366                         CALL DQRT01( M, N, A, AF, AQ, AR, LDA, TAU,
00367      $                               WORK, LWORK, RWORK, RESULT( 1 ) )
00368 
00369 *
00370 *                       Test DGEQRFP
00371 *
00372                         CALL DQRT01P( M, N, A, AF, AQ, AR, LDA, TAU,
00373      $                               WORK, LWORK, RWORK, RESULT( 8 ) )
00374 
00375                          IF( .NOT. DGENND( M, N, AF, LDA ) )
00376      $                       RESULT( 9 ) = 2*THRESH
00377                         NT = NT + 1
00378                     ELSE IF( M.GE.N ) THEN
00379 *
00380 *                       Test DORGQR, using factorization
00381 *                       returned by DQRT01
00382 *
00383                         CALL DQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU,
00384      $                               WORK, LWORK, RWORK, RESULT( 1 ) )
00385                      END IF
00386                      IF( M.GE.K ) THEN
00387 *
00388 *                       Test DORMQR, using factorization returned
00389 *                       by DQRT01
00390 *
00391                         CALL DQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU,
00392      $                               WORK, LWORK, RWORK, RESULT( 3 ) )
00393                         NT = NT + 4
00394 *
00395 *                       If M>=N and K=N, call DGEQRS to solve a system
00396 *                       with NRHS right hand sides and compute the
00397 *                       residual.
00398 *
00399                         IF( K.EQ.N .AND. INB.EQ.1 ) THEN
00400 *
00401 *                          Generate a solution and set the right
00402 *                          hand side.
00403 *
00404                            SRNAMT = 'DLARHS'
00405                            CALL DLARHS( PATH, 'New', 'Full',
00406      $                                  'No transpose', M, N, 0, 0,
00407      $                                  NRHS, A, LDA, XACT, LDA, B, LDA,
00408      $                                  ISEED, INFO )
00409 *
00410                            CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
00411      $                                  LDA )
00412                            SRNAMT = 'DGEQRS'
00413                            CALL DGEQRS( M, N, NRHS, AF, LDA, TAU, X,
00414      $                                  LDA, WORK, LWORK, INFO )
00415 *
00416 *                          Check error code from DGEQRS.
00417 *
00418                            IF( INFO.NE.0 )
00419      $                        CALL ALAERH( PATH, 'DGEQRS', INFO, 0, ' ',
00420      $                                     M, N, NRHS, -1, NB, IMAT,
00421      $                                     NFAIL, NERRS, NOUT )
00422 *
00423                            CALL DGET02( 'No transpose', M, N, NRHS, A,
00424      $                                  LDA, X, LDA, B, LDA, RWORK,
00425      $                                  RESULT( 7 ) )
00426                            NT = NT + 1
00427                         END IF
00428                      END IF
00429 *
00430 *                    Print information about the tests that did not
00431 *                    pass the threshold.
00432 *
00433                      DO 20 I = 1, NTESTS
00434                         IF( RESULT( I ).GE.THRESH ) THEN
00435                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00436      $                        CALL ALAHD( NOUT, PATH )
00437                            WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
00438      $                        IMAT, I, RESULT( I )
00439                            NFAIL = NFAIL + 1
00440                         END IF
00441    20                CONTINUE
00442                      NRUN = NRUN + NT
00443    30             CONTINUE
00444    40          CONTINUE
00445    50       CONTINUE
00446    60    CONTINUE
00447    70 CONTINUE
00448 *
00449 *     Print a summary of the results.
00450 *
00451       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00452 *
00453  9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
00454      $      I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
00455       RETURN
00456 *
00457 *     End of DCHKQR
00458 *
00459       END
 All Files Functions