OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrhs.f
Go to the documentation of this file.
1*> \brief \b DERRHS
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 DERRHS( 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*> DERRHS tests the error exits for DGEBAK, SGEBAL, SGEHRD, DORGHR,
25*> DORMHR, DHSEQR, SHSEIN, and DTREVC.
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 double_eig
52*
53* =====================================================================
54 SUBROUTINE derrhs( 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, IHI, ILO, INFO, J, M, NT
74* ..
75* .. Local Arrays ..
76 LOGICAL SEL( NMAX )
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 DOUBLE PRECISION A( NMAX, NMAX ), C( NMAX, NMAX ), S( NMAX ),
79 $ TAU( NMAX ), VL( NMAX, NMAX ),
80 $ VR( NMAX, NMAX ), W( LW ), WI( NMAX ),
81 $ WR( NMAX )
82* ..
83* .. External Functions ..
84 LOGICAL LSAMEN
85 EXTERNAL lsamen
86* ..
87* .. External Subroutines ..
88 EXTERNAL chkxer, dgebak, dgebal, dgehrd, dhsein, dhseqr,
89 $ dorghr, dormhr, dtrevc
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 wi( j ) = dble( j )
116 sel( j ) = .true.
117 20 CONTINUE
118 ok = .true.
119 nt = 0
120*
121* Test error exits of the nonsymmetric eigenvalue routines.
122*
123 IF( lsamen( 2, c2, 'HS' ) ) THEN
124*
125* DGEBAL
126*
127 srnamt = 'DGEBAL'
128 infot = 1
129 CALL dgebal( '/', 0, a, 1, ilo, ihi, s, info )
130 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
131 infot = 2
132 CALL dgebal( 'N', -1, a, 1, ilo, ihi, s, info )
133 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
134 infot = 4
135 CALL dgebal( 'N', 2, a, 1, ilo, ihi, s, info )
136 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
137 nt = nt + 3
138*
139* DGEBAK
140*
141 srnamt = 'DGEBAK'
142 infot = 1
143 CALL dgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
144 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
145 infot = 2
146 CALL dgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
147 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
148 infot = 3
149 CALL dgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
150 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
151 infot = 4
152 CALL dgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
153 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
154 infot = 4
155 CALL dgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
156 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
157 infot = 5
158 CALL dgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
159 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
160 infot = 5
161 CALL dgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
162 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
163 infot = 7
164 CALL dgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
165 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
166 infot = 9
167 CALL dgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
168 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
169 nt = nt + 9
170*
171* DGEHRD
172*
173 srnamt = 'DGEHRD'
174 infot = 1
175 CALL dgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
176 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
177 infot = 2
178 CALL dgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
179 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
180 infot = 2
181 CALL dgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
182 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
183 infot = 3
184 CALL dgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
185 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
186 infot = 3
187 CALL dgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
188 CALL chkxer( 'dgehrd', INFOT, NOUT, LERR, OK )
189 INFOT = 5
190 CALL DGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO )
191 CALL CHKXER( 'dgehrd', INFOT, NOUT, LERR, OK )
192 INFOT = 8
193 CALL DGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO )
194 CALL CHKXER( 'dgehrd', INFOT, NOUT, LERR, OK )
195 NT = NT + 7
196*
197* DORGHR
198*
199 SRNAMT = 'dorghr'
200 INFOT = 1
201 CALL DORGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO )
202 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
203 INFOT = 2
204 CALL DORGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO )
205 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
206 INFOT = 2
207 CALL DORGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO )
208 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
209 INFOT = 3
210 CALL DORGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO )
211 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
212 INFOT = 3
213 CALL DORGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO )
214 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
215 INFOT = 5
216 CALL DORGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO )
217 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
218 INFOT = 8
219 CALL DORGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO )
220 CALL CHKXER( 'dorghr', INFOT, NOUT, LERR, OK )
221 NT = NT + 7
222*
223* DORMHR
224*
225 SRNAMT = 'dormhr'
226 INFOT = 1
227 CALL DORMHR( '/', 'n', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
228 $ INFO )
229 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
230 INFOT = 2
231 CALL DORMHR( 'l', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
232 $ INFO )
233 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
234 INFOT = 3
235 CALL DORMHR( 'l', 'n', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
236 $ INFO )
237 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
238 INFOT = 4
239 CALL DORMHR( 'l', 'n', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1,
240 $ INFO )
241 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
242 INFOT = 5
243 CALL DORMHR( 'l', 'n', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1,
244 $ INFO )
245 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
246 INFOT = 5
247 CALL DORMHR( 'l', 'n', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1,
248 $ INFO )
249 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
250 INFOT = 5
251 CALL DORMHR( 'l', 'n', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2,
252 $ INFO )
253 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
254 INFOT = 5
255 CALL DORMHR( 'r', 'n', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2,
256 $ INFO )
257 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
258 INFOT = 6
259 CALL DORMHR( 'l', 'n', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1,
260 $ INFO )
261 CALL CHKXER( 'dormhr', infot, nout, lerr, ok )
262 infot = 6
263 CALL dormhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
264 $ info )
265 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
266 infot = 6
267 CALL dormhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
268 $ info )
269 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
270 infot = 8
271 CALL dormhr( 'l', 'n', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
272 $ INFO )
273 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
274 INFOT = 8
275 CALL DORMHR( 'r', 'n', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
276 $ INFO )
277 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
278 INFOT = 11
279 CALL DORMHR( 'l', 'n', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1,
280 $ INFO )
281 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
282 INFOT = 13
283 CALL DORMHR( 'l', 'n', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
284 $ INFO )
285 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
286 INFOT = 13
287 CALL DORMHR( 'r', 'n', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
288 $ INFO )
289 CALL CHKXER( 'dormhr', INFOT, NOUT, LERR, OK )
290 NT = NT + 16
291*
292* DHSEQR
293*
294 SRNAMT = 'dhseqr'
295 INFOT = 1
296 CALL DHSEQR( '/', 'n', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1,
297 $ INFO )
298 CALL CHKXER( 'dhseqr', INFOT, NOUT, LERR, OK )
299 INFOT = 2
300 CALL DHSEQR( 'e', '/', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1,
301 $ INFO )
302 CALL CHKXER( 'dhseqr', INFOT, NOUT, LERR, OK )
303 INFOT = 3
304 CALL DHSEQR( 'e', 'n', -1, 1, 0, A, 1, WR, WI, C, 1, W, 1,
305 $ INFO )
306 CALL CHKXER( 'dhseqr', INFOT, NOUT, LERR, OK )
307 INFOT = 4
308 CALL DHSEQR( 'e', 'n', 0, 0, 0, A, 1, WR, WI, C, 1, W, 1,
309 $ INFO )
310 CALL CHKXER( 'dhseqr', INFOT, NOUT, LERR, OK )
311 INFOT = 4
312 CALL DHSEQR( 'e', 'n', 0, 2, 0, A, 1, WR, WI, C, 1, W, 1,
313 $ INFO )
314 CALL CHKXER( 'dhseqr', INFOT, NOUT, LERR, OK )
315 INFOT = 5
316 CALL DHSEQR( 'e', 'n', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
317 $ info )
318 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
319 infot = 5
320 CALL dhseqr( 'E', 'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
321 $ info )
322 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
323 infot = 7
324 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
325 $ info )
326 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
327 infot = 11
328 CALL dhseqr( 'E', 'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
329 $ info )
330 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
331 nt = nt + 9
332*
333* DHSEIN
334*
335 srnamt = 'DHSEIN'
336 infot = 1
337 CALL dhsein( '/', 'N', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
338 $ 0, m, w, ifaill, ifailr, info )
339 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
340 infot = 2
341 CALL dhsein( 'R', '/', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
342 $ 0, m, w, ifaill, ifailr, info )
343 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
344 infot = 3
345 CALL dhsein( 'R', 'N', '/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
346 $ 0, m, w, ifaill, ifailr, info )
347 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
348 infot = 5
349 CALL dhsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
350 $ 1, 0, m, w, ifaill, ifailr, info )
351 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
352 infot = 7
353 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
354 $ 4, m, w, ifaill, ifailr, info )
355 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
356 infot = 11
357 CALL dhsein( 'L', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
358 $ 4, m, w, ifaill, ifailr, info )
359 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
360 infot = 13
361 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
362 $ 4, m, w, ifaill, ifailr, info )
363 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
364 infot = 14
365 CALL dhsein( 'R', 'N', 'n', SEL, 2, A, 2, WR, WI, VL, 1, VR, 2,
366 $ 1, M, W, IFAILL, IFAILR, INFO )
367 CALL CHKXER( 'dhsein', INFOT, NOUT, LERR, OK )
368 NT = NT + 8
369*
370* DTREVC
371*
372 SRNAMT = 'dtrevc'
373 INFOT = 1
374 CALL DTREVC( '/', 'a', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W,
375 $ INFO )
376 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
377 INFOT = 2
378 CALL DTREVC( 'l', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W,
379 $ INFO )
380 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
381 INFOT = 4
382 CALL DTREVC( 'l', 'a', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W,
383 $ INFO )
384 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
385 INFOT = 6
386 CALL DTREVC( 'l', 'a', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W,
387 $ INFO )
388 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
389 INFOT = 8
390 CALL DTREVC( 'l', 'a', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W,
391 $ INFO )
392 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
393 INFOT = 10
394 CALL DTREVC( 'r', 'a', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W,
395 $ INFO )
396 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
397 INFOT = 11
398 CALL DTREVC( 'l', 'a', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W,
399 $ INFO )
400 CALL CHKXER( 'dtrevc', INFOT, NOUT, LERR, OK )
401 NT = NT + 7
402 END IF
403*
404* Print a summary line.
405*
406 IF( OK ) THEN
407 WRITE( NOUT, FMT = 9999 )PATH, NT
408 ELSE
409 WRITE( NOUT, FMT = 9998 )PATH
410 END IF
411*
412 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
413 $ ' (', I3, ' tests done)' )
414 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
415 $ 'exits ***' )
416*
417 RETURN
418*
419* End of DERRHS
420*
421 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
dgehrd
subroutine dgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
DGEHRD
Definition dgehrd.f:167
dgebal
subroutine dgebal(job, n, a, lda, ilo, ihi, scale, info)
DGEBAL
Definition dgebal.f:160
dgebak
subroutine dgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
DGEBAK
Definition dgebak.f:130
dormhr
subroutine dormhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
DORMHR
Definition dormhr.f:178
dhseqr
subroutine dhseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
DHSEQR
Definition dhseqr.f:316
dhsein
subroutine dhsein(side, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr, info)
DHSEIN
Definition dhsein.f:263
dtrevc
subroutine dtrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
DTREVC
Definition dtrevc.f:222
dorghr
subroutine dorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
DORGHR
Definition dorghr.f:126
derrhs
subroutine derrhs(path, nunit)
DERRHS
Definition derrhs.f:55