LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
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.
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, strevc3, sgehd2
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*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgebak
subroutine sgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
SGEBAK
Definition sgebak.f:130
sgebal
subroutine sgebal(job, n, a, lda, ilo, ihi, scale, info)
SGEBAL
Definition sgebal.f:163
sgehd2
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
sgehrd
subroutine sgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
SGEHRD
Definition sgehrd.f:167
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
shseqr
subroutine shseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
SHSEQR
Definition shseqr.f:316
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
strevc3
subroutine strevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, info)
STREVC3
Definition strevc3.f:237
strevc
subroutine strevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
STREVC
Definition strevc.f:222
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
Here is the call graph for this function:
Here is the caller graph for this function: