LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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, STREVC, and STREVC3.
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,
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 infot = 13
331 CALL shseqr( 'E', 'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
332 $ info )
333 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
334 nt = nt + 10
335*
336* SHSEIN
337*
338 srnamt = 'SHSEIN'
339 infot = 1
340 CALL shsein( '/', 'N', '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 = 2
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 = 3
348 CALL shsein( 'R', 'N', '/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
349 $ 0, m, w, ifaill, ifailr, info )
350 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
351 infot = 5
352 CALL shsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
353 $ 1, 0, m, w, ifaill, ifailr, info )
354 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
355 infot = 7
356 CALL shsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
357 $ 4, m, w, ifaill, ifailr, info )
358 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
359 infot = 11
360 CALL shsein( 'L', '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 = 13
364 CALL shsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
365 $ 4, m, w, ifaill, ifailr, info )
366 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
367 infot = 14
368 CALL shsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
369 $ 1, m, w, ifaill, ifailr, info )
370 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
371 nt = nt + 8
372*
373* STREVC
374*
375 srnamt = 'STREVC'
376 infot = 1
377 CALL strevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
378 $ info )
379 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
380 infot = 2
381 CALL strevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
382 $ info )
383 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
384 infot = 4
385 CALL strevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
386 $ info )
387 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
388 infot = 6
389 CALL strevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
390 $ info )
391 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
392 infot = 8
393 CALL strevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
394 $ info )
395 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
396 infot = 10
397 CALL strevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
398 $ info )
399 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
400 infot = 11
401 CALL strevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
402 $ info )
403 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
404 nt = nt + 7
405*
406* STREVC3
407*
408 srnamt = 'STREVC3'
409 infot = 1
410 CALL strevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
411 $ lw, info )
412 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
413 infot = 2
414 CALL strevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
415 $ lw, info )
416 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
417 infot = 4
418 CALL strevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
419 $ lw, info )
420 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
421 infot = 6
422 CALL strevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
423 $ lw, info )
424 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
425 infot = 8
426 CALL strevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
427 $ lw, info )
428 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
429 infot = 10
430 CALL strevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
431 $ lw, info )
432 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
433 infot = 11
434 CALL strevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
435 $ lw, info )
436 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
437 infot = 14
438 CALL strevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
439 $ 2, info )
440 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
441 nt = nt + 8
442 END IF
443*
444* Print a summary line.
445*
446 IF( ok ) THEN
447 WRITE( nout, fmt = 9999 )path, nt
448 ELSE
449 WRITE( nout, fmt = 9998 )path
450 END IF
451*
452 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
453 $ ' (', i3, ' tests done)' )
454 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
455 $ 'exits ***' )
456*
457 RETURN
458*
459* End of SERRHS
460*
461 END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
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 strevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, INFO)
STREVC3
Definition: strevc3.f:237
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
subroutine serrhs(PATH, NUNIT)
SERRHS
Definition: serrhs.f:55