LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dchktsqr.f
Go to the documentation of this file.
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 DCHKTSQR( 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*> DCHKTSQR tests DGETSQR and DORMTSQR.
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 dchktsqr( 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, INB,
126 $ minmn, mb, imb
127*
128* .. Local Arrays ..
129 DOUBLE PRECISION RESULT( NTESTS )
130* ..
131* .. External Subroutines ..
132 EXTERNAL alaerh, alahd, alasum, derrtsqr,
133 $ dtsqr01, xlaenv
134* ..
135* .. Intrinsic Functions ..
136 INTRINSIC max, min
137* ..
138* .. Scalars in Common ..
139 LOGICAL LERR, OK
140 CHARACTER*32 SRNAMT
141 INTEGER INFOT, NUNIT
142* ..
143* .. Common blocks ..
144 COMMON / infoc / infot, nunit, ok, lerr
145 COMMON / srnamc / srnamt
146* ..
147* .. Executable Statements ..
148*
149* Initialize constants
150*
151 path( 1: 1 ) = 'D'
152 path( 2: 3 ) = 'TS'
153 nrun = 0
154 nfail = 0
155 nerrs = 0
156*
157* Test the error exits
158*
159 CALL xlaenv( 1, 0 )
160 CALL xlaenv( 2, 0 )
161 IF( tsterr ) CALL derrtsqr( path, nout )
162 infot = 0
163*
164* Do for each value of M in MVAL.
165*
166 DO i = 1, nm
167 m = mval( i )
168*
169* Do for each value of N in NVAL.
170*
171 DO j = 1, nn
172 n = nval( j )
173 IF (min(m,n).NE.0) THEN
174 DO inb = 1, nnb
175 mb = nbval( inb )
176 CALL xlaenv( 1, mb )
177 DO imb = 1, nnb
178 nb = nbval( imb )
179 CALL xlaenv( 2, nb )
180*
181* Test DGEQR and DGEMQR
182*
183 CALL dtsqr01( 'TS', m, n, mb, nb, result )
184*
185* Print information about the tests that did not
186* pass the threshold.
187*
188 DO t = 1, ntests
189 IF( result( t ).GE.thresh ) THEN
190 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
191 $ CALL alahd( nout, path )
192 WRITE( nout, fmt = 9999 )m, n, mb, nb,
193 $ t, result( t )
194 nfail = nfail + 1
195 END IF
196 END DO
197 nrun = nrun + ntests
198 END DO
199 END DO
200 END IF
201 END DO
202 END DO
203*
204* Do for each value of M in MVAL.
205*
206 DO i = 1, nm
207 m = mval( i )
208*
209* Do for each value of N in NVAL.
210*
211 DO j = 1, nn
212 n = nval( j )
213 IF (min(m,n).NE.0) THEN
214 DO inb = 1, nnb
215 mb = nbval( inb )
216 CALL xlaenv( 1, mb )
217 DO imb = 1, nnb
218 nb = nbval( imb )
219 CALL xlaenv( 2, nb )
220*
221* Test DGEQR and DGEMQR
222*
223 CALL dtsqr01( 'SW', m, n, mb, nb, result )
224*
225* Print information about the tests that did not
226* pass the threshold.
227*
228 DO t = 1, ntests
229 IF( result( t ).GE.thresh ) THEN
230 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
231 $ CALL alahd( nout, path )
232 WRITE( nout, fmt = 9998 )m, n, mb, nb,
233 $ t, result( t )
234 nfail = nfail + 1
235 END IF
236 END DO
237 nrun = nrun + ntests
238 END DO
239 END DO
240 END IF
241 END DO
242 END DO
243*
244* Print a summary of the results.
245*
246 CALL alasum( path, nout, nfail, nrun, nerrs )
247*
248 9999 FORMAT( 'TS: M=', i5, ', N=', i5, ', MB=', i5,
249 $ ', NB=', i5,' test(', i2, ')=', g12.5 )
250 9998 FORMAT( 'SW: M=', i5, ', N=', i5, ', MB=', i5,
251 $ ', NB=', i5,' test(', i2, ')=', g12.5 )
252 RETURN
253*
254* End of DCHKTSQR
255*
256 END
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
subroutine dchktsqr(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
DCHKQRT
Definition dchktsqr.f:102
subroutine derrtsqr(path, nunit)
DERRTSQR
Definition derrtsqr.f:55
subroutine dtsqr01(tssw, m, n, mb, nb, result)
DTSQR01
Definition dtsqr01.f:84