LAPACK 3.11.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, 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,
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*
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
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 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
Here is the call graph for this function:
Here is the caller graph for this function: