LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
serrhs.f
Go to the documentation of this file.
1 *> \brief \b SERRHS
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SERRHS( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> SERRHS tests the error exits for SGEBAK, SGEBAL, SGEHRD, SORGHR,
25 *> SORMHR, SHSEQR, SHSEIN, and STREVC.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \ingroup single_eig
52 *
53 * =====================================================================
54  SUBROUTINE serrhs( PATH, NUNIT )
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 *
420  END
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
sgebal
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
Definition: sgebal.f:160
sgehrd
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
Definition: sgehrd.f:167
sgebak
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
Definition: sgebak.f:130
sorghr
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
Definition: sorghr.f:126
sormhr
subroutine sormhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMHR
Definition: sormhr.f:179
strevc
subroutine strevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STREVC
Definition: strevc.f:222
shseqr
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
Definition: shseqr.f:316
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:263
serrhs
subroutine serrhs(PATH, NUNIT)
SERRHS
Definition: serrhs.f:55