LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ derrhs()

subroutine derrhs ( character*3  PATH,
integer  NUNIT 
)

DERRHS

Purpose:
 DERRHS tests the error exits for DGEBAK, SGEBAL, SGEHRD, DORGHR,
 DORMHR, DHSEQR, SHSEIN, and DTREVC.
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.
Date
December 2016

Definition at line 57 of file derrhs.f.

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