108 IMPLICIT NONE
109
110
111
112
113
114
115 LOGICAL TSTERR
116 INTEGER NM, NN, NNB, NOUT
117 DOUBLE PRECISION THRESH
118
119
120 INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
121
122
123
124
125
126 INTEGER NTESTS
127 parameter( ntests = 6 )
128
129
130 CHARACTER(LEN=3) PATH
131 INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1,
132 $ NB2, NFAIL, NERRS, NRUN
133
134
135 DOUBLE PRECISION RESULT( NTESTS )
136
137
140
141
142 INTRINSIC max, min
143
144
145 LOGICAL LERR, OK
146 CHARACTER(LEN=32) SRNAMT
147 INTEGER INFOT, NUNIT
148
149
150 COMMON / infoc / infot, nunit, ok, lerr
151 COMMON / srnamc / srnamt
152
153
154
155
156
157 path( 1: 1 ) = 'D'
158 path( 2: 3 ) = 'HH'
159 nrun = 0
160 nfail = 0
161 nerrs = 0
162
163
164
166 infot = 0
167
168
169
170 DO i = 1, nm
171 m = mval( i )
172
173
174
175 DO j = 1, nn
176 n = nval( j )
177
178
179
180 IF ( min( m, n ).GT.0 .AND. m.GE.n ) THEN
181
182
183
184 DO imb1 = 1, nnb
185 mb1 = nbval( imb1 )
186
187
188
189 IF ( mb1.GT.n ) THEN
190
191
192
193 DO inb1 = 1, nnb
194 nb1 = nbval( inb1 )
195
196
197
198 DO inb2 = 1, nnb
199 nb2 = nbval( inb2 )
200
201 IF( nb1.GT.0 .AND. nb2.GT.0 ) THEN
202
203
204
206 $ nb2, result )
207
208
209
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
231
232 DO i = 1, nm
233 m = mval( i )
234
235
236
237 DO j = 1, nn
238 n = nval( j )
239
240
241
242 IF ( min( m, n ).GT.0 .AND. m.GE.n ) THEN
243
244
245
246 DO imb1 = 1, nnb
247 mb1 = nbval( imb1 )
248
249
250
251 IF ( mb1.GT.n ) THEN
252
253
254
255 DO inb1 = 1, nnb
256 nb1 = nbval( inb1 )
257
258
259
260 DO inb2 = 1, nnb
261 nb2 = nbval( inb2 )
262
263 IF( nb1.GT.0 .AND. nb2.GT.0 ) THEN
264
265
266
268 $ nb2, result )
269
270
271
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
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
305
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine alahd(iounit, path)
ALAHD
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