37
38
39
41 USE elbufdef_mod
42
43
44
45#include "implicit_f.inc"
46
47
48
49#include "mvsiz_p.inc"
50
51
52
53#include "com_xfem1.inc"
54
55
56
57 INTEGER LFT,LLT,NFT,NXLAY
58 INTEGER IELCRKTG(*),EDGETG(3,*),IEDGESH3(3,*),(*),
59 . XNOD(2,2),IXTG(NIXTG,*),NODEDGE(2,*),TAGSKYTG(3,*),KNOD2ELC(*),
60 . TAGEDGE(*)
62 . x1l(*),y1l(*),x2l(*),y2l(*),x3l(*),y3l(*),beta0(2)
63
64 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
65 TYPE (ELBUF_STRUCT_), DIMENSION(NXEL) , TARGET :: XFEM_STR
66 TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
67 TYPE (XFEM_SHELL_) , DIMENSION(NLEVMAX) :: CRKSHELL
68 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX) :: CRKEDGE
69 TYPE (XFEM_PHANTOM_), DIMENSION(NXLAYMAX) :: XFEM_PHANTOM
70
71
72
73 INTEGER I,K,II,IL,ILAY,ELCRK,IED,ICUT,IEDGE,IC1,IC2,ICRK,p1,p2,
74 . NOD1,NOD2,JCRK,IXEL
75 INTEGER dd(3),d1(3),d2(3),IFI(2),ILEV(NXEL),N(3),ISIGN0(3),
76 . IENR0(3),IENR(3),NTAG(3)
78 . fit(3,mvsiz),xn(3),yn(3),xmi(2),ymi(2),beta(2,mvsiz),
79 . off_phantom
81 EXTERNAL lsintx
82 DATA dd/2,3,1/
83 DATA d1/2,3,4/
84 DATA d2/3,4,2/
85
86 TYPE(G_BUFEL_) , POINTER :: GBUF
87 TYPE(L_BUFEL_) , POINTER :: LBUF
88
89 p2 = 0
90 DO i=lft,llt
91 xn(1)=x1l(i)
92 yn(1)=y1l(i)
93 xn(2)=x2l(i)
94 yn(2)=y2l(i)
95 xn(3)=x3l(i)
96 yn(3)=y3l(i)
97 IF (elcut(i+nft) > 0) THEN
98 DO k=1,3
99 p1 = k
100 p2 = dd(k)
101 ied = edgetg(k,i+nft)
102 IF (ied > 0) THEN
103 xmi(ied) = half*(xn(p1) + xn(p2))
104 ymi(ied) = half*(yn(p1) + yn(p2))
105 ENDIF
106 ENDDO
107
108 DO k=1,3
109 fit(k,i) = lsintx(xmi(1),ymi(1),xmi(2),ymi(2),xn(k),yn(k))
110 ENDDO
111 ENDIF
112 ENDDO
113
114 DO i=lft,llt
115 elcrk = ielcrktg(i+nft)
116 beta(1,i) = zero
117 beta(2,i) = zero
118 IF(elcut(i+nft) > 0)THEN
119
120 jcrk = elcrk - ecrkxfec
121 DO k=1,3
122 iedge = iedgesh3(k,jcrk)
123 ied = edgetg(k,i+nft)
124 IF (ied > 0) THEN
125 nod1 = nodedge(1,iedge)
126 nod2 = nodedge(2,iedge)
127 IF (nod1 == xnod(ied,1) .and. nod2 == xnod(ied,2)) THEN
128 beta(ied,i) = beta0(ied)
129 ELSE IF (nod2 == xnod(ied,1) .and. nod1 == xnod(ied,2)) THEN
130 beta(ied,i) = one - beta0(ied)
131 END IF
132 ENDIF
133 ENDDO
134 ENDIF
135 ENDDO
136
137 DO ilay=1,nxlay
138 ii = nxel*(ilay-1)
139 DO k=1,nxel
140 ilev(k) = ii + k
141 ENDDO
142 DO i=lft,llt
143 elcrk = ielcrktg(i+nft)
144 jcrk = elcrk - ecrkxfec
145 IF (elcut(i+nft) > 0) THEN
146 icrk = crkshell(ilev(1))%PHANTOMG(elcrk)
147 crklvset(ilev(1))%ELCUT(elcrk) = icrk
148 crklvset(ilev(2))%ELCUT(elcrk) = -icrk
149
150 xfem_phantom(ilay)%ELCUT(elcrk) = icrk
151 crkedge(ilay)%LAYCUT(elcrk) = 2
152
153 n(1) = ixtg(2,i+nft)
154 n(2) = ixtg(3,i+nft)
155 n(3) = ixtg(4,i+nft)
156
157 isign0(1) = int(sign(one,fit(1,i))) * icrk
158 isign0(2) = int(sign(one,fit(2,i))) * icrk
159 isign0(3) = int(sign(one,fit(3,i))) * icrk
160
161 ntag(1:3) = 0
162
163 DO k=1,3
164 ienr0(k) = 0
165 ienr(k) = 0
166 ied = edgetg(k,i+nft)
167 IF (ied > 0) THEN
168 ntag(k) = ntag(k) + 1
169 ntag(dd(k)) = ntag(dd(k)) + 1
170 ENDIF
171 ENDDO
172
173 DO k=1,3
174 ied = edgetg(k,i+nft)
175 iedge = iedgesh3(k,jcrk)
176 IF(ied > 0)THEN
177 nod1 = nodedge(1,iedge)
178 nod2 = nodedge(2,iedge)
179 IF(nod1 == n(k) .and. nod2 == n(dd(k)))THEN
180 p1 = k
181 p2 = dd(k)
182 ELSE IF(nod2 == n(k) .and. nod1 == n(dd(k)THEN
183 p1 = dd(k)
184 p2 = k
185 END IF
186 IF(ntag(p1) > 0.AND.crkedge(ilay)%EDGEENR(1,iedge) > 0)
187 . ienr0(p1) = crkedge(ilay)%EDGEENR(1,iedge)
188 IF(ntag(p2) > 0.AND.crkedge(ilay)%EDGEENR(2,iedge) > 0)
189 . ienr0(p2) = crkedge(ilay)%EDGEENR(2,iedge)
190 ENDIF
191 ENDDO
192
193 DO k=1,3
194 IF(ienr0(k) /= 0)THEN
195 ienr(k) = ienr0(k)
196 ELSE
197 ienr(k) = tagskytg(k,i+nft)+knod2elc(n(k))*(ilay-1)
198 ENDIF
199 ENDDO
200
201 DO k=1,3
202 ied = edgetg(k,i+nft)
203 iedge = iedgesh3(k,jcrk)
204 IF(ied > 0)THEN
205 DO il=1,nxel
206 crklvset(ilev(il))%EDGETG(k,jcrk) = ied
207 crklvset(ilev(il))%ICUTEDGE(iedge) = 1
208 crklvset(ilev(il))%RATIOEDGE(iedge) = beta(ied,i)
209 ENDDO
210
211 crkedge(ilay)%EDGETIP(1,iedge) =
max(ied,
212 . crkedge(ilay)%EDGETIP(1,iedge))
213 crkedge(ilay)%EDGETIP(2,iedge) =
214 . crkedge(ilay)%EDGETIP(2,iedge) + 1
215
216
217
218 IF(crkedge(ilay)%EDGEICRK(iedge) == 0)
219 . crkedge(ilay)%EDGEICRK(iedge) = icrk
220
221 nod1 = nodedge(1,iedge)
222 nod2 = nodedge(2,iedge)
223 ifi(1:2) = 0
224 p1 = 0
225 p2 = 0
226 IF(nod1 == n(k) .and. nod2 == n(dd(k)))THEN
227 ifi(1) = isign0(k)
228 ifi(2) = isign0(dd(k))
229 p1 = k
230 p2 = dd(k)
231 ELSE IF(nod2 == n(k) .and. nod1 == n(dd(k)))THEN
232 ifi(1) = isign0(dd(k))
233 ifi(2) = isign0(k)
234 p1 = dd(k)
235 p2 = k
236 END IF
237 IF(crkedge(ilay)%EDGEIFI(1,iedge) == 0)
238 . crkedge(ilay)%EDGEIFI(1,iedge) = ifi(1)
239 IF(crkedge(ilay)%EDGEIFI(2,iedge) == 0)
240 . crkedge(ilay)%EDGEIFI(2,iedge) = ifi(2)
241
242 IF(crkedge(ilay)%EDGEENR(1,iedge) == 0)
243 . crkedge(ilay)%EDGEENR(1,iedge) = ienr(p1)
244
245 IF(crkedge(ilay)%EDGEENR(2,iedge) == 0)
246 . crkedge(ilay)%EDGEENR(2,iedge) = ienr(p2)
247 ENDIF
248 ENDDO
249 ENDIF
250 ENDDO
251 ENDDO
252
253
254
255 IF (nxlay > 1)THEN
256
257 DO ixel=1,2
258 DO ilay=1,nxlay
259 lbuf => xfem_str(ixel)%BUFLY(ilay)%LBUF(1,1,1)
260 DO i=lft,llt
261 IF(elcut(i+nft) > 0)THEN
262 off_phantom = lbuf%OFF(i)
263 lbuf%OFF(i) = - off_phantom
264 ENDIF
265 ENDDO
266 ENDDO
267 ENDDO
268 ELSE
269
270 DO ixel=1,2
271 gbuf => xfem_str(ixel
272 DO i=lft,llt
273 IF(elcut(i+nft) > 0)THEN
274 off_phantom = gbuf%OFF(i)
275 gbuf%OFF(i) = - off_phantom
276 ENDIF
277 ENDDO
278 ENDDO
279 ENDIF
280
281
282
283 DO i=lft,llt
284 IF(elcut(i+nft) > 0)THEN
285 elbuf_str%GBUF%OFF(i) = zero
286 ENDIF
287 ENDDO
288
289 DO i=lft,llt
290 elcrk = ielcrktg(i+nft) - ecrkxfec
291 IF (elcut(i+nft) > 0) THEN
292 DO k=1,3
293 ied = edgetg(k,i+nft)
294 iedge = iedgesh3(k,elcrk)
295 IF (ied > 0 .and. iedge > 0) THEN
296 tagedge(iedge) = tagedge(iedge) + 1
297 ENDIF
298 ENDDO
299 ENDIF
300 ENDDO
301
302 RETURN
1.15.0