LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zchkunhr_col.f
Go to the documentation of this file.
1*> \brief \b ZCHKUNHR_COL
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 ZCHKUNHR_COL( 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*> ZCHKUNHR_COL tests:
28*> 1) ZUNGTSQR and ZUNHR_COL using ZLATSQR, ZGEMQRT,
29*> 2) ZUNGTSQR_ROW and ZUNHR_COL inside ZGETSQRHRT
30*> (which calls ZLATSQR, ZUNGTSQR_ROW and ZUNHR_COL) using ZGEMQRT.
31*> Therefore, ZLATSQR (part of ZGEQR), ZGEMQRT (part of ZGEMQR)
32*> have to be tested before this test.
33*>
34*> \endverbatim
35*
36* Arguments:
37* ==========
38*
39*> \param[in] THRESH
40*> \verbatim
41*> THRESH is DOUBLE PRECISION
42*> The threshold value for the test ratios. A result is
43*> included in the output file if RESULT >= THRESH. To have
44*> every test ratio printed, use THRESH = 0.
45*> \endverbatim
46*>
47*> \param[in] TSTERR
48*> \verbatim
49*> TSTERR is LOGICAL
50*> Flag that indicates whether error exits are to be tested.
51*> \endverbatim
52*>
53*> \param[in] NM
54*> \verbatim
55*> NM is INTEGER
56*> The number of values of M contained in the vector MVAL.
57*> \endverbatim
58*>
59*> \param[in] MVAL
60*> \verbatim
61*> MVAL is INTEGER array, dimension (NM)
62*> The values of the matrix row dimension M.
63*> \endverbatim
64*>
65*> \param[in] NN
66*> \verbatim
67*> NN is INTEGER
68*> The number of values of N contained in the vector NVAL.
69*> \endverbatim
70*>
71*> \param[in] NVAL
72*> \verbatim
73*> NVAL is INTEGER array, dimension (NN)
74*> The values of the matrix column dimension N.
75*> \endverbatim
76*>
77*> \param[in] NNB
78*> \verbatim
79*> NNB is INTEGER
80*> The number of values of NB contained in the vector NBVAL.
81*> \endverbatim
82*>
83*> \param[in] NBVAL
84*> \verbatim
85*> NBVAL is INTEGER array, dimension (NNB)
86*> The values of the blocksize NB.
87*> \endverbatim
88*>
89*> \param[in] NOUT
90*> \verbatim
91*> NOUT is INTEGER
92*> The unit number for output.
93*> \endverbatim
94*
95* Authors:
96* ========
97*
98*> \author Univ. of Tennessee
99*> \author Univ. of California Berkeley
100*> \author Univ. of Colorado Denver
101*> \author NAG Ltd.
102*
103*> \ingroup complex16_lin
104*
105* =====================================================================
106 SUBROUTINE zchkunhr_col( THRESH, TSTERR, NM, MVAL, NN, NVAL,
107 $ NNB, NBVAL, NOUT )
108 IMPLICIT NONE
109*
110* -- LAPACK test routine --
111* -- LAPACK is a software package provided by Univ. of Tennessee, --
112* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
113*
114* .. Scalar Arguments ..
115 LOGICAL TSTERR
116 INTEGER NM, NN, NNB, NOUT
117 DOUBLE PRECISION THRESH
118* ..
119* .. Array Arguments ..
120 INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
121* ..
122*
123* =====================================================================
124*
125* .. Parameters ..
126 INTEGER NTESTS
127 parameter( ntests = 6 )
128* ..
129* .. Local Scalars ..
130 CHARACTER(LEN=3) PATH
131 INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1,
132 $ nb2, nfail, nerrs, nrun
133*
134* .. Local Arrays ..
135 DOUBLE PRECISION RESULT( NTESTS )
136* ..
137* .. External Subroutines ..
138 EXTERNAL alahd, alasum, zerrunhr_col, zunhr_col01,
139 $ zunhr_col02
140* ..
141* .. Intrinsic Functions ..
142 INTRINSIC max, min
143* ..
144* .. Scalars in Common ..
145 LOGICAL LERR, OK
146 CHARACTER(LEN=32) SRNAMT
147 INTEGER INFOT, NUNIT
148* ..
149* .. Common blocks ..
150 COMMON / infoc / infot, nunit, ok, lerr
151 COMMON / srnamc / srnamt
152* ..
153* .. Executable Statements ..
154*
155* Initialize constants
156*
157 path( 1: 1 ) = 'Z'
158 path( 2: 3 ) = 'HH'
159 nrun = 0
160 nfail = 0
161 nerrs = 0
162*
163* Test the error exits
164*
165 IF( tsterr ) CALL zerrunhr_col( path, nout )
166 infot = 0
167*
168* Do for each value of M in MVAL.
169*
170 DO i = 1, nm
171 m = mval( i )
172*
173* Do for each value of N in NVAL.
174*
175 DO j = 1, nn
176 n = nval( j )
177*
178* Only for M >= N
179*
180 IF ( min( m, n ).GT.0 .AND. m.GE.n ) THEN
181*
182* Do for each possible value of MB1
183*
184 DO imb1 = 1, nnb
185 mb1 = nbval( imb1 )
186*
187* Only for MB1 > N
188*
189 IF ( mb1.GT.n ) THEN
190*
191* Do for each possible value of NB1
192*
193 DO inb1 = 1, nnb
194 nb1 = nbval( inb1 )
195*
196* Do for each possible value of NB2
197*
198 DO inb2 = 1, nnb
199 nb2 = nbval( inb2 )
200*
201 IF( nb1.GT.0 .AND. nb2.GT.0 ) THEN
202*
203* Test ZUNHR_COL
204*
205 CALL zunhr_col01( m, n, mb1, nb1,
206 $ nb2, result )
207*
208* Print information about the tests that did
209* not pass the threshold.
210*
211 DO t = 1, ntests
212 IF( result( t ).GE.thresh ) THEN
213 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
214 $ CALL alahd( nout, path )
215 WRITE( nout, fmt = 9999 ) m, n, mb1,
216 $ nb1, nb2, t, result( t )
217 nfail = nfail + 1
218 END IF
219 END DO
220 nrun = nrun + ntests
221 END IF
222 END DO
223 END DO
224 END IF
225 END DO
226 END IF
227 END DO
228 END DO
229*
230* Do for each value of M in MVAL.
231*
232 DO i = 1, nm
233 m = mval( i )
234*
235* Do for each value of N in NVAL.
236*
237 DO j = 1, nn
238 n = nval( j )
239*
240* Only for M >= N
241*
242 IF ( min( m, n ).GT.0 .AND. m.GE.n ) THEN
243*
244* Do for each possible value of MB1
245*
246 DO imb1 = 1, nnb
247 mb1 = nbval( imb1 )
248*
249* Only for MB1 > N
250*
251 IF ( mb1.GT.n ) THEN
252*
253* Do for each possible value of NB1
254*
255 DO inb1 = 1, nnb
256 nb1 = nbval( inb1 )
257*
258* Do for each possible value of NB2
259*
260 DO inb2 = 1, nnb
261 nb2 = nbval( inb2 )
262*
263 IF( nb1.GT.0 .AND. nb2.GT.0 ) THEN
264*
265* Test ZUNHR_COL
266*
267 CALL zunhr_col02( m, n, mb1, nb1,
268 $ nb2, result )
269*
270* Print information about the tests that did
271* not pass the threshold.
272*
273 DO t = 1, ntests
274 IF( result( t ).GE.thresh ) THEN
275 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
276 $ CALL alahd( nout, path )
277 WRITE( nout, fmt = 9998 ) m, n, mb1,
278 $ nb1, nb2, t, result( t )
279 nfail = nfail + 1
280 END IF
281 END DO
282 nrun = nrun + ntests
283 END IF
284 END DO
285 END DO
286 END IF
287 END DO
288 END IF
289 END DO
290 END DO
291*
292* Print a summary of the results.
293*
294 CALL alasum( path, nout, nfail, nrun, nerrs )
295*
296 9999 FORMAT( 'ZUNGTSQR and ZUNHR_COL: M=', i5, ', N=', i5,
297 $ ', MB1=', i5, ', NB1=', i5, ', NB2=', i5,
298 $ ' test(', i2, ')=', g12.5 )
299 9998 FORMAT( 'ZUNGTSQR_ROW and ZUNHR_COL: M=', i5, ', N=', i5,
300 $ ', MB1=', i5, ', NB1=', i5, ', NB2=', i5,
301 $ ' test(', i2, ')=', g12.5 )
302 RETURN
303*
304* End of ZCHKUNHR_COL
305*
306 END
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
alahd
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
zchkunhr_col
subroutine zchkunhr_col(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
ZCHKUNHR_COL
Definition zchkunhr_col.f:108
zerrunhr_col
subroutine zerrunhr_col(path, nunit)
ZERRUNHR_COL
Definition zerrunhr_col.f:56
zunhr_col01
subroutine zunhr_col01(m, n, mb1, nb1, nb2, result)
ZUNHR_COL01
Definition zunhr_col01.f:119
zunhr_col02
subroutine zunhr_col02(m, n, mb1, nb1, nb2, result)
ZUNHR_COL02
Definition zunhr_col02.f:120