35
37 use element_mod , only : nixtg
38
39
40
41#include "implicit_f.inc"
42
43
44
45#include "mvsiz_p.inc"
46#include "comlock.inc"
47
48
49
50#include "com_xfem1.inc"
51
52
53
54 INTEGER JFT,JLT,NFT,ILEV,IXTG(NIXTG,*),ELCUTC(2,*),IEL_CRKTG(*),
55 . IAD_CRKTG(3,*),XEDGE3N(3,*),NODEDGE(2,*)
56 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
57
58
59
60 INTEGER I,K,K1,K2,K3,KK,P1,P2,P3,IFI1,IFI2,
61 . EDGE,IEDGE1,IEDGE2,EDGE1,EDGE2,IED1,IED2,
62 . IADC1,IADC2,IADC3,ILAY,IXEL,ELCUT,ELCRK,ELCRKTG,
63 . IED0,IFI10,NOD1,NOD2,ITRI,NX1,NX2,NX3
64 INTEGER IFI0(3,MVSIZ),D1(3),D2(3),DX(6)
66 . xin(3,mvsiz),yin(3,mvsiz),zin(3,mvsiz),
67 . xx(3,mvsiz),yy(3,mvsiz),zz(3,mvsiz)
68 my_real x10,y10,z10,x20,y20,z20,beta
69
70 DATA d1/2,3,1/
71 DATA d2/3,1,2/
72 DATA dx/1,2,3,1,2,3/
73
74
75
76
77 ixel = mod(ilev-1, nxel) + 1
78 ilay = (ilev-ixel)/nxel + 1
79 p1 = 0
80 p2 = 0
81 p3 = 0
82
83 DO i=jft,jlt
84 xin(1,i) = zero
85 yin(1,i) = zero
86 zin(1,i) = zero
87 xin(2,i) = zero
88 yin(2,i) = zero
89 zin(2,i) = zero
90 xin(3,i) = zero
91 yin(3,i) = zero
92 zin(3,i) = zero
93 END DO
94
95 DO i=jft,jlt
96 elcrktg = iel_crktg(i+nft)
97 iadc1 = iad_crktg(1,elcrktg)
98 iadc2 = iad_crktg(2,elcrktg)
99 iadc3 = iad_crktg(3,elcrktg)
100
104
105 ifi0(1,i) = isign(1,ifi0(1,i))
106 ifi0(2,i) = isign(1,ifi0(2,i))
107 ifi0(3,i) = isign(1,ifi0(3,i))
108
109
110
111
112 xx(1,i) =
crkavx(ilev)%X(1,iadc1)
113 yy(1,i) =
crkavx(ilev)%X(2,iadc1)
114 zz(1,i) =
crkavx(ilev)%X(3,iadc1)
115
116 xx(2,i) =
crkavx(ilev)%X(1,iadc2)
117 yy(2,i) =
crkavx(ilev)%X(2,iadc2)
118 zz(2,i) =
crkavx(ilev)%X(3,iadc2)
119
120 xx(3,i) =
crkavx(ilev)%X(1,iadc3)
121 yy(3,i) =
crkavx(ilev)%X(2,iadc3)
122 zz(3,i) =
crkavx(ilev)%X(3,iadc3)
123 END DO
124
125
126
127 DO i=jft,jlt
128 elcrktg = iel_crktg(i+nft)
129 elcrk = elcrktg + ecrkxfec
131 IF (elcut /= 0) THEN
132 DO k=1,3
133 ied0 = crkedge(ilay)%IEDGETG(k,elcrktg)
134 IF (ied0 > 0) THEN
135 edge = xedge3n(k,elcrktg)
136 beta = crkedge(ilay)%RATIO(edge)
137 nod1 = nodedge(1,edge)
138 nod2 = nodedge(2,edge)
139 IF (nod1 == ixtg(k+1,i+nft) .and.
140 . nod2 == ixtg(d1(k)+1,i+nft)) THEN
141 p1 = k
142 p2 = d1(k)
143 ELSEIF (nod2 == ixtg(k+1,i+nft).and.
144 . nod1 == ixtg(d1(k)+1,i+nft)) THEN
145 p1 = d1(k)
146 p2 = k
147 ENDIF
148 x10 = xx(p1,i)
149 y10 = yy(p1,i)
150 z10 = zz(p1,i)
151 x20 = xx(p2,i)
152 y20 = yy(p2,i)
153 z20 = zz(p2,i)
154 xin(ied0,i) = x10+beta*(x20-x10)
155 yin(ied0,i) = y10+beta*(y20-y10)
156 zin(ied0,i) = z10+beta*(z20-z10)
157 END IF
158 END DO
159 END IF
160 END DO
161
162
163
164
165
166 DO i=jft,jlt
167 elcrktg = iel_crktg(i+nft)
168 elcrk = elcrktg + ecrkxfec
170
171 IF (elcutc(1,i+nft) == 0) cycle
172 p1 = 0
173 p2 = 0
174 p3 = 0
175 DO k=1,3
176 ifi10 = ifi0(k,i)
177 ifi1 = ifi0(d1(k),i)
178 ifi2 = ifi0(d2(k),i)
179 IF (ifi10*ifi1 < 0 .and. ifi10*ifi2 < 0) THEN
180 p1 = k
181 p2 = d1(k)
182 p3 = d2(k)
183 EXIT
184 END IF
185 END DO
186
187 IF (p1==0 .or. p2==0 .or. p3==0) cycle
188
191 nx2 = dx(nx1+1)
192 nx3 = dx(nx1+2)
193 ied1 = nx1
194 ied2 = nx3
195 iedge1 = crkedge(ilay)%IEDGETG(ied1,elcrktg)
196 iedge2 = crkedge(ilay)%IEDGETG(ied2,elcrktg)
197 edge1 = xedge3n(ied1,elcrktg)
198 edge2 = xedge3n(ied2,elcrktg)
199
200 kk =
crkshell(ilev)%XNODEL(nx1,elcrk)
201 k1 = kk -
crknod(ilev)%CRKNUMNODS * (ilev-1)
202 kk =
crkshell(ilev)%XNODEL(nx2,elcrk)
203 k2 = kk -
crknod(ilev)%CRKNUMNODS * (ilev-1)
204 kk =
crkshell(ilev)%XNODEL(nx3,elcrk)
205 k3 = kk -
crknod(ilev)%CRKNUMNODS * (ilev-1)
206
207 IF (itri < 0) THEN
208
209 IF (ixel == 1) THEN
210
211
212
213
214 crkavx(ilev)%XX(1,k2) = xin(iedge1,i)
215 crkavx(ilev)%XX(2,k2) = yin(iedge1,i)
216 crkavx(ilev)%XX(3,k2) = zin(iedge1,i)
217 crkavx(ilev)%XX(1,k3) = xin(iedge2,i)
218 crkavx(ilev)%XX(2,k3) = yin(iedge2,i)
219 crkavx(ilev)%XX(3,k3) = zin(iedge2,i)
220
221 ELSEIF (ixel == 2) THEN
222
223
224
225
226 crkavx(ilev)%XX(1,k1) = xin(iedge2,i)
227 crkavx(ilev)%XX(2,k1) = yin(iedge2,i)
228 crkavx(ilev)%XX(3,k1) = zin(iedge2,i)
229
230 ELSEIF (ixel == 3) THEN
231
232
233
234 crkavx(ilev)%XX(1,k1) = xin(iedge1,i)
235 crkavx(ilev)%XX(2,k1) = yin(iedge1,i)
236 crkavx(ilev)%XX(3,k1) = zin(iedge1,i)
237
238 crkavx(ilev)%XX(1,k3) = xin(iedge2,i)
239 crkavx(ilev)%XX(2,k3) = yin(iedge2,i)
240 crkavx(ilev)%XX(3,k3) = zin(iedge2,i)
241 END IF
242
243 ELSEIF (itri > 0) THEN
244
245 IF (ixel == 1) THEN
246
247
248
249
250 crkavx(ilev)%XX(1,k1) = xin(iedge1,i)
251 crkavx(ilev)%XX(2,k1) = yin(iedge1,i)
252 crkavx(ilev)%XX(3,k1) = zin(iedge1,i)
253
254 ELSEIF (ixel == 2) THEN
255
256
257
258 crkavx(ilev)%XX(1,k2) = xin(iedge1,i)
259 crkavx(ilev)%XX(2,k2) = yin(iedge1,i)
260 crkavx(ilev)%XX(3,k2) = zin(iedge1,i)
261 crkavx(ilev)%XX(1,k3) = xin(iedge2,i)
262 crkavx(ilev)%XX(2,k3) = yin(iedge2,i)
263 crkavx(ilev)%XX(3,k3) = zin(iedge2,i)
264 ELSEIF (ixel == 3) THEN
265
266
267
268 crkavx(ilev)%XX(1,k1) = xin(iedge2,i)
269 crkavx(ilev)%XX(2,k1) = yin(iedge2,i)
270 crkavx(ilev)%XX(3,k1) = zin(iedge2,i)
271
275
276
277
278 END IF
279
280 ENDIF
281
282 ENDDO
283
284 RETURN
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
type(xfem_nodes_), dimension(:), allocatable crknod
type(xfem_avx_), dimension(:), allocatable crkavx
type(xfem_shell_), dimension(:), allocatable crkshell