OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inixfem.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!|| inixfem ../engine/source/elements/xfem/inixfem.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| crk_coord_ini ../engine/source/elements/xfem/crk_coord_ini.F
29!|| enrichc_ini ../engine/source/elements/xfem/enrichc_ini.F
30!|| enrichtg_ini ../engine/source/elements/xfem/enrichtg_ini.F
31!|| spmd_exch_iedge ../engine/source/mpi/elements/spmd_xfem.F
32!|| startimeg ../engine/source/system/timer.F
33!|| stoptimeg ../engine/source/system/timer.F
34!||--- uses -----------------------------------------------------
35!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
36!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
37!|| element_mod ../common_source/modules/elements/element_mod.F90
38!||====================================================================
39 SUBROUTINE inixfem(ELBUF_TAB,XFEM_TAB ,
40 . IPARG ,IXC ,IXTG ,NGROUC ,IGROUC ,
41 . ELCUTC ,IADC_CRK ,IEL_CRK ,INOD_CRK ,ADDCNE_CRK,
42 . X ,KNOD2ELC ,NODEDGE ,CRKNODIAD,IAD_EDGE ,
43 . FR_EDGE ,FR_NBEDGE,NODLEVXF ,CRKEDGE ,XEDGE4N ,
44 . XEDGE3N )
45C-----------------------------------------------
46 USE crackxfem_mod
47 USE elbufdef_mod
48 use element_mod , only : nixc,nixtg
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "param_c.inc"
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "com_xfem1.inc"
60#include "task_c.inc"
61#include "vect01_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER IPARG(NPARG,*),IXC(NIXC,*),IXTG(NIXTG,*),NGROUC,IGROUC(*),
66 . ELCUTC(2,*),IADC_CRK(*),IEL_CRK(*),INOD_CRK(*),XEDGE4N(4,*),
67 . XEDGE3N(3,*),ADDCNE_CRK(*),KNOD2ELC(*),NODEDGE(2,*),
68 . CRKNODIAD(*),IAD_EDGE(*),FR_EDGE(*),FR_NBEDGE(*),NODLEVXF(*)
69 my_real X(3,*)
70 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
71 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
72 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX) :: CRKEDGE
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I,K,IG,NG,JFT,JLT,NEL,IXFEM,N,ITG1,ITG2,FLAG,
77 . SIZE,lsdrc,icut,iedge,elcrk,elcrktg,elcut,ilay,nxlay,pp1
78 INTEGER NODFTSK,NODLTSK
79 my_real OFF
80C=======================================================================
81 numelcrk2 = numelcrk ! to check if crack advances in the cycle (animation)
82 itg1 = 1+numelc
83 itg2 = 1+4*ecrkxfec
84C---
85 nodftsk = 1
86 nodltsk = numnod
87 CALL crk_coord_ini(addcne_crk,inod_crk,nodftsk,nodltsk,x,nodlevxf)
88c
89 ! Save nb elements connected to the node
90 DO i=nodftsk,nodltsk
91 n = inod_crk(i)
92 IF (n > 0) THEN
93 knod2elc(n) = addcne_crk(n+1)-addcne_crk(n)
94 ENDIF
95 ENDDO
96C---
97 IF (nlevset == 0) RETURN ! NUMCRACK = 0
98C---
99 itg1 = 1+numelc
100 itg2 = 1+4*ecrkxfec
101c-----------------------------------------------------------------------------
102C initialize element enrichments
103c-----------------------------------------------------------------------------
104c-----
105 DO ig = 1, ngrouc
106 ng = igrouc(ig)
107 ity = iparg(5,ng)
108 off = iparg(8,ng)
109 ixfem = iparg(54,ng)
110 IF (off == 1) cycle
111 IF (ixfem == 0) cycle
112 IF (ity /= 3 .and. ity /=7 ) cycle
113 IF (iddw > 0) CALL startimeg(ng)
114C---
115 nxlay = elbuf_tab(ng)%NLAY
116 nel =iparg(2,ng)
117 nft =iparg(3,ng)
118 npt =iparg(6,ng)
119 lft = 1
120 llt = min(nvsiz,nel)
121 jft = lft
122 jlt = llt
123C---
124 IF (ity == 3) THEN
125 CALL enrichc_ini(elbuf_tab(ng) ,xfem_tab(ng,1:nxel),
126 . ixc ,nft ,jft ,jlt ,nxlay ,
127 . iadc_crk ,iel_crk ,inod_crk ,elcutc ,nodedge ,
128 . crknodiad ,knod2elc ,x ,crkedge ,xedge4n )
129C---
130 ELSEIF (ity == 7) THEN
131 CALL enrichtg_ini(elbuf_tab(ng),
132 . ixtg ,nft ,jft ,jlt ,nxlay ,
133 . iadc_crk(itg2),iel_crk(itg1),inod_crk,elcutc(1,itg1),nodedge ,
134 . crknodiad ,knod2elc ,x ,crkedge ,xedge3n )
135 END IF
136C---
137 IF (iddw > 0) CALL stoptimeg(ng)
138 END DO
139c-----------------------------------------------------------------------------
140C Tag cut edges : CRKEDGE(ILAY)%ICUTEDGE(IEDGE)
141c-----------------------------------------------------------------------------
142 DO ig = 1, ngrouc
143 ng = igrouc(ig)
144 ity = iparg(5,ng)
145 off = iparg(8,ng)
146 ixfem = iparg(54,ng)
147 IF (off == 1) GOTO 200
148 IF (ixfem == 0) GOTO 200
149 IF (ity/=3 .AND. ity/=7) GOTO 200
150 IF (iddw>0) CALL startimeg(ng)
151C---
152 nel =iparg(2,ng)
153 nft =iparg(3,ng)
154 lft = 1
155 llt = min(nvsiz,nel)
156 jft = lft
157 jlt = llt
158C---
159 IF (ity == 3) THEN
160 DO ilay=1,nxlay
161 pp1 = (ilay-1)*nxel + 1
162 DO i=jft,jlt
163 elcrk = iel_crk(i+nft)
164 elcut = 0
165 IF (elcrk > 0) elcut = xfem_phantom(ilay)%ELCUT(elcrk)
166 IF (elcut /= 0) THEN
167 DO k=1,4
168 iedge = xedge4n(k,elcrk)
169 icut = 0
170 IF (iedge > 0) icut = crkedge(ilay)%ICUTEDGE(iedge)
171 IF (icut == 2) crkedge(ilay)%ICUTEDGE(iedge) = 1
172 ENDDO
173 ENDIF
174 ENDDO
175 ENDDO
176 ELSE IF (ity == 7) THEN
177 DO ilay=1,nxlay
178 pp1 = (ilay-1)*nxel + 1
179 DO i=jft,jlt
180 elcrktg = iel_crk(i+nft+numelc)
181 elcrk = elcrktg + ecrkxfec
182 elcut = 0
183 IF (elcrk > 0) elcut = xfem_phantom(ilay)%ELCUT(elcrk)
184 IF (elcut /= 0)THEN
185 DO k=1,3
186 iedge = xedge3n(k,elcrktg)
187 icut = 0
188 IF (iedge > 0) icut = crkedge(ilay)%ICUTEDGE(iedge)
189 IF (icut == 2) crkedge(ilay)%ICUTEDGE(iedge) = 1
190 ENDDO
191 ENDIF
192 ENDDO
193 ENDDO
194 END IF
195C---
196 IF (iddw>0) CALL stoptimeg(ng)
197 200 CONTINUE
198 END DO
199c----------------------
200 IF (nspmd > 1) THEN
201 flag = 2
202 SIZE = nxlay
203 lsdrc = fr_nbedge(nspmd+1)
204 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
205 . flag ,crkedge)
206 END IF
207C-----------
208 RETURN
209 END
crk_coord_ini
subroutine crk_coord_ini(addcne_crk, inod_crk, nodft, nodlt, x, nodlevxf)
Definition crk_coord_ini.F:33
startimeg
subroutine startimeg(ng)
Definition timer.F:1371
stoptimeg
subroutine stoptimeg(ng)
Definition timer.F:1419
enrichc_ini
subroutine enrichc_ini(elbuf_str, xfem_str, ixc, nft, jft, jlt, nxlay, iadc_crk, iel_crk, inod_crk, elcutc, nodedge, crknodiad, knod2elc, x, crkedge, xedge4n)
Definition enrichc_ini.F:40
enrichtg_ini
subroutine enrichtg_ini(elbuf_str, ixtg, nft, jft, jlt, nxlay, iad_crktg, iel_crktg, inod_crk, elcutc, nodedge, crknodiad, knod2elc, x, crkedge, xedge3n)
Definition enrichtg_ini.F:40
inixfem
subroutine inixfem(elbuf_tab, xfem_tab, iparg, ixc, ixtg, ngrouc, igrouc, elcutc, iadc_crk, iel_crk, inod_crk, addcne_crk, x, knod2elc, nodedge, crknodiad, iad_edge, fr_edge, fr_nbedge, nodlevxf, crkedge, xedge4n, xedge3n)
Definition inixfem.F:45
min
#define min(a, b)
Definition macros.h:20
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::xfem_phantom
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
Definition crackxfem_mod.F:139
spmd_exch_iedge
subroutine spmd_exch_iedge(iad_edge, fr_edge, size, lsdrc, fr_nbedge, flag, crkedge)
Definition spmd_xfem.F:619