OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dget37.f
Go to the documentation of this file.
1*> \brief \b DGET37
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 DGET37( RMAX, LMAX, NINFO, KNT, NIN )
12*
13* .. Scalar Arguments ..
14* INTEGER KNT, NIN
15* ..
16* .. Array Arguments ..
17* INTEGER LMAX( 3 ), NINFO( 3 )
18* DOUBLE PRECISION RMAX( 3 )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> DGET37 tests DTRSNA, a routine for estimating condition numbers of
28*> eigenvalues and/or right eigenvectors of a matrix.
29*>
30*> The test matrices are read from a file with logical unit number NIN.
31*> \endverbatim
32*
33* Arguments:
34* ==========
35*
36*> \param[out] RMAX
37*> \verbatim
38*> RMAX is DOUBLE PRECISION array, dimension (3)
39*> Value of the largest test ratio.
40*> RMAX(1) = largest ratio comparing different calls to DTRSNA
41*> RMAX(2) = largest error in reciprocal condition
42*> numbers taking their conditioning into account
43*> RMAX(3) = largest error in reciprocal condition
44*> numbers not taking their conditioning into
45*> account (may be larger than RMAX(2))
46*> \endverbatim
47*>
48*> \param[out] LMAX
49*> \verbatim
50*> LMAX is INTEGER array, dimension (3)
51*> LMAX(i) is example number where largest test ratio
52*> RMAX(i) is achieved. Also:
53*> If DGEHRD returns INFO nonzero on example i, LMAX(1)=i
54*> If DHSEQR returns INFO nonzero on example i, LMAX(2)=i
55*> If DTRSNA returns INFO nonzero on example i, LMAX(3)=i
56*> \endverbatim
57*>
58*> \param[out] NINFO
59*> \verbatim
60*> NINFO is INTEGER array, dimension (3)
61*> NINFO(1) = No. of times DGEHRD returned INFO nonzero
62*> NINFO(2) = No. of times DHSEQR returned INFO nonzero
63*> NINFO(3) = No. of times DTRSNA returned INFO nonzero
64*> \endverbatim
65*>
66*> \param[out] KNT
67*> \verbatim
68*> KNT is INTEGER
69*> Total number of examples tested.
70*> \endverbatim
71*>
72*> \param[in] NIN
73*> \verbatim
74*> NIN is INTEGER
75*> Input logical unit number
76*> \endverbatim
77*
78* Authors:
79* ========
80*
81*> \author Univ. of Tennessee
82*> \author Univ. of California Berkeley
83*> \author Univ. of Colorado Denver
84*> \author NAG Ltd.
85*
86*> \ingroup double_eig
87*
88* =====================================================================
89 SUBROUTINE dget37( RMAX, LMAX, NINFO, KNT, NIN )
90*
91* -- LAPACK test routine --
92* -- LAPACK is a software package provided by Univ. of Tennessee, --
93* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*
95* .. Scalar Arguments ..
96 INTEGER KNT, NIN
97* ..
98* .. Array Arguments ..
99 INTEGER LMAX( 3 ), NINFO( 3 )
100 DOUBLE PRECISION RMAX( 3 )
101* ..
102*
103* =====================================================================
104*
105* .. Parameters ..
106 DOUBLE PRECISION ZERO, ONE, TWO
107 parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0 )
108 DOUBLE PRECISION EPSIN
109 parameter( epsin = 5.9605d-8 )
110 INTEGER LDT, LWORK
111 parameter( ldt = 20, lwork = 2*ldt*( 10+ldt ) )
112* ..
113* .. Local Scalars ..
114 INTEGER I, ICMP, IFND, INFO, ISCL, J, KMIN, M, N
115 DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TNRM, TOL, TOLIN, V,
116 $ VIMIN, VMAX, VMUL, VRMIN
117* ..
118* .. Local Arrays ..
119 LOGICAL SELECT( LDT )
120 INTEGER IWORK( 2*LDT ), LCMP( 3 )
121 DOUBLE PRECISION DUM( 1 ), LE( LDT, LDT ), RE( LDT, LDT ),
122 $ S( LDT ), SEP( LDT ), SEPIN( LDT ),
123 $ SEPTMP( LDT ), SIN( LDT ), STMP( LDT ),
124 $ T( LDT, LDT ), TMP( LDT, LDT ), VAL( 3 ),
125 $ WI( LDT ), WIIN( LDT ), WITMP( LDT ),
126 $ WORK( LWORK ), WR( LDT ), WRIN( LDT ),
127 $ WRTMP( LDT )
128* ..
129* .. External Functions ..
130 DOUBLE PRECISION DLAMCH, DLANGE
131 EXTERNAL dlamch, dlange
132* ..
133* .. External Subroutines ..
134 EXTERNAL dcopy, dgehrd, dhseqr, dlabad, dlacpy, dscal,
135 $ dtrevc, dtrsna
136* ..
137* .. Intrinsic Functions ..
138 INTRINSIC dble, max, sqrt
139* ..
140* .. Executable Statements ..
141*
142 eps = dlamch( 'P' )
143 smlnum = dlamch( 's' ) / EPS
144 BIGNUM = ONE / SMLNUM
145 CALL DLABAD( SMLNUM, BIGNUM )
146*
147* EPSIN = 2**(-24) = precision to which input data computed
148*
149 EPS = MAX( EPS, EPSIN )
150 RMAX( 1 ) = ZERO
151 RMAX( 2 ) = ZERO
152 RMAX( 3 ) = ZERO
153 LMAX( 1 ) = 0
154 LMAX( 2 ) = 0
155 LMAX( 3 ) = 0
156 KNT = 0
157 NINFO( 1 ) = 0
158 NINFO( 2 ) = 0
159 NINFO( 3 ) = 0
160*
161 VAL( 1 ) = SQRT( SMLNUM )
162 VAL( 2 ) = ONE
163 VAL( 3 ) = SQRT( BIGNUM )
164*
165* Read input data until N=0. Assume input eigenvalues are sorted
166* lexicographically (increasing by real part, then decreasing by
167* imaginary part)
168*
169 10 CONTINUE
170 READ( NIN, FMT = * )N
171.EQ. IF( N0 )
172 $ RETURN
173 DO 20 I = 1, N
174 READ( NIN, FMT = * )( TMP( I, J ), J = 1, N )
175 20 CONTINUE
176 DO 30 I = 1, N
177 READ( NIN, FMT = * )WRIN( I ), WIIN( I ), SIN( I ), SEPIN( I )
178 30 CONTINUE
179 TNRM = DLANGE( 'm', N, N, TMP, LDT, WORK )
180*
181* Begin test
182*
183 DO 240 ISCL = 1, 3
184*
185* Scale input matrix
186*
187 KNT = KNT + 1
188 CALL DLACPY( 'f', N, N, TMP, LDT, T, LDT )
189 VMUL = VAL( ISCL )
190 DO 40 I = 1, N
191 CALL DSCAL( N, VMUL, T( 1, I ), 1 )
192 40 CONTINUE
193.EQ. IF( TNRMZERO )
194 $ VMUL = ONE
195*
196* Compute eigenvalues and eigenvectors
197*
198 CALL DGEHRD( N, 1, N, T, LDT, WORK( 1 ), WORK( N+1 ), LWORK-N,
199 $ INFO )
200.NE. IF( INFO0 ) THEN
201 LMAX( 1 ) = KNT
202 NINFO( 1 ) = NINFO( 1 ) + 1
203 GO TO 240
204 END IF
205 DO 60 J = 1, N - 2
206 DO 50 I = J + 2, N
207 T( I, J ) = ZERO
208 50 CONTINUE
209 60 CONTINUE
210*
211* Compute Schur form
212*
213 CALL DHSEQR( 's', 'n', N, 1, N, T, LDT, WR, WI, DUM, 1, WORK,
214 $ LWORK, INFO )
215.NE. IF( INFO0 ) THEN
216 LMAX( 2 ) = KNT
217 NINFO( 2 ) = NINFO( 2 ) + 1
218 GO TO 240
219 END IF
220*
221* Compute eigenvectors
222*
223 CALL DTREVC( 'both', 'all', SELECT, N, T, LDT, LE, LDT, RE,
224 $ LDT, N, M, WORK, INFO )
225*
226* Compute condition numbers
227*
228 CALL DTRSNA( 'both', 'all', SELECT, N, T, LDT, LE, LDT, RE,
229 $ LDT, S, SEP, N, M, WORK, N, IWORK, INFO )
230.NE. IF( INFO0 ) THEN
231 LMAX( 3 ) = KNT
232 NINFO( 3 ) = NINFO( 3 ) + 1
233 GO TO 240
234 END IF
235*
236* Sort eigenvalues and condition numbers lexicographically
237* to compare with inputs
238*
239 CALL DCOPY( N, WR, 1, WRTMP, 1 )
240 CALL DCOPY( N, WI, 1, WITMP, 1 )
241 CALL DCOPY( N, S, 1, STMP, 1 )
242 CALL DCOPY( N, SEP, 1, SEPTMP, 1 )
243 CALL DSCAL( N, ONE / VMUL, SEPTMP, 1 )
244 DO 80 I = 1, N - 1
245 KMIN = I
246 VRMIN = WRTMP( I )
247 VIMIN = WITMP( I )
248 DO 70 J = I + 1, N
249.LT. IF( WRTMP( J )VRMIN ) THEN
250 KMIN = J
251 VRMIN = WRTMP( J )
252 VIMIN = WITMP( J )
253 END IF
254 70 CONTINUE
255 WRTMP( KMIN ) = WRTMP( I )
256 WITMP( KMIN ) = WITMP( I )
257 WRTMP( I ) = VRMIN
258 WITMP( I ) = VIMIN
259 VRMIN = STMP( KMIN )
260 STMP( KMIN ) = STMP( I )
261 STMP( I ) = VRMIN
262 VRMIN = SEPTMP( KMIN )
263 SEPTMP( KMIN ) = SEPTMP( I )
264 SEPTMP( I ) = VRMIN
265 80 CONTINUE
266*
267* Compare condition numbers for eigenvalues
268* taking their condition numbers into account
269*
270 V = MAX( TWO*DBLE( N )*EPS*TNRM, SMLNUM )
271.EQ. IF( TNRMZERO )
272 $ V = ONE
273 DO 90 I = 1, N
274.GT. IF( VSEPTMP( I ) ) THEN
275 TOL = ONE
276 ELSE
277 TOL = V / SEPTMP( I )
278 END IF
279.GT. IF( VSEPIN( I ) ) THEN
280 TOLIN = ONE
281 ELSE
282 TOLIN = V / SEPIN( I )
283 END IF
284 TOL = MAX( TOL, SMLNUM / EPS )
285 TOLIN = MAX( TOLIN, SMLNUM / EPS )
286.GT. IF( EPS*( SIN( I )-TOLIN )STMP( I )+TOL ) THEN
287 VMAX = ONE / EPS
288.GT. ELSE IF( SIN( I )-TOLINSTMP( I )+TOL ) THEN
289 VMAX = ( SIN( I )-TOLIN ) / ( STMP( I )+TOL )
290.LT. ELSE IF( SIN( I )+TOLINEPS*( STMP( I )-TOL ) ) THEN
291 VMAX = ONE / EPS
292.LT. ELSE IF( SIN( I )+TOLINSTMP( I )-TOL ) THEN
293 VMAX = ( STMP( I )-TOL ) / ( SIN( I )+TOLIN )
294 ELSE
295 VMAX = ONE
296 END IF
297.GT. IF( VMAXRMAX( 2 ) ) THEN
298 RMAX( 2 ) = VMAX
299.EQ. IF( NINFO( 2 )0 )
300 $ LMAX( 2 ) = KNT
301 END IF
302 90 CONTINUE
303*
304* Compare condition numbers for eigenvectors
305* taking their condition numbers into account
306*
307 DO 100 I = 1, N
308.GT. IF( VSEPTMP( I )*STMP( I ) ) THEN
309 TOL = SEPTMP( I )
310 ELSE
311 TOL = V / STMP( I )
312 END IF
313.GT. IF( VSEPIN( I )*SIN( I ) ) THEN
314 TOLIN = SEPIN( I )
315 ELSE
316 TOLIN = V / SIN( I )
317 END IF
318 TOL = MAX( TOL, SMLNUM / EPS )
319 TOLIN = MAX( TOLIN, SMLNUM / EPS )
320.GT. IF( EPS*( SEPIN( I )-TOLIN )SEPTMP( I )+TOL ) THEN
321 VMAX = ONE / EPS
322.GT. ELSE IF( SEPIN( I )-TOLINSEPTMP( I )+TOL ) THEN
323 VMAX = ( SEPIN( I )-TOLIN ) / ( SEPTMP( I )+TOL )
324.LT. ELSE IF( SEPIN( I )+TOLINEPS*( SEPTMP( I )-TOL ) ) THEN
325 VMAX = ONE / EPS
326.LT. ELSE IF( SEPIN( I )+TOLINSEPTMP( I )-TOL ) THEN
327 VMAX = ( SEPTMP( I )-TOL ) / ( SEPIN( I )+TOLIN )
328 ELSE
329 VMAX = ONE
330 END IF
331.GT. IF( VMAXRMAX( 2 ) ) THEN
332 RMAX( 2 ) = VMAX
333.EQ. IF( NINFO( 2 )0 )
334 $ LMAX( 2 ) = KNT
335 END IF
336 100 CONTINUE
337*
338* Compare condition numbers for eigenvalues
339* without taking their condition numbers into account
340*
341 DO 110 I = 1, N
342.LE..AND..LE. IF( SIN( I )DBLE( 2*N )*EPS STMP( I )
343 $ DBLE( 2*N )*EPS ) THEN
344 VMAX = ONE
345.GT. ELSE IF( EPS*SIN( I )STMP( I ) ) THEN
346 VMAX = ONE / EPS
347.GT. ELSE IF( SIN( I )STMP( I ) ) THEN
348 VMAX = SIN( I ) / STMP( I )
349.LT. ELSE IF( SIN( I )EPS*STMP( I ) ) THEN
350 VMAX = ONE / EPS
351.LT. ELSE IF( SIN( I )STMP( I ) ) THEN
352 VMAX = STMP( I ) / SIN( I )
353 ELSE
354 VMAX = ONE
355 END IF
356.GT. IF( VMAXRMAX( 3 ) ) THEN
357 RMAX( 3 ) = VMAX
358.EQ. IF( NINFO( 3 )0 )
359 $ LMAX( 3 ) = KNT
360 END IF
361 110 CONTINUE
362*
363* Compare condition numbers for eigenvectors
364* without taking their condition numbers into account
365*
366 DO 120 I = 1, N
367.LE..AND..LE. IF( SEPIN( I )V SEPTMP( I )V ) THEN
368 VMAX = ONE
369.GT. ELSE IF( EPS*SEPIN( I )SEPTMP( I ) ) THEN
370 VMAX = ONE / EPS
371.GT. ELSE IF( SEPIN( I )SEPTMP( I ) ) THEN
372 VMAX = SEPIN( I ) / SEPTMP( I )
373.LT. ELSE IF( SEPIN( I )EPS*SEPTMP( I ) ) THEN
374 VMAX = ONE / EPS
375.LT. ELSE IF( SEPIN( I )SEPTMP( I ) ) THEN
376 VMAX = SEPTMP( I ) / SEPIN( I )
377 ELSE
378 VMAX = ONE
379 END IF
380.GT. IF( VMAXRMAX( 3 ) ) THEN
381 RMAX( 3 ) = VMAX
382.EQ. IF( NINFO( 3 )0 )
383 $ LMAX( 3 ) = KNT
384 END IF
385 120 CONTINUE
386*
387* Compute eigenvalue condition numbers only and compare
388*
389 VMAX = ZERO
390 DUM( 1 ) = -ONE
391 CALL DCOPY( N, DUM, 0, STMP, 1 )
392 CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
393 CALL DTRSNA( 'eigcond', 'all', SELECT, N, T, LDT, LE, LDT, RE,
394 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
395.NE. IF( INFO0 ) THEN
396 LMAX( 3 ) = KNT
397 NINFO( 3 ) = NINFO( 3 ) + 1
398 GO TO 240
399 END IF
400 DO 130 I = 1, N
401.NE. IF( STMP( I )S( I ) )
402 $ VMAX = ONE / EPS
403.NE. IF( SEPTMP( I )DUM( 1 ) )
404 $ VMAX = ONE / EPS
405 130 CONTINUE
406*
407* Compute eigenvector condition numbers only and compare
408*
409 CALL DCOPY( N, DUM, 0, STMP, 1 )
410 CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
411 CALL DTRSNA( 'veccond', 'all', SELECT, N, T, LDT, LE, LDT, RE,
412 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
413.NE. IF( INFO0 ) THEN
414 LMAX( 3 ) = KNT
415 NINFO( 3 ) = NINFO( 3 ) + 1
416 GO TO 240
417 END IF
418 DO 140 I = 1, N
419.NE. IF( STMP( I )DUM( 1 ) )
420 $ VMAX = ONE / EPS
421.NE. IF( SEPTMP( I )SEP( I ) )
422 $ VMAX = ONE / EPS
423 140 CONTINUE
424*
425* Compute all condition numbers using SELECT and compare
426*
427 DO 150 I = 1, N
428 SELECT( I ) = .TRUE.
429 150 CONTINUE
430 CALL DCOPY( N, DUM, 0, STMP, 1 )
431 CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
432 CALL DTRSNA( 'bothcond', 'some', SELECT, N, T, LDT, LE, LDT,
433 $ RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK,
434 $ INFO )
435.NE. IF( INFO0 ) THEN
436 LMAX( 3 ) = KNT
437 NINFO( 3 ) = NINFO( 3 ) + 1
438 GO TO 240
439 END IF
440 DO 160 I = 1, N
441.NE. IF( SEPTMP( I )SEP( I ) )
442 $ VMAX = ONE / EPS
443.NE. IF( STMP( I )S( I ) )
444 $ VMAX = ONE / EPS
445 160 CONTINUE
446*
447* Compute eigenvalue condition numbers using SELECT and compare
448*
449 CALL DCOPY( N, DUM, 0, STMP, 1 )
450 CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
451 CALL DTRSNA( 'eigcond', 'some', SELECT, N, T, LDT, LE, LDT, RE,
452 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
453.NE. IF( INFO0 ) THEN
454 LMAX( 3 ) = KNT
455 NINFO( 3 ) = NINFO( 3 ) + 1
456 GO TO 240
457 END IF
458 DO 170 I = 1, N
459.NE. IF( STMP( I )S( I ) )
460 $ VMAX = ONE / EPS
461.NE. IF( SEPTMP( I )DUM( 1 ) )
462 $ VMAX = ONE / EPS
463 170 CONTINUE
464*
465* Compute eigenvector condition numbers using SELECT and compare
466*
467 CALL DCOPY( N, DUM, 0, STMP, 1 )
468 CALL DCOPY( N, DUM, 0, SEPTMP, 1 )
469 CALL DTRSNA( 'veccond', 'some', SELECT, N, T, LDT, LE, LDT, RE,
470 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
471.NE. IF( INFO0 ) THEN
472 LMAX( 3 ) = KNT
473 NINFO( 3 ) = NINFO( 3 ) + 1
474 GO TO 240
475 END IF
476 DO 180 I = 1, N
477.NE. IF( STMP( I )DUM( 1 ) )
478 $ VMAX = ONE / EPS
479.NE. IF( SEPTMP( I )SEP( I ) )
480 $ VMAX = ONE / EPS
481 180 CONTINUE
482.GT. IF( VMAXRMAX( 1 ) ) THEN
483 RMAX( 1 ) = VMAX
484.EQ. IF( NINFO( 1 )0 )
485 $ LMAX( 1 ) = KNT
486 END IF
487*
488* Select first real and first complex eigenvalue
489*
490.EQ. IF( WI( 1 )ZERO ) THEN
491 LCMP( 1 ) = 1
492 IFND = 0
493 DO 190 I = 2, N
494.EQ..OR..EQ. IF( IFND1 WI( I )ZERO ) THEN
495 SELECT( I ) = .FALSE.
496 ELSE
497 IFND = 1
498 LCMP( 2 ) = I
499 LCMP( 3 ) = I + 1
500 CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 2 ), 1 )
501 CALL DCOPY( N, RE( 1, I+1 ), 1, RE( 1, 3 ), 1 )
502 CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 2 ), 1 )
503 CALL DCOPY( N, LE( 1, I+1 ), 1, LE( 1, 3 ), 1 )
504 END IF
505 190 CONTINUE
506.EQ. IF( IFND0 ) THEN
507 ICMP = 1
508 ELSE
509 ICMP = 3
510 END IF
511 ELSE
512 LCMP( 1 ) = 1
513 LCMP( 2 ) = 2
514 IFND = 0
515 DO 200 I = 3, N
516.EQ..OR..NE. IF( IFND1 WI( I )ZERO ) THEN
517 SELECT( I ) = .FALSE.
518 ELSE
519 LCMP( 3 ) = I
520 IFND = 1
521 CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 3 ), 1 )
522 CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 3 ), 1 )
523 END IF
524 200 CONTINUE
525.EQ. IF( IFND0 ) THEN
526 ICMP = 2
527 ELSE
528 ICMP = 3
529 END IF
530 END IF
531*
532* Compute all selected condition numbers
533*
534 CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
535 CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
536 CALL DTRSNA( 'bothcond', 'some', SELECT, N, T, LDT, LE, LDT,
537 $ RE, LDT, STMP, SEPTMP, N, M, WORK, N, IWORK,
538 $ INFO )
539.NE. IF( INFO0 ) THEN
540 LMAX( 3 ) = KNT
541 NINFO( 3 ) = NINFO( 3 ) + 1
542 GO TO 240
543 END IF
544 DO 210 I = 1, ICMP
545 J = LCMP( I )
546.NE. IF( SEPTMP( I )SEP( J ) )
547 $ VMAX = ONE / EPS
548.NE. IF( STMP( I )S( J ) )
549 $ VMAX = ONE / EPS
550 210 CONTINUE
551*
552* Compute selected eigenvalue condition numbers
553*
554 CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
555 CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
556 CALL DTRSNA( 'eigcond', 'some', SELECT, N, T, LDT, LE, LDT, RE,
557 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
558.NE. IF( INFO0 ) THEN
559 LMAX( 3 ) = KNT
560 NINFO( 3 ) = NINFO( 3 ) + 1
561 GO TO 240
562 END IF
563 DO 220 I = 1, ICMP
564 J = LCMP( I )
565.NE. IF( STMP( I )S( J ) )
566 $ VMAX = ONE / EPS
567.NE. IF( SEPTMP( I )DUM( 1 ) )
568 $ VMAX = ONE / EPS
569 220 CONTINUE
570*
571* Compute selected eigenvector condition numbers
572*
573 CALL DCOPY( ICMP, DUM, 0, STMP, 1 )
574 CALL DCOPY( ICMP, DUM, 0, SEPTMP, 1 )
575 CALL DTRSNA( 'veccond', 'some', SELECT, N, T, LDT, LE, LDT, RE,
576 $ LDT, STMP, SEPTMP, N, M, WORK, N, IWORK, INFO )
577.NE. IF( INFO0 ) THEN
578 LMAX( 3 ) = KNT
579 NINFO( 3 ) = NINFO( 3 ) + 1
580 GO TO 240
581 END IF
582 DO 230 I = 1, ICMP
583 J = LCMP( I )
584.NE. IF( STMP( I )DUM( 1 ) )
585 $ VMAX = ONE / EPS
586.NE. IF( SEPTMP( I )SEP( J ) )
587 $ VMAX = ONE / EPS
588 230 CONTINUE
589.GT. IF( VMAXRMAX( 1 ) ) THEN
590 RMAX( 1 ) = VMAX
591.EQ. IF( NINFO( 1 )0 )
592 $ LMAX( 1 ) = KNT
593 END IF
594 240 CONTINUE
595 GO TO 10
596*
597* End of DGET37
598*
599 END
subroutine eigcond(graphe, eigipm, eigrpm, ikc0, nddl0, k_diag, k_lt, iadk, jdik, ms, in, ndof, nddl, eigibuf, x, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, pm, geo, cont, icut, skew, xcut, fint, itab, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, dd_iad, fr_iad, dd_front, weight, eani, ipart, rby, nom_opt, igrsurf, bufsf, idata, rdata, bufmat, bufgeo, kxx, ixx, kxsp, ixsp, nod2sp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, iparg, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, nint2, iint2, ipari, intbuf_tab, d, lddl, partsav, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, weight_md, cluster, fcluster, mcluster, xfem_tab, w, nv46, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, drape_q4, drape_t3, h3d_data, subset, igrnod, fcont_max, fncontp2, ftcontp2, ale_connectivity)
Definition eigcond.F:68
subroutine dlabad(small, large)
DLABAD
Definition dlabad.f:74
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
Definition dlacpy.f:103
subroutine dgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
DGEHRD
Definition dgehrd.f:167
subroutine dtrsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, iwork, info)
DTRSNA
Definition dtrsna.f:265
subroutine dhseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
DHSEQR
Definition dhseqr.f:316
subroutine dtrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
DTREVC
Definition dtrevc.f:222
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
subroutine dget37(rmax, lmax, ninfo, knt, nin)
DGET37
Definition dget37.f:90
#define max(a, b)
Definition macros.h:21