LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ serrhs()

 subroutine serrhs ( character*3 path, integer nunit )

SERRHS

Purpose:
``` SERRHS tests the error exits for SGEBAK, SGEBAL, SGEHRD, SGEHD2,
SORGHR, SORMHR, SHSEQR, SHSEIN, STREVC, and STREVC3.```
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.```

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,
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* SGEHD2
197*
198 srnamt = 'SGEHD2'
199 infot = 1
200 CALL sgehd2( -1, 1, 1, a, 1, tau, w, info )
201 CALL chkxer( 'SGEHD2', infot, nout, lerr, ok )
202 infot = 2
203 CALL sgehd2( 0, 0, 0, a, 1, tau, w, info )
204 CALL chkxer( 'SGEHD2', infot, nout, lerr, ok )
205 infot = 2
206 CALL sgehd2( 0, 2, 0, a, 1, tau, w, info )
207 CALL chkxer( 'SGEHD2', infot, nout, lerr, ok )
208 infot = 3
209 CALL sgehd2( 1, 1, 0, a, 1, tau, w, info )
210 CALL chkxer( 'SGEHD2', infot, nout, lerr, ok )
211 infot = 3
212 CALL sgehd2( 0, 1, 1, a, 1, tau, w, info )
213 CALL chkxer( 'SGEHD2', infot, nout, lerr, ok )
214 infot = 5
215 CALL sgehd2( 2, 1, 1, a, 1, tau, w, info )
216 CALL chkxer( 'SGEHD2', infot, nout, lerr, ok )
217 nt = nt + 6
218*
219* SORGHR
220*
221 srnamt = 'SORGHR'
222 infot = 1
223 CALL sorghr( -1, 1, 1, a, 1, tau, w, 1, info )
224 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
225 infot = 2
226 CALL sorghr( 0, 0, 0, a, 1, tau, w, 1, info )
227 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
228 infot = 2
229 CALL sorghr( 0, 2, 0, a, 1, tau, w, 1, info )
230 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
231 infot = 3
232 CALL sorghr( 1, 1, 0, a, 1, tau, w, 1, info )
233 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
234 infot = 3
235 CALL sorghr( 0, 1, 1, a, 1, tau, w, 1, info )
236 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
237 infot = 5
238 CALL sorghr( 2, 1, 1, a, 1, tau, w, 1, info )
239 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
240 infot = 8
241 CALL sorghr( 3, 1, 3, a, 3, tau, w, 1, info )
242 CALL chkxer( 'SORGHR', infot, nout, lerr, ok )
243 nt = nt + 7
244*
245* SORMHR
246*
247 srnamt = 'SORMHR'
248 infot = 1
249 CALL sormhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
250 \$ info )
251 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
252 infot = 2
253 CALL sormhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
254 \$ info )
255 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
256 infot = 3
257 CALL sormhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
258 \$ info )
259 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
260 infot = 4
261 CALL sormhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
262 \$ info )
263 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
264 infot = 5
265 CALL sormhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
266 \$ info )
267 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
268 infot = 5
269 CALL sormhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
270 \$ info )
271 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
272 infot = 5
273 CALL sormhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
274 \$ info )
275 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
276 infot = 5
277 CALL sormhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
278 \$ info )
279 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
280 infot = 6
281 CALL sormhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
282 \$ info )
283 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
284 infot = 6
285 CALL sormhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
286 \$ info )
287 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
288 infot = 6
289 CALL sormhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
290 \$ info )
291 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
292 infot = 8
293 CALL sormhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
294 \$ info )
295 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
296 infot = 8
297 CALL sormhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
298 \$ info )
299 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
300 infot = 11
301 CALL sormhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
302 \$ info )
303 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
304 infot = 13
305 CALL sormhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
306 \$ info )
307 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
308 infot = 13
309 CALL sormhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
310 \$ info )
311 CALL chkxer( 'SORMHR', infot, nout, lerr, ok )
312 nt = nt + 16
313*
314* SHSEQR
315*
316 srnamt = 'SHSEQR'
317 infot = 1
318 CALL shseqr( '/', 'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
319 \$ info )
320 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
321 infot = 2
322 CALL shseqr( 'E', '/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
323 \$ info )
324 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
325 infot = 3
326 CALL shseqr( 'E', 'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
327 \$ info )
328 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
329 infot = 4
330 CALL shseqr( 'E', 'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
331 \$ info )
332 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
333 infot = 4
334 CALL shseqr( 'E', 'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
335 \$ info )
336 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
337 infot = 5
338 CALL shseqr( 'E', 'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
339 \$ info )
340 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
341 infot = 5
342 CALL shseqr( 'E', 'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
343 \$ info )
344 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
345 infot = 7
346 CALL shseqr( 'E', 'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
347 \$ info )
348 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
349 infot = 11
350 CALL shseqr( 'E', 'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
351 \$ info )
352 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
353 infot = 13
354 CALL shseqr( 'E', 'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
355 \$ info )
356 CALL chkxer( 'SHSEQR', infot, nout, lerr, ok )
357 nt = nt + 10
358*
359* SHSEIN
360*
361 srnamt = 'SHSEIN'
362 infot = 1
363 CALL shsein( '/', 'N', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
364 \$ 0, m, w, ifaill, ifailr, info )
365 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
366 infot = 2
367 CALL shsein( 'R', '/', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
368 \$ 0, m, w, ifaill, ifailr, info )
369 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
370 infot = 3
371 CALL shsein( 'R', 'N', '/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
372 \$ 0, m, w, ifaill, ifailr, info )
373 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
374 infot = 5
375 CALL shsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
376 \$ 1, 0, m, w, ifaill, ifailr, info )
377 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
378 infot = 7
379 CALL shsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
380 \$ 4, m, w, ifaill, ifailr, info )
381 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
382 infot = 11
383 CALL shsein( 'L', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
384 \$ 4, m, w, ifaill, ifailr, info )
385 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
386 infot = 13
387 CALL shsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
388 \$ 4, m, w, ifaill, ifailr, info )
389 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
390 infot = 14
391 CALL shsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
392 \$ 1, m, w, ifaill, ifailr, info )
393 CALL chkxer( 'SHSEIN', infot, nout, lerr, ok )
394 nt = nt + 8
395*
396* STREVC
397*
398 srnamt = 'STREVC'
399 infot = 1
400 CALL strevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
401 \$ info )
402 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
403 infot = 2
404 CALL strevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
405 \$ info )
406 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
407 infot = 4
408 CALL strevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
409 \$ info )
410 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
411 infot = 6
412 CALL strevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
413 \$ info )
414 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
415 infot = 8
416 CALL strevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
417 \$ info )
418 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
419 infot = 10
420 CALL strevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
421 \$ info )
422 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
423 infot = 11
424 CALL strevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
425 \$ info )
426 CALL chkxer( 'STREVC', infot, nout, lerr, ok )
427 nt = nt + 7
428*
429* STREVC3
430*
431 srnamt = 'STREVC3'
432 infot = 1
433 CALL strevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
434 \$ lw, info )
435 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
436 infot = 2
437 CALL strevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
438 \$ lw, info )
439 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
440 infot = 4
441 CALL strevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
442 \$ lw, info )
443 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
444 infot = 6
445 CALL strevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
446 \$ lw, info )
447 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
448 infot = 8
449 CALL strevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
450 \$ lw, info )
451 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
452 infot = 10
453 CALL strevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
454 \$ lw, info )
455 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
456 infot = 11
457 CALL strevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
458 \$ lw, info )
459 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
460 infot = 14
461 CALL strevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
462 \$ 2, info )
463 CALL chkxer( 'STREVC3', infot, nout, lerr, ok )
464 nt = nt + 8
465 END IF
466*
467* Print a summary line.
468*
469 IF( ok ) THEN
470 WRITE( nout, fmt = 9999 )path, nt
471 ELSE
472 WRITE( nout, fmt = 9998 )path
473 END IF
474*
475 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
476 \$ ' (', i3, ' tests done)' )
477 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
478 \$ 'exits ***' )
479*
480 RETURN
481*
482* End of SERRHS
483*
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine sgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
SGEBAK
Definition sgebak.f:130
subroutine sgebal(job, n, a, lda, ilo, ihi, scale, info)
SGEBAL
Definition sgebal.f:163
subroutine sgehd2(n, ilo, ihi, a, lda, tau, work, info)
SGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
Definition sgehd2.f:149
subroutine sgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
SGEHRD
Definition sgehrd.f:167
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 shseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
SHSEQR
Definition shseqr.f:316
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
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 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
Here is the call graph for this function:
Here is the caller graph for this function: