TESTING/LIN/dchkqrt.f

   1 *> \brief \b DCHKQRT
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE DCHKQRT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
  12 *                           NBVAL, NOUT )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       LOGICAL            TSTERR
  16 *       INTEGER            NM, NN, NNB, NOUT
  17 *       DOUBLE PRECISION   THRESH
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       INTEGER            MVAL( * ), NBVAL( * ), NVAL( * )
  21 *
  22 *> \par Purpose:
  23 *  =============
  24 *>
  25 *> \verbatim
  26 *>
  27 *> DCHKQRT tests DGEQRT and DGEMQRT.
  28 *> \endverbatim
  29 *
  30 *  Arguments:
  31 *  ==========
  32 *
  33 *> \param[in] THRESH
  34 *> \verbatim
  35 *>          THRESH is DOUBLE PRECISION
  36 *>          The threshold value for the test ratios.  A result is
  37 *>          included in the output file if RESULT >= THRESH.  To have
  38 *>          every test ratio printed, use THRESH = 0.
  39 *> \endverbatim
  40 *>
  41 *> \param[in] TSTERR
  42 *> \verbatim
  43 *>          TSTERR is LOGICAL
  44 *>          Flag that indicates whether error exits are to be tested.
  45 *> \endverbatim
  46 *>
  47 *> \param[in] NM
  48 *> \verbatim
  49 *>          NM is INTEGER
  50 *>          The number of values of M contained in the vector MVAL.
  51 *> \endverbatim
  52 *>
  53 *> \param[in] MVAL
  54 *> \verbatim
  55 *>          MVAL is INTEGER array, dimension (NM)
  56 *>          The values of the matrix row dimension M.
  57 *> \endverbatim
  58 *>
  59 *> \param[in] NN
  60 *> \verbatim
  61 *>          NN is INTEGER
  62 *>          The number of values of N contained in the vector NVAL.
  63 *> \endverbatim
  64 *>
  65 *> \param[in] NVAL
  66 *> \verbatim
  67 *>          NVAL is INTEGER array, dimension (NN)
  68 *>          The values of the matrix column dimension N.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] NNB
  72 *> \verbatim
  73 *>          NNB is INTEGER
  74 *>          The number of values of NB contained in the vector NBVAL.
  75 *> \endverbatim
  76 *>
  77 *> \param[in] NBVAL
  78 *> \verbatim
  79 *>          NBVAL is INTEGER array, dimension (NBVAL)
  80 *>          The values of the blocksize NB.
  81 *> \endverbatim
  82 *>
  83 *> \param[in] NOUT
  84 *> \verbatim
  85 *>          NOUT is INTEGER
  86 *>          The unit number for output.
  87 *> \endverbatim
  88 *
  89 *  Authors:
  90 *  ========
  91 *
  92 *> \author Univ. of Tennessee
  93 *> \author Univ. of California Berkeley
  94 *> \author Univ. of Colorado Denver
  95 *> \author NAG Ltd.
  96 *
  97 *> \date November 2011
  98 *
  99 *> \ingroup double_lin
 100 *
 101 *  =====================================================================
 102       SUBROUTINE DCHKQRT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
 103      $                     NBVAL, NOUT )
 104       IMPLICIT NONE
 105 *
 106 *  -- LAPACK test routine (version 3.4.0) --
 107 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 108 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 109 *     November 2011
 110 *
 111 *     .. Scalar Arguments ..
 112       LOGICAL            TSTERR
 113       INTEGER            NM, NN, NNB, NOUT
 114       DOUBLE PRECISION   THRESH
 115 *     ..
 116 *     .. Array Arguments ..
 117       INTEGER            MVAL( * ), NBVAL( * ), NVAL( * )
 118 *     ..
 119 *
 120 *  =====================================================================
 121 *
 122 *     .. Parameters ..
 123       INTEGER            NTESTS
 124       PARAMETER          ( NTESTS = 6 )
 125 *     ..
 126 *     .. Local Scalars ..
 127       CHARACTER*3        PATH
 128       INTEGER            I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN,
 129      $                   MINMN
 130 *
 131 *     .. Local Arrays ..
 132       DOUBLE PRECISION   RESULT( NTESTS )
 133 *     ..
 134 *     .. External Subroutines ..
 135       EXTERNAL           ALAERH, ALAHD, ALASUM, DERRQRT, DQRT04
 136 *     ..
 137 *     .. Scalars in Common ..
 138       LOGICAL            LERR, OK
 139       CHARACTER*32       SRNAMT
 140       INTEGER            INFOT, NUNIT
 141 *     ..
 142 *     .. Common blocks ..
 143       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
 144       COMMON             / SRNAMC / SRNAMT
 145 *     ..
 146 *     .. Executable Statements ..
 147 *
 148 *     Initialize constants
 149 *
 150       PATH( 1: 1 ) = 'D'
 151       PATH( 2: 3 ) = 'QT'
 152       NRUN = 0
 153       NFAIL = 0
 154       NERRS = 0
 155 *
 156 *     Test the error exits
 157 *
 158       IF( TSTERR ) CALL DERRQRT( PATH, NOUT )
 159       INFOT = 0
 160 *
 161 *     Do for each value of M in MVAL.
 162 *
 163       DO I = 1, NM
 164          M = MVAL( I )
 165 *
 166 *        Do for each value of N in NVAL.
 167 *
 168          DO J = 1, NN
 169             N = NVAL( J )
 170 *
 171 *        Do for each possible value of NB
 172 *
 173             MINMN = MIN( M, N )
 174             DO K = 1, NNB
 175                NB = NBVAL( K )
 176 *
 177 *              Test DGEQRT and DGEMQRT
 178 *
 179                IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN
 180                   CALL DQRT04( M, N, NB, RESULT )
 181 *
 182 *                 Print information about the tests that did not
 183 *                 pass the threshold.
 184 *
 185                   DO T = 1, NTESTS
 186                      IF( RESULT( T ).GE.THRESH ) THEN
 187                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 188      $                       CALL ALAHD( NOUT, PATH )
 189                         WRITE( NOUT, FMT = 9999 )M, N, NB,
 190      $                       T, RESULT( T )
 191                         NFAIL = NFAIL + 1
 192                      END IF
 193                   END DO
 194                   NRUN = NRUN + NTESTS
 195                END IF
 196             END DO
 197          END DO
 198       END DO
 199 *
 200 *     Print a summary of the results.
 201 *
 202       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 203 *
 204  9999 FORMAT( ' M=', I5, ', N=', I5, ', NB=', I4,
 205      $      ' test(', I2, ')=', G12.5 )
 206       RETURN
 207 *
 208 *     End of DCHKQRT
 209 *
 210       END