OpenRadioss 2025.1.11
OpenRadioss project
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, 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
the
end diagonal values have been computed in the(sparse) matrix id.SOL
sgehrd
subroutine sgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
SGEHRD
Definition sgehrd.f:167
sgebal
subroutine sgebal(job, n, a, lda, ilo, ihi, scale, info)
SGEBAL
Definition sgebal.f:160
sgebak
subroutine sgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
SGEBAK
Definition sgebak.f:130
shseqr
subroutine shseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
SHSEQR
Definition shseqr.f:316
sormhr
subroutine sormhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
SORMHR
Definition sormhr.f:179
sorghr
subroutine sorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
SORGHR
Definition sorghr.f:126
strevc
subroutine strevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
STREVC
Definition strevc.f:222
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