1*> \brief \b DCHKLQT
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 DCHKLQT( 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*> DCHKLQT tests DGELQT and DGEMLQT.
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 (NNB)
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*> \ingroup double_lin
98*
99*  =====================================================================
100      SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
101     $                     NBVAL, NOUT )
102      IMPLICIT NONE
103*
104*  -- LAPACK test routine --
105*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
106*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
107*
108*     .. Scalar Arguments ..
109      LOGICAL            TSTERR
110      INTEGER            NM, NN, NNB, NOUT
111      DOUBLE PRECISION   THRESH
112*     ..
113*     .. Array Arguments ..
114      INTEGER            MVAL( * ), NBVAL( * ), NVAL( * )
115*     ..
116*
117*  =====================================================================
118*
119*     .. Parameters ..
120      INTEGER            NTESTS
121      PARAMETER          ( NTESTS = 6 )
122*     ..
123*     .. Local Scalars ..
124      CHARACTER*3        PATH
125      INTEGER            I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN,
126     $                   MINMN
127*
128*     .. Local Arrays ..
129      DOUBLE PRECISION   RESULT( NTESTS )
130*     ..
131*     .. External Subroutines ..
132      EXTERNAL           ALAERH, ALAHD, ALASUM, DERRLQT, DLQT04
133*     ..
134*     .. Scalars in Common ..
135      LOGICAL            LERR, OK
136      CHARACTER*32       SRNAMT
137      INTEGER            INFOT, NUNIT
138*     ..
139*     .. Common blocks ..
140      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
141      COMMON             / SRNAMC / SRNAMT
142*     ..
143*     .. Executable Statements ..
144*
145*     Initialize constants
146*
147      PATH( 1: 1 ) = 'D'
148      PATH( 2: 3 ) = 'TQ'
149      NRUN = 0
150      NFAIL = 0
151      NERRS = 0
152*
153*     Test the error exits
154*
155      IF( TSTERR ) CALL DERRLQT( PATH, NOUT )
156      INFOT = 0
157*
158*     Do for each value of M in MVAL.
159*
160      DO I = 1, NM
161         M = MVAL( I )
162*
163*        Do for each value of N in NVAL.
164*
165         DO J = 1, NN
166            N = NVAL( J )
167*
168*        Do for each possible value of NB
169*
170            MINMN = MIN( M, N )
171            DO K = 1, NNB
172               NB = NBVAL( K )
173*
174*              Test DGELQT and DGEMLQT
175*
176               IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN
177                  CALL DLQT04( M, N, NB, RESULT )
178*
179*                 Print information about the tests that did not
180*                 pass the threshold.
181*
182                  DO T = 1, NTESTS
183                     IF( RESULT( T ).GE.THRESH ) THEN
184                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
185     $                       CALL ALAHD( NOUT, PATH )
186                        WRITE( NOUT, FMT = 9999 )M, N, NB,
187     $                       T, RESULT( T )
188                        NFAIL = NFAIL + 1
189                     END IF
190                  END DO
191                  NRUN = NRUN + NTESTS
192               END IF
193            END DO
194         END DO
195      END DO
196*
197*     Print a summary of the results.
198*
199      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
200*
201 9999 FORMAT( ' M=', I5, ', N=', I5, ', NB=', I4,
202     $      ' test(', I2, ')=', G12.5 )
203      RETURN
204*
205*     End of DCHKLQT
206*
207      END
208