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