1*> \brief \b DCHKQRTP
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 DCHKQRTP( 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*> DCHKQRTP tests DTPQRT and DTPMQRT.
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 DCHKQRTP( 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, L, 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, DERRQRTP
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 ) = 'QX'
152      NRUN = 0
153      NFAIL = 0
154      NERRS = 0
155*
156*     Test the error exits
157*
158      IF( TSTERR ) CALL DERRQRTP( PATH, NOUT )
159      INFOT = 0
160*
161*     Do for each value of M
162*
163      DO I = 1, NM
164         M = MVAL( I )
165*
166*        Do for each value of N
167*
168         DO J = 1, NN
169            N = NVAL( J )
170*
171*           Do for each value of L
172*
173            MINMN = MIN( M, N )
174            DO L = 0, MINMN, MAX( MINMN, 1 )
175*
176*              Do for each possible value of NB
177*
178               DO K = 1, NNB
179                  NB = NBVAL( K )
180*
181*                 Test DTPQRT and DTPMQRT
182*
183                  IF( (NB.LE.N).AND.(NB.GT.0) ) THEN
184                     CALL DQRT05( M, N, L, NB, RESULT )
185*
186*                    Print information about the tests that did not
187*                    pass the threshold.
188*
189                     DO T = 1, NTESTS
190                     IF( RESULT( T ).GE.THRESH ) THEN
191                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
192     $                       CALL ALAHD( NOUT, PATH )
193                           WRITE( NOUT, FMT = 9999 )M, N, NB, L,
194     $                            T, RESULT( T )
195                           NFAIL = NFAIL + 1
196                        END IF
197                     END DO
198                     NRUN = NRUN + NTESTS
199                  END IF
200               END DO
201            END DO
202         END DO
203      END DO
204*
205*     Print a summary of the results.
206*
207      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
208*
209 9999 FORMAT( ' M=', I5, ', N=', I5, ', NB=', I4,' L=', I4,
210     $      ' test(', I2, ')=', G12.5 )
211      RETURN
212*
213*     End of DCHKQRTP
214*
215      END
216