LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ serrhs()

subroutine serrhs ( character*3  PATH,
integer  NUNIT 
)

SERRHS

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