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