89 SUBROUTINE dget37( RMAX, LMAX, NINFO, KNT, NIN )
99 INTEGER LMAX( 3 ), ( 3 )
100 DOUBLE PRECISION RMAX( 3 )
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 )
111 parameter( ldt = 20, lwork = 2*ldt*( 10+ldt ) )
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
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( ), SEPIN( LDT ),
123 $ SEPTMP( LDT ), SIN( LDT ), STMP( ),
124 $ T( LDT, LDT ), TMP( , LDT ), VAL( 3 ),
125 $ WI( LDT ), WIIN( LDT ), WITMP( LDT ),
126 $ WORK( LWORK ), WR( LDT ), WRIN( ),
130 DOUBLE PRECISION DLAMCH, DLANGE
131 EXTERNAL dlamch, dlange
138 INTRINSIC dble,
max, sqrt
143 smlnum = dlamch( 's
' ) / EPS
144 BIGNUM = ONE / SMLNUM
145 CALL DLABAD( SMLNUM, BIGNUM )
149 EPS = MAX( EPS, EPSIN )
161 VAL( 1 ) = SQRT( SMLNUM )
163 VAL( 3 ) = SQRT( BIGNUM )
170 READ( NIN, FMT = * )N
174 READ( NIN, FMT = * )( TMP( I, J ), J = 1, N )
177 READ( NIN, FMT = * )WRIN( I ), WIIN( I ), SIN( I ), SEPIN( I )
179 TNRM = DLANGE( 'm
', N, N, TMP, LDT, WORK )
188 CALL DLACPY( 'f
', N, N, TMP, LDT, T, LDT )
191 CALL DSCAL( N, VMUL, T( 1, I ), 1 )
198 CALL DGEHRD( N, 1, N, T, LDT, WORK( 1 ), WORK( N+1 ), LWORK-N,
202 NINFO( 1 ) = NINFO( 1 ) + 1
213 CALL DHSEQR( 's
', 'n
', N, 1, N, T, LDT, WR, WI, DUM, 1, WORK,
217 NINFO( 2 ) = NINFO( 2 ) + 1
223 CALL DTREVC( 'both
', 'all
', SELECT, N, T, LDT, LE, LDT, RE,
224 $ LDT, N, M, WORK, INFO )
228 CALL DTRSNA( 'both
', 'all
', SELECT, N, T, LDT, LE, LDT, RE,
229 $ LDT, S, SEP, N, M, WORK, N, IWORK, INFO )
232 NINFO( 3 ) = NINFO( 3 ) + 1
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 )
249.LT.
IF( WRTMP( J )VRMIN ) THEN
255 WRTMP( KMIN ) = WRTMP( I )
256 WITMP( KMIN ) = WITMP( I )
260 STMP( KMIN ) = STMP( I )
262 VRMIN = SEPTMP( KMIN )
263 SEPTMP( KMIN ) = SEPTMP( I )
270 V = MAX( TWO*DBLE( N )*EPS*TNRM, SMLNUM )
274.GT.
IF( VSEPTMP( I ) ) THEN
277 TOL = V / SEPTMP( I )
279.GT.
IF( VSEPIN( I ) ) THEN
282 TOLIN = V / SEPIN( I )
284 TOL = MAX( TOL, SMLNUM / EPS )
285 TOLIN = MAX( TOLIN, SMLNUM / EPS )
286.GT.
IF( EPS*( SIN( I )-TOLIN )STMP( I )+TOL ) THEN
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
292.LT.
ELSE IF( SIN( I )+TOLINSTMP( I )-TOL ) THEN
293 VMAX = ( STMP( I )-TOL ) / ( SIN( I )+TOLIN )
297.GT.
IF( VMAXRMAX( 2 ) ) THEN
299.EQ.
IF( NINFO( 2 )0 )
308.GT.
IF( VSEPTMP( I )*STMP( I ) ) THEN
313.GT.
IF( VSEPIN( I )*SIN( I ) ) THEN
318 TOL = MAX( TOL, SMLNUM / EPS )
319 TOLIN = MAX( TOLIN, SMLNUM / EPS )
320.GT.
IF( EPS*( SEPIN( I )-TOLIN )SEPTMP( I )+TOL ) THEN
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
326.LT.
ELSE IF( SEPIN( I )+TOLINSEPTMP( I )-TOL ) THEN
327 VMAX = ( SEPTMP( I )-TOL ) / ( SEPIN( I )+TOLIN )
331.GT.
IF( VMAXRMAX( 2 ) ) THEN
333.EQ.
IF( NINFO( 2 )0 )
342.LE..AND..LE.
IF( SIN( I )DBLE( 2*N )*EPS STMP( I )
343 $ DBLE( 2*N )*EPS ) THEN
345.GT.
ELSE IF( EPS*SIN( I )STMP( I ) ) THEN
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
351.LT.
ELSE IF( SIN( I )STMP( I ) ) THEN
352 VMAX = STMP( I ) / SIN( I )
356.GT.
IF( VMAXRMAX( 3 ) ) THEN
358.EQ.
IF( NINFO( 3 )0 )
367.LE..AND..LE.
IF( SEPIN( I )V SEPTMP( I )V ) THEN
369.GT.
ELSE IF( EPS*SEPIN( I )SEPTMP( I ) ) THEN
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
375.LT.
ELSE IF( SEPIN( I )SEPTMP( I ) ) THEN
376 VMAX = SEPTMP( I ) / SEPIN( I )
380.GT.
IF( VMAXRMAX( 3 ) ) THEN
382.EQ.
IF( NINFO( 3 )0 )
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 )
397 NINFO( 3 ) = NINFO( 3 ) + 1
401.NE.
IF( STMP( I )S( I ) )
403.NE.
IF( SEPTMP( I )DUM( 1 ) )
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 )
415 NINFO( 3 ) = NINFO( 3 ) + 1
419.NE.
IF( STMP( I )DUM( 1 ) )
421.NE.
IF( SEPTMP( I )SEP( I ) )
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,
437 NINFO( 3 ) = NINFO( 3 ) + 1
441.NE.
IF( SEPTMP( I )SEP( I ) )
443.NE.
IF( STMP( I )S( I ) )
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 )
455 NINFO( 3 ) = NINFO( 3 ) + 1
459.NE.
IF( STMP( I )S( I ) )
461.NE.
IF( SEPTMP( I )DUM( 1 ) )
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 )
473 NINFO( 3 ) = NINFO( 3 ) + 1
477.NE.
IF( STMP( I )DUM( 1 ) )
479.NE.
IF( SEPTMP( I )SEP( I ) )
482.GT.
IF( VMAXRMAX( 1 ) ) THEN
484.EQ.
IF( NINFO( 1 )0 )
490.EQ.
IF( WI( 1 )ZERO ) THEN
494.EQ..OR..EQ.
IF( IFND1 WI( I )ZERO ) THEN
495 SELECT( I ) = .FALSE.
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 )
516.EQ..OR..NE.
IF( IFND1 WI( I )ZERO ) THEN
517 SELECT( I ) = .FALSE.
521 CALL DCOPY( N, RE( 1, I ), 1, RE( 1, 3 ), 1 )
522 CALL DCOPY( N, LE( 1, I ), 1, LE( 1, 3 ), 1 )
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,
541 NINFO( 3 ) = NINFO( 3 ) + 1
546.NE.
IF( SEPTMP( I )SEP( J ) )
548.NE.
IF( STMP( I )S( J ) )
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 )
560 NINFO( 3 ) = NINFO( 3 ) + 1
565.NE.
IF( STMP( I )S( J ) )
567.NE.
IF( SEPTMP( I )DUM( 1 ) )
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 )
579 NINFO( 3 ) = NINFO( 3 ) + 1
584.NE.
IF( STMP( I )DUM( 1 ) )
586.NE.
IF( SEPTMP( I )SEP( J ) )
589.GT.
IF( VMAXRMAX( 1 ) ) THEN
591.EQ.
IF( NINFO( 1 )0 )
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)