LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dchkorhr_col()

subroutine dchkorhr_col ( double precision  thresh,
logical  tsterr,
integer  nm,
integer, dimension( * )  mval,
integer  nn,
integer, dimension( * )  nval,
integer  nnb,
integer, dimension( * )  nbval,
integer  nout 
)

DCHKORHR_COL

Purpose:
 DCHKORHR_COL tests:
   1) DORGTSQR and DORHR_COL using DLATSQR, DGEMQRT,
   2) DORGTSQR_ROW and DORHR_COL inside DGETSQRHRT
      (which calls DLATSQR, DORGTSQR_ROW and DORHR_COL) using DGEMQRT.
 Therefore, DLATSQR (part of DGEQR), DGEMQRT (part of DGEMQR)
 have to be tested before this test.
Parameters
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 106 of file dchkorhr_col.f.

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 ..
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 ) = 'D'
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 derrorhr_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 DORHR_COL
204*
205 CALL dorhr_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 DORHR_COL
266*
267 CALL dorhr_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( 'DORGTSQR and DORHR_COL: M=', i5, ', N=', i5,
297 $ ', MB1=', i5, ', NB1=', i5, ', NB2=', i5,
298 $ ' test(', i2, ')=', g12.5 )
299 9998 FORMAT( 'DORGTSQR_ROW and DORHR_COL: M=', i5, ', N=', i5,
300 $ ', MB1=', i5, ', NB1=', i5, ', NB2=', i5,
301 $ ' test(', i2, ')=', g12.5 )
302 RETURN
303*
304* End of DCHKORHR_COL
305*
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
subroutine derrorhr_col(path, nunit)
DERRORHR_COL
subroutine dorhr_col01(m, n, mb1, nb1, nb2, result)
DORHR_COL01
subroutine dorhr_col02(m, n, mb1, nb1, nb2, result)
DORHR_COL02
Here is the call graph for this function:
Here is the caller graph for this function: