OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
preinicrk4N.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine preinicrk4n (elbuf_str, xfem_str, x1l, y1l, x2l, y2l, x3l, y3l, x4l, y4l, lft, llt, nft, nxlay, ielcrkc, edgec, beta0, iedgesh4, elcut, xnod, ixc, nodedge, tagskyc, knod2elc, tagedge, crklvset, crkshell, crkedge, xfem_phantom)
program __preinicrk4n_f__

Function/Subroutine Documentation

◆ __preinicrk4n_f__()

program __preinicrk4n_f__

Definition at line 311 of file preinicrk4N.F.

◆ preinicrk4n()

subroutine preinicrk4n ( type (elbuf_struct_), target elbuf_str,
type (elbuf_struct_), dimension(nxel), target xfem_str,
x1l,
y1l,
x2l,
y2l,
x3l,
y3l,
x4l,
y4l,
integer lft,
integer llt,
integer nft,
integer nxlay,
integer, dimension(*) ielcrkc,
integer, dimension(4,*) edgec,
beta0,
integer, dimension(4,*) iedgesh4,
integer, dimension(*) elcut,
integer, dimension(2,2) xnod,
integer, dimension(nixc,*) ixc,
integer, dimension(2,*) nodedge,
integer, dimension(4,*) tagskyc,
integer, dimension(*) knod2elc,
integer, dimension(*) tagedge,
type (xfem_lvset_), dimension(nlevmax) crklvset,
type (xfem_shell_), dimension(nlevmax) crkshell,
type (xfem_edge_), dimension(nxlaymax) crkedge,
type (xfem_phantom_), dimension(nxlaymax) xfem_phantom )

