OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zerrhs.f
Go to the documentation of this file.
1*> \brief \b ZERRHS
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 ZERRHS( 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*> ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR,
25*> ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC.
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 complex16_eig
52*
53* =====================================================================
54 SUBROUTINE zerrhs( 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*nmax )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, IHI, ILO, INFO, J, M, NT
74* ..
75* .. Local Arrays ..
76 LOGICAL SEL( NMAX )
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 DOUBLE PRECISION RW( NMAX ), S( NMAX )
79 COMPLEX*16 A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
80 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
81 $ X( NMAX )
82* ..
83* .. External Functions ..
84 LOGICAL LSAMEN
85 EXTERNAL lsamen
86* ..
87* .. External Subroutines ..
88 EXTERNAL chkxer, zgebak, zgebal, zgehrd, zhsein, zhseqr,
89 $ ztrevc, zunghr, zunmhr
90* ..
91* .. Intrinsic Functions ..
92 INTRINSIC dble
93* ..
94* .. Scalars in Common ..
95 LOGICAL LERR, OK
96 CHARACTER*32 SRNAMT
97 INTEGER INFOT, NOUT
98* ..
99* .. Common blocks ..
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
102* ..
103* .. Executable Statements ..
104*
105 nout = nunit
106 WRITE( nout, fmt = * )
107 c2 = path( 2: 3 )
108*
109* Set the variables to innocuous values.
110*
111 DO 20 j = 1, nmax
112 DO 10 i = 1, nmax
113 a( i, j ) = 1.d0 / dble( i+j )
114 10 CONTINUE
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* ZGEBAL
125*
126 srnamt = 'ZGEBAL'
127 infot = 1
128 CALL zgebal( '/', 0, a, 1, ilo, ihi, s, info )
129 CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
130 infot = 2
131 CALL zgebal( 'N', -1, a, 1, ilo, ihi, s, info )
132 CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
133 infot = 4
134 CALL zgebal( 'N', 2, a, 1, ilo, ihi, s, info )
135 CALL chkxer( 'zgebal', INFOT, NOUT, LERR, OK )
136 NT = NT + 3
137*
138* ZGEBAK
139*
140 SRNAMT = 'zgebak'
141 INFOT = 1
142 CALL ZGEBAK( '/', 'r', 0, 1, 0, S, 0, A, 1, INFO )
143 CALL CHKXER( 'zgebak', INFOT, NOUT, LERR, OK )
144 INFOT = 2
145 CALL ZGEBAK( 'n', '/', 0, 1, 0, S, 0, A, 1, INFO )
146 CALL CHKXER( 'zgebak', INFOT, NOUT, LERR, OK )
147 INFOT = 3
148 CALL ZGEBAK( 'n', 'R', -1, 1, 0, s, 0, a, 1, info )
149 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
150 infot = 4
151 CALL zgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
152 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
153 infot = 4
154 CALL zgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
155 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
156 infot = 5
157 CALL zgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
158 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
159 infot = 5
160 CALL zgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
161 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
162 infot = 7
163 CALL zgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
164 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
165 infot = 9
166 CALL zgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
167 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
168 nt = nt + 9
169*
170* ZGEHRD
171*
172 srnamt = 'ZGEHRD'
173 infot = 1
174 CALL zgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
176 infot = 2
177 CALL zgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
179 infot = 2
180 CALL zgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
182 infot = 3
183 CALL zgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
185 infot = 3
186 CALL zgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
188 infot = 5
189 CALL zgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
191 infot = 8
192 CALL zgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
194 nt = nt + 7
195*
196* ZUNGHR
197*
198 srnamt = 'ZUNGHR'
199 infot = 1
200 CALL zunghr( -1, 1, 1, a, 1, tau, w, 1, info )
201 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
202 infot = 2
203 CALL zunghr( 0, 0, 0, a, 1, tau, w, 1, info )
204 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
205 infot = 2
206 CALL zunghr( 0, 2, 0, a, 1, tau, w, 1, info )
207 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
208 infot = 3
209 CALL zunghr( 1, 1, 0, a, 1, tau, w, 1, info )
210 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
211 infot = 3
212 CALL zunghr( 0, 1, 1, a, 1, tau, w, 1, info )
213 CALL chkxer( 'zunghr', INFOT, NOUT, LERR, OK )
214 INFOT = 5
215 CALL ZUNGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO )
216 CALL CHKXER( 'zunghr', INFOT, NOUT, LERR, OK )
217 INFOT = 8
218 CALL ZUNGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO )
219 CALL CHKXER( 'zunghr', INFOT, NOUT, LERR, OK )
220 NT = NT + 7
221*
222* ZUNMHR
223*
224 SRNAMT = 'zunmhr'
225 INFOT = 1
226 CALL ZUNMHR( '/', 'n', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
227 $ INFO )
228 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
229 INFOT = 2
230 CALL ZUNMHR( 'l', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
231 $ INFO )
232 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
233 INFOT = 3
234 CALL ZUNMHR( 'l', 'n', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
235 $ INFO )
236 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
237 INFOT = 4
238 CALL ZUNMHR( 'l', 'n', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1,
239 $ INFO )
240 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
241 INFOT = 5
242 CALL ZUNMHR( 'l', 'n', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1,
243 $ INFO )
244 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
245 INFOT = 5
246 CALL ZUNMHR( 'l', 'n', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1,
247 $ INFO )
248 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
249 INFOT = 5
250 CALL ZUNMHR( 'l', 'n', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2,
251 $ INFO )
252 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
253 INFOT = 5
254 CALL ZUNMHR( 'r', 'n', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2,
255 $ INFO )
256 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
257 INFOT = 6
258 CALL ZUNMHR( 'l', 'n', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1,
259 $ INFO )
260 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
261 INFOT = 6
262 CALL ZUNMHR( 'l', 'n', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1,
263 $ INFO )
264 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
265 INFOT = 6
266 CALL ZUNMHR( 'r', 'n', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1,
267 $ INFO )
268 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
269 INFOT = 8
270 CALL ZUNMHR( 'l', 'n', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
271 $ INFO )
272 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
273 INFOT = 8
274 CALL ZUNMHR( 'r', 'n', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
275 $ INFO )
276 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
277 INFOT = 11
278 CALL ZUNMHR( 'l', 'n', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1,
279 $ INFO )
280 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
281 INFOT = 13
282 CALL ZUNMHR( 'l', 'n', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
283 $ INFO )
284 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
285 INFOT = 13
286 CALL ZUNMHR( 'r', 'n', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
287 $ INFO )
288 CALL CHKXER( 'zunmhr', INFOT, NOUT, LERR, OK )
289 NT = NT + 16
290*
291* ZHSEQR
292*
293 SRNAMT = 'zhseqr'
294 INFOT = 1
295 CALL ZHSEQR( '/', 'n', 0, 1, 0, A, 1, X, C, 1, W, 1, INFO )
296 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
297 INFOT = 2
298 CALL ZHSEQR( 'e', '/', 0, 1, 0, A, 1, X, C, 1, W, 1, INFO )
299 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
300 INFOT = 3
301 CALL ZHSEQR( 'e', 'n', -1, 1, 0, A, 1, X, C, 1, W, 1, INFO )
302 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
303 INFOT = 4
304 CALL ZHSEQR( 'e', 'n', 0, 0, 0, A, 1, X, C, 1, W, 1, INFO )
305 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
306 INFOT = 4
307 CALL ZHSEQR( 'e', 'n', 0, 2, 0, A, 1, X, C, 1, W, 1, INFO )
308 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
309 INFOT = 5
310 CALL ZHSEQR( 'e', 'n', 1, 1, 0, A, 1, X, C, 1, W, 1, INFO )
311 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
312 INFOT = 5
313 CALL ZHSEQR( 'e', 'n', 1, 1, 2, A, 1, X, C, 1, W, 1, INFO )
314 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
315 INFOT = 7
316 CALL ZHSEQR( 'e', 'n', 2, 1, 2, A, 1, X, C, 2, W, 1, INFO )
317 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
318 INFOT = 10
319 CALL ZHSEQR( 'e', 'v', 2, 1, 2, A, 2, X, C, 1, W, 1, INFO )
320 CALL CHKXER( 'zhseqr', INFOT, NOUT, LERR, OK )
321 NT = NT + 9
322*
323* ZHSEIN
324*
325 SRNAMT = 'zhsein'
326 INFOT = 1
327 CALL ZHSEIN( '/', 'n', 'n', SEL, 0, A, 1, X, VL, 1, VR, 1, 0,
328 $ M, W, RW, IFAILL, IFAILR, INFO )
329 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
330 INFOT = 2
331 CALL ZHSEIN( 'r', '/', 'n', SEL, 0, A, 1, X, VL, 1, VR, 1, 0,
332 $ M, W, RW, IFAILL, IFAILR, INFO )
333 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
334 INFOT = 3
335 CALL ZHSEIN( 'r', 'n', '/', SEL, 0, A, 1, X, VL, 1, VR, 1, 0,
336 $ M, W, RW, IFAILL, IFAILR, INFO )
337 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
338 INFOT = 5
339 CALL ZHSEIN( 'r', 'n', 'n', SEL, -1, A, 1, X, VL, 1, VR, 1, 0,
340 $ M, W, RW, IFAILL, IFAILR, INFO )
341 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
342 INFOT = 7
343 CALL ZHSEIN( 'r', 'n', 'n', SEL, 2, A, 1, X, VL, 1, VR, 2, 4,
344 $ M, W, RW, IFAILL, IFAILR, INFO )
345 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
346 INFOT = 10
347 CALL ZHSEIN( 'l', 'n', 'n', SEL, 2, A, 2, X, VL, 1, VR, 1, 4,
348 $ M, W, RW, IFAILL, IFAILR, INFO )
349 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
350 INFOT = 12
351 CALL ZHSEIN( 'r', 'n', 'n', SEL, 2, A, 2, X, VL, 1, VR, 1, 4,
352 $ M, W, RW, IFAILL, IFAILR, INFO )
353 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
354 INFOT = 13
355 CALL ZHSEIN( 'r', 'n', 'n', SEL, 2, A, 2, X, VL, 1, VR, 2, 1,
356 $ M, W, RW, IFAILL, IFAILR, INFO )
357 CALL CHKXER( 'zhsein', INFOT, NOUT, LERR, OK )
358 NT = NT + 8
359*
360* ZTREVC
361*
362 SRNAMT = 'ztrevc'
363 INFOT = 1
364 CALL ZTREVC( '/', 'a', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, RW,
365 $ INFO )
366 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
367 INFOT = 2
368 CALL ZTREVC( 'l', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, RW,
369 $ INFO )
370 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
371 INFOT = 4
372 CALL ZTREVC( 'l', 'a', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W,
373 $ RW, INFO )
374 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
375 INFOT = 6
376 CALL ZTREVC( 'l', 'a', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W, RW,
377 $ INFO )
378 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
379 INFOT = 8
380 CALL ZTREVC( 'l', 'a', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, RW,
381 $ INFO )
382 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
383 INFOT = 10
384 CALL ZTREVC( 'r', 'a', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, RW,
385 $ INFO )
386 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
387 INFOT = 11
388 CALL ZTREVC( 'l', 'a', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W, RW,
389 $ INFO )
390 CALL CHKXER( 'ztrevc', INFOT, NOUT, LERR, OK )
391 NT = NT + 7
392 END IF
393*
394* Print a summary line.
395*
396 IF( OK ) THEN
397 WRITE( NOUT, FMT = 9999 )PATH, NT
398 ELSE
399 WRITE( NOUT, FMT = 9998 )PATH
400 END IF
401*
402 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
403 $ ' (', I3, ' tests done)' )
404 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
405 $ 'exits ***' )
406*
407 RETURN
408*
409* End of ZERRHS
410*
411 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
zgebal
subroutine zgebal(job, n, a, lda, ilo, ihi, scale, info)
ZGEBAL
Definition zgebal.f:162
zgehrd
subroutine zgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
ZGEHRD
Definition zgehrd.f:167
zgebak
subroutine zgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
ZGEBAK
Definition zgebak.f:131
ztrevc
subroutine ztrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
ZTREVC
Definition ztrevc.f:218
zhseqr
subroutine zhseqr(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
ZHSEQR
Definition zhseqr.f:299
zhsein
subroutine zhsein(side, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr, info)
ZHSEIN
Definition zhsein.f:245
zunghr
subroutine zunghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
ZUNGHR
Definition zunghr.f:126
zunmhr
subroutine zunmhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
ZUNMHR
Definition zunmhr.f:178
zerrhs
subroutine zerrhs(path, nunit)
ZERRHS
Definition zerrhs.f:55