36
37
38
40 USE elbufdef_mod
41
42
43
44#include "implicit_f.inc"
45
46
47
48#include "com01_c.inc"
49#include "param_c.inc"
50
51
52
53 INTEGER II, IGROU, IELN, IERR, IX(4), IXQ(NIXQ),IPARG(NPARG,*)
54
56 . dist,
area, tstif, t, vol, x(3,*), pm(npropm,*)
57 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
58
59
60
61 INTEGER I, N1, N2, N3, N4, IE, NG,MAT, IFA
63 . y1, y2, z1, z2,ny, nz, dy, dz,
norm,cond
64 INTEGER :: LLT ,NFT ,MTN ,IAD ,ITY ,NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,JTHE ,JLAG , ,JHBE
65 INTEGER :: JIVF, NVAUX, JPOR, JCVT, JCLOSE, JPLASOL, IREP, IINT, IGTYP
66 INTEGER :: ISORTH, ISORTHG, ISRAT, ISROT, ICSEN, IFAILURE, JSMS
67
68
69 ierr = 0
70
71
72
73 DO 200 ng=1,ngroup
75 2 mtn ,llt ,nft ,iad ,ity ,
76 3 npt ,jale ,ismstr ,jeul ,jtur ,
77 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
78 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
79 6 irep ,iint ,igtyp ,israt ,isrot ,
80 7 icsen ,isorth ,isorthg ,ifailure,jsms )
81 IF(ity/=2) GO TO 200
82 IF(ii>nft+llt) GO TO 200
83 IF(iparg(8,ng)==1.OR.jthe/=1)THEN
84 ierr = 1
85 RETURN
86 ENDIF
87 i = ii - nft
88 GOTO 250
89 200 CONTINUE
90 ierr = 1
91 RETURN
92 250 CONTINUE
93
94 igrou = ng
95 ieln = i
96 vol = elbuf_tab(ng)%GBUF%VOL(i)
97
98
99
100 n1=ix(1)
101 n2=ix(2)
102
103 y1=x(2,n1)
104 z1=x(3,n1)
105
106 y2=x(2,n2)
107 z2=x(3,n2)
108
109
110
111
112 ny= (z2-z1)
113 nz=-(y2-y1)
114 norm = sqrt(ny**2 + nz**2)
115
116
117
118 dy = two*(y1 + y2)
119 . -x(2,ixq(2))-x(2,ixq(3))
120 . -x(2,ixq(4))-x(2,ixq(5))
121
122 dz = two*(z1 + z2)
123 . -x(3,ixq(2))-x(3,ixq(3))
124 . -x(3,ixq(4))-x(3,ixq(5))
125
126
127
128 dist = fourth*(dy*ny+dz*nz) /
max(em15,
norm)
130
131
132
133 t = elbuf_tab(ng)%GBUF%TEMP(i)
134 mat =ixq(1)
135 IF(t<=pm(80,mat))THEN
136 cond=pm(75,mat)+pm(76,mat)*t
137 ELSE
138 cond=pm(77,mat)+pm(78,mat)*t
139 ENDIF
140 tstif = dist / cond
141
142 600 CONTINUE
143
144 RETURN
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)