Definition at line 31 of file preinicrk4N.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE xfem2def_mod
42 USE elbufdef_mod
43 use element_mod , only : nixc
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c K s
54C-----------------------------------------------
55#include "com_xfem1.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER LFT,LLT,NFT,NXLAY
60 INTEGER IELCRKC(*),EDGEC(4,*),IEDGESH4(4,*),ELCUT(*),XNOD(2,2),
61 . IXC(NIXC,*),NODEDGE(2,*),TAGSKYC(4,*),KNOD2ELC(*),TAGEDGE(*)
62 my_real
63 . x1l(*),y1l(*),x2l(*),y2l(*),x3l(*),y3l(*),x4l(*),y4l(*),
64 . beta0(2)
65C
66 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
67 TYPE (ELBUF_STRUCT_), DIMENSION(NXEL) , TARGET :: XFEM_STR
68 TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
69 TYPE (XFEM_SHELL_) , DIMENSION(NLEVMAX) :: CRKSHELL
70 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX) :: CRKEDGE
71 TYPE (XFEM_PHANTOM_), DIMENSION(NXLAYMAX) :: XFEM_PHANTOM
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,K,II,R,ELCRK,IED,p1,p2,dd(4),d1(4),d2(4),IFI(2),
76 . IEDGE,ICRK,ILEV(NXEL),IL,ILAY,N(4),ISIGN0(4),
77 . NOD1,NOD2,IXEL,IENR0(4),IENR(4),NTAG(4)
78 my_real
79 . fit(4,mvsiz),xn(4),yn(4),xmi(2),ymi(2),beta(2,mvsiz),
80 . off_phantom
81 EXTERNAL lsintx
82 my_real lsintx
83 TYPE(G_BUFEL_) , POINTER :: GBUF
84 TYPE(L_BUFEL_) , POINTER :: LBUF
85C
86 DATA dd/2,3,4,1/
87 DATA d1/2,3,4,5/
88 DATA d2/3,4,5,2/
89C=======================================================================
90 p2 = 0
91 DO i=lft,llt
92 xn(1)=x1l(i)
93 yn(1)=y1l(i)
94 xn(2)=x2l(i)
95 yn(2)=y2l(i)
96 xn(3)=x3l(i)
97 yn(3)=y3l(i)
98 xn(4)=x4l(i)
99 yn(4)=y4l(i)
100 IF (elcut(i+nft) > 0) THEN
101 DO r=1,4 ! edges
102 p1 = r
103 p2 = dd(r)
104 ied = edgec(r,i+nft)
105 IF (ied > 0) THEN
106 xmi(ied) = half*(xn(p1)+xn(p2))
107 ymi(ied) = half*(yn(p1)+yn(p2))
108 ENDIF
109 ENDDO
110C
111 DO r=1,4 ! nodes
112 fit(r,i) = lsintx(xmi(1),ymi(1),xmi(2),ymi(2),xn(r),yn(r))
113 ENDDO
114 ENDIF
115 ENDDO
116C
117 DO i=lft,llt
118 elcrk = ielcrkc(i+nft)
119 beta(1,i) = zero
120 beta(2,i) = zero
121 IF (elcut(i+nft) > 0) THEN
122C
123 DO r=1,4 ! edges
124 iedge = iedgesh4(r,elcrk)
125 ied = edgec(r,i+nft)
126 IF (ied > 0) THEN
127 nod1 = nodedge(1,iedge)
128 nod2 = nodedge(2,iedge)
129 IF (nod1 == xnod(ied,1) .and. nod2 == xnod(ied,2)) THEN
130 beta(ied,i) = beta0(ied)
131 ELSE IF (nod2 == xnod(ied,1) .and. nod1 == xnod(ied,2)) THEN
132 beta(ied,i) = one - beta0(ied)
133 END IF
134 ENDIF
135 ENDDO
136 ENDIF
137 ENDDO ! I=LFT,LLT
138c------------------------------------------------------------
139c
140 DO ilay=1,nxlay
141 ii = nxel*(ilay-1)
142 DO k=1,nxel
143 ilev(k) = ii + k
144 ENDDO
145 DO i=lft,llt
146 elcrk = ielcrkc(i+nft)
147 IF (elcut(i+nft) > 0) THEN
148 icrk = crkshell(ilev(1))%PHANTOMG(elcrk) ! global xfem element N
149 crklvset(ilev(1))%ELCUT(elcrk) = icrk
150 crklvset(ilev(2))%ELCUT(elcrk) = -icrk
151c
152 xfem_phantom(ilay)%ELCUT(elcrk) = icrk
153 crkedge(ilay)%LAYCUT(elcrk) = 2
154C
155 n(1) = ixc(2,i+nft)
156 n(2) = ixc(3,i+nft)
157 n(3) = ixc(4,i+nft)
158 n(4) = ixc(5,i+nft)
159C
160 isign0(1) = int(sign(one,fit(1,i))) * icrk
161 isign0(2) = int(sign(one,fit(2,i))) * icrk
162 isign0(3) = int(sign(one,fit(3,i))) * icrk
163 isign0(4) = int(sign(one,fit(4,i))) * icrk
164C
165 ntag(1:4) = 0
166C
167 DO r=1,4
168 ienr0(r) = 0
169 ienr(r)=0
170 ied = edgec(r,i+nft)
171 IF(ied > 0)THEN
172 ntag(r) = ntag(r) + 1
173 ntag(dd(r)) = ntag(dd(r)) + 1
174 ENDIF
175 ENDDO
176C
177 DO r=1,4
178 ied = edgec(r,i+nft)
179 iedge = iedgesh4(r,elcrk)
180 IF(ied > 0)THEN
181 nod1 = nodedge(1,iedge)
182 nod2 = nodedge(2,iedge)
183 IF(nod1 == n(r) .and. nod2 == n(dd(r)))THEN
184 p1 = r
185 p2 = dd(r)
186 ELSE IF(nod2 == n(r) .and. nod1 == n(dd(r)))THEN
187 p1 = dd(r)
188 p2 = r
189 END IF
190 IF(ntag(p1) > 0.AND.crkedge(ilay)%EDGEENR(1,iedge) > 0)
191 . ienr0(p1) = crkedge(ilay)%EDGEENR(1,iedge)
192 IF(ntag(p2) > 0.AND.crkedge(ilay)%EDGEENR(2,iedge) > 0)
193 . ienr0(p2) = crkedge(ilay)%EDGEENR(2,iedge)
194 ENDIF
195 ENDDO
196C
197 DO r=1,4
198 IF(ienr0(r) /= 0)THEN
199 ienr(r) = ienr0(r)
200 ELSE
201 ienr(r) = tagskyc(r,i+nft)+knod2elc(n(r))*(ilay-1)
202 ENDIF
203 ENDDO
204C
205 DO r=1,4
206 ied = edgec(r,i+nft)
207 iedge = iedgesh4(r,elcrk)
208 IF (ied > 0) THEN
209 DO il=1,nxel
210 crklvset(ilev(il))%EDGE(r,elcrk) = ied ! (=1,2)
211 crklvset(ilev(il))%ICUTEDGE(iedge) = 1
212 crklvset(ilev(il))%RATIOEDGE(iedge) = beta(ied,i)
213 ENDDO
214C
215 crkedge(ilay)%EDGETIP(1,iedge) = max(ied,
216 . crkedge(ilay)%EDGETIP(1,iedge))
217 crkedge(ilay)%EDGETIP(2,iedge) =
218 . crkedge(ilay)%EDGETIP(2,iedge) + 1
219C
220c add check if BETA (0:1)
221C
222 IF(crkedge(ilay)%EDGEICRK(iedge) == 0)
223 . crkedge(ilay)%EDGEICRK(iedge) = icrk
224C
225 nod1 = nodedge(1,iedge)
226 nod2 = nodedge(2,iedge)
227 ifi(1:2) = 0
228 p1 = 0
229 p2 = 0
230 IF(nod1 == n(r) .and. nod2 == n(dd(r)))THEN
231 ifi(1) = isign0(r)
232 ifi(2) = isign0(dd(r))
233 p1 = r
234 p2 = dd(r)
235 ELSE IF(nod2 == n(r) .and. nod1 == n(dd(r)))THEN
236 ifi(1) = isign0(dd(r))
237 ifi(2) = isign0(r)
238 p1 = dd(r)
239 p2 = r
240 END IF
241 IF(crkedge(ilay)%EDGEIFI(1,iedge) == 0)
242 . crkedge(ilay)%EDGEIFI(1,iedge) = ifi(1)
243 IF(crkedge(ilay)%EDGEIFI(2,iedge) == 0)
244 . crkedge(ilay)%EDGEIFI(2,iedge) = ifi(2)
245 IF(crkedge(ilay)%EDGEENR(1,iedge) == 0)
246 . crkedge(ilay)%EDGEENR(1,iedge) = ienr(p1)
247 IF(crkedge(ilay)%EDGEENR(2,iedge) == 0)
248 . crkedge(ilay)%EDGEENR(2,iedge) = ienr(p2)
249 ENDIF
250 ENDDO ! r=1,4
251 ENDIF
252 ENDDO ! I=LFT,LLT
253 ENDDO ! ILAY=1,NXLAY
254C------------------------------------------------------
255c activation of cracked elements (OFFG = 1)
256C------------------------------------------------------
257 IF (nxlay > 1) THEN ! multilayer
258 DO ixel=1,nxel
259 DO ilay=1,nxlay
260 lbuf => xfem_str(ixel)%BUFLY(ilay)%LBUF(1,1,1)
261 DO i=lft,llt
262 IF(elcut(i+nft) > 0)THEN
263 off_phantom = lbuf%OFF(i)
264 lbuf%OFF(i) = - off_phantom
265 ENDIF
266 ENDDO
267 ENDDO
268 ENDDO
269 ELSE ! monolayer
270 DO ixel=1,nxel
271 gbuf => xfem_str(ixel)%GBUF
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 ! IF(NXLAY > 1)THEN
280C------------------------------------------------------
281c remove (replace) already cracked elements (OFFG = 0)
282C------------------------------------------------------
283 DO i=lft,llt
284 IF(elcut(i+nft) > 0)THEN
285 elbuf_str%GBUF%OFF(i) = zero
286 ENDIF
287 ENDDO
288C
289 DO i=lft,llt
290 elcrk = ielcrkc(i+nft)
291 IF(elcut(i+nft) > 0)THEN
292 DO r=1,4
293 ied = edgec(r,i+nft)
294 iedge = iedgesh4(r,elcrk)
295 IF(ied > 0)THEN
296 tagedge(iedge) = tagedge(iedge) + 1
297 ENDIF
298 ENDDO
299 ENDIF
300 ENDDO
301C-----------
302 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
xfem2def_mod
Definition xfem2def_mod.F:40