OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
precrklay.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| precrklay ../engine/source/elements/xfem/precrklay.F
25!||--- called by ------------------------------------------------------
26!|| cforc3 ../engine/source/elements/shell/coque/cforc3.F
27!|| czforc3 ../engine/source/elements/shell/coquez/czforc3.F
28!||--- uses -----------------------------------------------------
29!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
30!||====================================================================
31 SUBROUTINE precrklay(JFT ,JLT ,NFT ,NLAY ,ELCRKINI,
32 . IEL_CRK,INOD_CRK,NODENR ,CRKEDGE,XEDGE4N )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE crackxfem_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER JFT,JLT,NFT,NLAY
45 INTEGER ELCRKINI(NLAY,*),IEL_CRK(*),INOD_CRK(*),
46 . nodenr(*),xedge4n(4,*)
47 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER I,K,ILAY,ELCRK,ELCUT,IEDGE,ICUT
52C=======================================================================
53C check for advancing within an uncut element layer
54C-----------------------
55 DO i=jft,jlt
56 elcrk = iel_crk(i+nft) ! N systeme elem xfem
57 DO ilay=1,nlay
58 elcut = crkedge(ilay)%LAYCUT(elcrk)
59 IF (elcut == 0)THEN ! not cut yet
60c tag uncut layer for advancing
61 icut = 0
62 DO k=1,4 ! edges
63 iedge = xedge4n(k,elcrk) ! N local de l'arrete (elem sys xfem)
64 icut = crkedge(ilay)%ICUTEDGE(iedge) ! flag arrete coupe/non
65 IF (icut == 1) THEN ! tag elements avec un crack sur le bord
66 elcrkini(ilay,i) = 2 ! avancement de fissure dans l'element possible
67 EXIT
68 ENDIF
69 ENDDO
70 ENDIF ! IF(ELCUT == 0)THEN
71 ENDDO ! DO ILAY=1,NLAY
72 ENDDO ! DO I=JFT,JLT
73C-----------
74 RETURN
75 END
76!||====================================================================
77!|| precrklaytg ../engine/source/elements/xfem/precrklay.F
78!||--- called by ------------------------------------------------------
79!|| c3forc3 ../engine/source/elements/sh3n/coque3n/c3forc3.F
80!||--- uses -----------------------------------------------------
81!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
82!||====================================================================
83 SUBROUTINE precrklaytg(JFT ,JLT ,NFT ,NLAY ,ELCRKINI,
84 . IEL_CRKTG,INOD_CRK ,NODENR ,CRKEDGE ,XEDGE3N )
85C-----------------------------------------------
86C M o d u l e s
87C-----------------------------------------------
88 USE crackxfem_mod
89C-----------------------------------------------
90C I m p l i c i t T y p e s
91C-----------------------------------------------
92#include "implicit_f.inc"
93C-----------------------------------------------
94C C o m m o n B l o c k s
95C-----------------------------------------------
96#include "com_xfem1.inc"
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 INTEGER JFT,JLT,NFT,NLAY
101 INTEGER ELCRKINI(NLAY,*),IEL_CRKTG(*),INOD_CRK(*),
102 . nodenr(*),xedge3n(3,*)
103 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
104C-----------------------------------------------
105C L o c a l V a r i a b l e s
106C-----------------------------------------------
107 INTEGER I,K,ILAY,ELCRK,ELCRKTG,ELCUT,IEDGE,ICUT
108C=======================================================================
109C check for advancing within an uncut element layer
110C-----------------------
111 DO i=jft,jlt
112 elcrktg = iel_crktg(i+nft)
113 elcrk = elcrktg + ecrkxfec
114 DO ilay=1,nlay
115 elcut = crkedge(ilay)%LAYCUT(elcrk)
116 IF (elcut == 0) THEN
117c tag uncut layer for advancing
118 icut = 0
119 DO k=1,3
120 iedge = xedge3n(k,elcrktg)
121 icut = crkedge(ilay)%ICUTEDGE(iedge)
122 IF (icut == 1) THEN
123 elcrkini(ilay,i) = 2
124 EXIT
125 ENDIF
126 ENDDO
127 ENDIF ! IF(ELCUT == 0)THEN
128 ENDDO ! DO ILAY=1,NLAY
129 ENDDO ! DO I=JFT,JLT
130C-----------
131 RETURN
132 END
133!||====================================================================
134!|| crkoffc ../engine/source/elements/xfem/precrklay.F
135!||--- called by ------------------------------------------------------
136!|| cforc3 ../engine/source/elements/shell/coque/cforc3.F
137!|| czforc3 ../engine/source/elements/shell/coquez/czforc3.F
138!||--- uses -----------------------------------------------------
139!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
140!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
141!||====================================================================
142 SUBROUTINE crkoffc(ELBUF_STR,XFEM_STR ,
143 . JFT ,JLT ,NFT ,IR ,IS ,
144 . NXLAY ,IEL_CRK ,CRKEDGE,XEDGE4N )
145C-----------------------------------------------
146C M o d u l e s
147C-----------------------------------------------
148 USE crackxfem_mod
149 USE elbufdef_mod
150C-----------------------------------------------
151C I m p l i c i t T y p e s
152C-----------------------------------------------
153#include "implicit_f.inc"
154C-----------------------------------------------
155C C o m m o n B l o c k s
156C-----------------------------------------------
157#include "com_xfem1.inc"
158C-----------------------------------------------
159C D u m m y A r g u m e n t s
160C-----------------------------------------------
161 INTEGER JFT,JLT,NFT,NXLAY,IR,IS
162 INTEGER IEL_CRK(*),XEDGE4N(4,*)
163C
164 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
165 TYPE (ELBUF_STRUCT_), DIMENSION(NXEL), TARGET :: XFEM_STR ! take xfem_str
166 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
167C-----------------------------------------------
168C L o c a l V a r i a b l e s
169C-----------------------------------------------
170 INTEGER I,K,ILAY,ELCRK,IFAC,ILAYCRK,IEDGE,IXEL
171 TYPE(G_BUFEL_) ,POINTER :: GBUF
172C-----------------------
173c tag bord libre d'un element std efface dans une loi
174c on delete les phantomes
175C=======================================================================
176 gbuf => elbuf_str%GBUF
177C---
178 DO i=jft,jlt
179 elcrk = iel_crk(i+nft) ! N element sys xfem
180 IF (elcrk == 0) cycle
181 ifac = 0
182 DO ilay=1,nxlay
183 ilaycrk = crkedge(ilay)%LAYCUT(elcrk)
184 IF (ilaycrk /= 0) cycle
185 IF (gbuf%OFF(i) == zero) ifac = ifac + 1
186 ENDDO
187C----
188 IF (ifac == nxlay) THEN
189 DO ilay=1,nxlay
190 DO k=1,4
191 iedge = xedge4n(k,elcrk)
192 crkedge(ilay)%IBORDEDGE(iedge) = 2 ! devient bord libre
193 ENDDO
194C---
195 DO ixel=1,nxel
196 IF (nxlay == 1) THEN
197 xfem_str(ixel)%GBUF%OFF(i) = zero
198 ELSEIF (nxlay > 1) THEN
199 xfem_str(ixel)%BUFLY(ilay)%LBUF(ir,is,1)%OFF(i) = zero
200 ENDIF
201 ENDDO
202C---
203 ENDDO
204 ENDIF
205 ENDDO
206C-----------
207 RETURN
208 END
209!||====================================================================
210!|| crkofftg ../engine/source/elements/xfem/precrklay.F
211!||--- called by ------------------------------------------------------
212!|| c3forc3 ../engine/source/elements/sh3n/coque3n/c3forc3.F
213!||--- uses -----------------------------------------------------
214!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
215!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
216!||====================================================================
217 SUBROUTINE crkofftg(ELBUF_STR,XFEM_STR ,
218 . JFT ,JLT ,NFT ,IR ,IS ,
219 . NXLAY ,IEL_CRKTG ,CRKEDGE,XEDGE3N )
220C-----------------------------------------------
221C M o d u l e s
222C-----------------------------------------------
223 USE crackxfem_mod
224 USE elbufdef_mod
225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C C o m m o n B l o c k s
231C-----------------------------------------------
232#include "com_xfem1.inc"
233C-----------------------------------------------
234C D u m m y A r g u m e n t s
235C-----------------------------------------------
236 INTEGER JFT,JLT,NFT,NXLAY,IR,IS
237 INTEGER IEL_CRKTG(*),XEDGE3N(3,*)
238C
239 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
240 TYPE (ELBUF_STRUCT_), DIMENSION(NXEL), TARGET :: XFEM_STR ! take xfem_str
241 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
242C-----------------------------------------------
243C L o c a l V a r i a b l e s
244C-----------------------------------------------
245 INTEGER I,J,K,ILAY,ELCRKTG,ELCRK,IFAC,ILAYCRK,IEDGE,IXEL
246 TYPE(g_bufel_) ,POINTER :: GBUF
247C=======================================================================
248 gbuf => elbuf_str%GBUF
249C---
250 DO i=jft,jlt
251 elcrktg = iel_crktg(i+nft)
252 elcrk = elcrktg + ecrkxfec
253 IF (elcrk == 0) cycle
254 ifac = 0
255 DO ilay=1,nxlay
256 ilaycrk = crkedge(ilay)%LAYCUT(elcrk)
257 IF (ilaycrk /= 0) cycle
258 IF (gbuf%OFF(i) == zero) ifac = ifac + 1
259 ENDDO
260C----
261 IF (ifac == nxlay) THEN
262 DO ilay=1,nxlay
263 DO k=1,3
264 iedge = xedge3n(k,elcrktg)
265 crkedge(ilay)%IBORDEDGE(iedge) = 2
266 ENDDO
267C---
268 DO ixel=1,nxel
269 IF (nxlay == 1) THEN
270 xfem_str(ixel)%GBUF%OFF(i) = zero
271 ELSEIF (nxlay > 1) THEN
272 xfem_str(ixel)%BUFLY(ilay)%LBUF(ir,is,1)%OFF(i) = zero
273 ENDIF
274 ENDDO
275C---
276 ENDDO
277 ENDIF
278 ENDDO
279C-----------
280 RETURN
281 END
crackxfem_mod
Definition crackxfem_mod.F:121
precrklaytg
subroutine precrklaytg(jft, jlt, nft, nlay, elcrkini, iel_crktg, inod_crk, nodenr, crkedge, xedge3n)
Definition precrklay.F:85
crkofftg
subroutine crkofftg(elbuf_str, xfem_str, jft, jlt, nft, ir, is, nxlay, iel_crktg, crkedge, xedge3n)
Definition precrklay.F:220
crkoffc
subroutine crkoffc(elbuf_str, xfem_str, jft, jlt, nft, ir, is, nxlay, iel_crk, crkedge, xedge4n)
Definition precrklay.F:145
precrklay
subroutine precrklay(jft, jlt, nft, nlay, elcrkini, iel_crk, inod_crk, nodenr, crkedge, xedge4n)
Definition precrklay.F:33