LAPACK  3.10.1
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.

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
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  nt = nt + 9
332 *
333 * DHSEIN
334 *
335  srnamt = 'DHSEIN'
336  infot = 1
337  CALL dhsein( '/', 'N', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
338  $ 0, m, w, ifaill, ifailr, info )
339  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
340  infot = 2
341  CALL dhsein( 'R', '/', '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 = 3
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 = 5
349  CALL dhsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
350  $ 1, 0, m, w, ifaill, ifailr, info )
351  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
352  infot = 7
353  CALL dhsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
354  $ 4, m, w, ifaill, ifailr, info )
355  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
356  infot = 11
357  CALL dhsein( 'L', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
358  $ 4, m, w, ifaill, ifailr, info )
359  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
360  infot = 13
361  CALL dhsein( 'R', '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 = 14
365  CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
366  $ 1, m, w, ifaill, ifailr, info )
367  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
368  nt = nt + 8
369 *
370 * DTREVC
371 *
372  srnamt = 'DTREVC'
373  infot = 1
374  CALL dtrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
375  $ info )
376  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
377  infot = 2
378  CALL dtrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
379  $ info )
380  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
381  infot = 4
382  CALL dtrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
383  $ info )
384  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
385  infot = 6
386  CALL dtrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
387  $ info )
388  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
389  infot = 8
390  CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
391  $ info )
392  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
393  infot = 10
394  CALL dtrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
395  $ info )
396  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
397  infot = 11
398  CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
399  $ info )
400  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
401  nt = nt + 7
402  END IF
403 *
404 * Print a summary line.
405 *
406  IF( ok ) THEN
407  WRITE( nout, fmt = 9999 )path, nt
408  ELSE
409  WRITE( nout, fmt = 9998 )path
410  END IF
411 *
412  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
413  $ ' (', i3, ' tests done)' )
414  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
415  $ 'exits ***' )
416 *
417  RETURN
418 *
419 * End of DERRHS
420 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
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
Here is the call graph for this function:
Here is the caller graph for this function: