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

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