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

◆ derrhs()

subroutine derrhs ( character*3  PATH,
integer  NUNIT 
)

DERRHS

Purpose:
 DERRHS tests the error exits for DGEBAK, DGEBAL, DGEHRD, DORGHR,
 DORMHR, DHSEQR, DHSEIN, DTREVC, and DTREVC3.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file derrhs.f.

55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX, LW
69 parameter( nmax = 3, lw = ( nmax+2 )*( nmax+2 )+nmax )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, IHI, ILO, INFO, J, M, NT
74* ..
75* .. Local Arrays ..
76 LOGICAL SEL( NMAX )
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 DOUBLE PRECISION A( NMAX, NMAX ), C( NMAX, NMAX ), S( NMAX ),
79 $ TAU( NMAX ), VL( NMAX, NMAX ),
80 $ VR( NMAX, NMAX ), W( LW ), WI( NMAX ),
81 $ WR( NMAX )
82* ..
83* .. External Functions ..
84 LOGICAL LSAMEN
85 EXTERNAL lsamen
86* ..
87* .. External Subroutines ..
88 EXTERNAL chkxer, dgebak, dgebal, dgehrd, dhsein, dhseqr,
89 $ dorghr, dormhr, dtrevc, dtrevc3
90* ..
91* .. Intrinsic Functions ..
92 INTRINSIC dble
93* ..
94* .. Scalars in Common ..
95 LOGICAL LERR, OK
96 CHARACTER*32 SRNAMT
97 INTEGER INFOT, NOUT
98* ..
99* .. Common blocks ..
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
102* ..
103* .. Executable Statements ..
104*
105 nout = nunit
106 WRITE( nout, fmt = * )
107 c2 = path( 2: 3 )
108*
109* Set the variables to innocuous values.
110*
111 DO 20 j = 1, nmax
112 DO 10 i = 1, nmax
113 a( i, j ) = 1.d0 / dble( i+j )
114 10 CONTINUE
115 wi( j ) = dble( j )
116 sel( j ) = .true.
117 20 CONTINUE
118 ok = .true.
119 nt = 0
120*
121* Test error exits of the nonsymmetric eigenvalue routines.
122*
123 IF( lsamen( 2, c2, 'HS' ) ) THEN
124*
125* DGEBAL
126*
127 srnamt = 'DGEBAL'
128 infot = 1
129 CALL dgebal( '/', 0, a, 1, ilo, ihi, s, info )
130 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
131 infot = 2
132 CALL dgebal( 'N', -1, a, 1, ilo, ihi, s, info )
133 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
134 infot = 4
135 CALL dgebal( 'N', 2, a, 1, ilo, ihi, s, info )
136 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
137 nt = nt + 3
138*
139* DGEBAK
140*
141 srnamt = 'DGEBAK'
142 infot = 1
143 CALL dgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
144 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
145 infot = 2
146 CALL dgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
147 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
148 infot = 3
149 CALL dgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
150 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
151 infot = 4
152 CALL dgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
153 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
154 infot = 4
155 CALL dgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
156 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
157 infot = 5
158 CALL dgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
159 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
160 infot = 5
161 CALL dgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
162 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
163 infot = 7
164 CALL dgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
165 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
166 infot = 9
167 CALL dgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
168 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
169 nt = nt + 9
170*
171* DGEHRD
172*
173 srnamt = 'DGEHRD'
174 infot = 1
175 CALL dgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
176 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
177 infot = 2
178 CALL dgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
179 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
180 infot = 2
181 CALL dgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
182 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
183 infot = 3
184 CALL dgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
185 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
186 infot = 3
187 CALL dgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
188 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
189 infot = 5
190 CALL dgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
191 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
192 infot = 8
193 CALL dgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
194 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
195 nt = nt + 7
196*
197* DORGHR
198*
199 srnamt = 'DORGHR'
200 infot = 1
201 CALL dorghr( -1, 1, 1, a, 1, tau, w, 1, info )
202 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
203 infot = 2
204 CALL dorghr( 0, 0, 0, a, 1, tau, w, 1, info )
205 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
206 infot = 2
207 CALL dorghr( 0, 2, 0, a, 1, tau, w, 1, info )
208 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
209 infot = 3
210 CALL dorghr( 1, 1, 0, a, 1, tau, w, 1, info )
211 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
212 infot = 3
213 CALL dorghr( 0, 1, 1, a, 1, tau, w, 1, info )
214 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
215 infot = 5
216 CALL dorghr( 2, 1, 1, a, 1, tau, w, 1, info )
217 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
218 infot = 8
219 CALL dorghr( 3, 1, 3, a, 3, tau, w, 1, info )
220 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
221 nt = nt + 7
222*
223* DORMHR
224*
225 srnamt = 'DORMHR'
226 infot = 1
227 CALL dormhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
228 $ info )
229 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
230 infot = 2
231 CALL dormhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
232 $ info )
233 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
234 infot = 3
235 CALL dormhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
236 $ info )
237 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
238 infot = 4
239 CALL dormhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
240 $ info )
241 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
242 infot = 5
243 CALL dormhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
244 $ info )
245 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
246 infot = 5
247 CALL dormhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
248 $ info )
249 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
250 infot = 5
251 CALL dormhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
252 $ info )
253 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
254 infot = 5
255 CALL dormhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
256 $ info )
257 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
258 infot = 6
259 CALL dormhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
260 $ info )
261 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
262 infot = 6
263 CALL dormhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
264 $ info )
265 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
266 infot = 6
267 CALL dormhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
268 $ info )
269 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
270 infot = 8
271 CALL dormhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
272 $ info )
273 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
274 infot = 8
275 CALL dormhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
276 $ info )
277 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
278 infot = 11
279 CALL dormhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
280 $ info )
281 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
282 infot = 13
283 CALL dormhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
284 $ info )
285 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
286 infot = 13
287 CALL dormhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
288 $ info )
289 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
290 nt = nt + 16
291*
292* DHSEQR
293*
294 srnamt = 'DHSEQR'
295 infot = 1
296 CALL dhseqr( '/', 'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
297 $ info )
298 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
299 infot = 2
300 CALL dhseqr( 'E', '/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
301 $ info )
302 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
303 infot = 3
304 CALL dhseqr( 'E', 'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
305 $ info )
306 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
307 infot = 4
308 CALL dhseqr( 'E', 'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
309 $ info )
310 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
311 infot = 4
312 CALL dhseqr( 'E', 'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
313 $ info )
314 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
315 infot = 5
316 CALL dhseqr( 'E', 'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
317 $ info )
318 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
319 infot = 5
320 CALL dhseqr( 'E', 'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
321 $ info )
322 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
323 infot = 7
324 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
325 $ info )
326 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
327 infot = 11
328 CALL dhseqr( 'E', 'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
329 $ info )
330 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
331 infot = 13
332 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
333 $ info )
334 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
335 nt = nt + 10
336*
337* DHSEIN
338*
339 srnamt = 'DHSEIN'
340 infot = 1
341 CALL dhsein( '/', 'N', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
342 $ 0, m, w, ifaill, ifailr, info )
343 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
344 infot = 2
345 CALL dhsein( 'R', '/', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
346 $ 0, m, w, ifaill, ifailr, info )
347 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
348 infot = 3
349 CALL dhsein( 'R', 'N', '/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
350 $ 0, m, w, ifaill, ifailr, info )
351 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
352 infot = 5
353 CALL dhsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
354 $ 1, 0, m, w, ifaill, ifailr, info )
355 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
356 infot = 7
357 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
358 $ 4, m, w, ifaill, ifailr, info )
359 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
360 infot = 11
361 CALL dhsein( 'L', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
362 $ 4, m, w, ifaill, ifailr, info )
363 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
364 infot = 13
365 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
366 $ 4, m, w, ifaill, ifailr, info )
367 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
368 infot = 14
369 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
370 $ 1, m, w, ifaill, ifailr, info )
371 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
372 nt = nt + 8
373*
374* DTREVC
375*
376 srnamt = 'DTREVC'
377 infot = 1
378 CALL dtrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
379 $ info )
380 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
381 infot = 2
382 CALL dtrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
383 $ info )
384 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
385 infot = 4
386 CALL dtrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
387 $ info )
388 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
389 infot = 6
390 CALL dtrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
391 $ info )
392 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
393 infot = 8
394 CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
395 $ info )
396 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
397 infot = 10
398 CALL dtrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
399 $ info )
400 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
401 infot = 11
402 CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
403 $ info )
404 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
405 nt = nt + 7
406*
407* DTREVC3
408*
409 srnamt = 'DTREVC3'
410 infot = 1
411 CALL dtrevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
412 $ lw, info )
413 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
414 infot = 2
415 CALL dtrevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
416 $ lw, info )
417 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
418 infot = 4
419 CALL dtrevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
420 $ lw, info )
421 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
422 infot = 6
423 CALL dtrevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
424 $ lw, info )
425 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
426 infot = 8
427 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
428 $ lw, info )
429 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
430 infot = 10
431 CALL dtrevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
432 $ lw, info )
433 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
434 infot = 11
435 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
436 $ lw, info )
437 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
438 infot = 14
439 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
440 $ 2, info )
441 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
442 nt = nt + 8
443 END IF
444*
445* Print a summary line.
446*
447 IF( ok ) THEN
448 WRITE( nout, fmt = 9999 )path, nt
449 ELSE
450 WRITE( nout, fmt = 9998 )path
451 END IF
452*
453 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
454 $ ' (', i3, ' tests done)' )
455 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
456 $ 'exits ***' )
457*
458 RETURN
459*
460* End of DERRHS
461*
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
dgehrd
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
Definition: dgehrd.f:167
dgebal
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
Definition: dgebal.f:160
dgebak
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:130
dhsein
subroutine dhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, IFAILR, INFO)
DHSEIN
Definition: dhsein.f:263
dtrevc
subroutine dtrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTREVC
Definition: dtrevc.f:222
dhseqr
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
Definition: dhseqr.f:316
dormhr
subroutine dormhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMHR
Definition: dormhr.f:178
dorghr
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:126
dtrevc3
subroutine dtrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, INFO)
DTREVC3
Definition: dtrevc3.f:237
Here is the call graph for this function:
Here is the caller graph for this function: