OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inixfem.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "task_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ inixfem()

subroutine inixfem ( type (elbuf_struct_), dimension(ngroup) elbuf_tab,
type (elbuf_struct_), dimension(ngroup,nxel) xfem_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer ngrouc,
integer, dimension(*) igrouc,
integer, dimension(2,*) elcutc,
integer, dimension(*) iadc_crk,
integer, dimension(*) iel_crk,
integer, dimension(*) inod_crk,
integer, dimension(*) addcne_crk,
x,
integer, dimension(*) knod2elc,
integer, dimension(2,*) nodedge,
integer, dimension(*) crknodiad,
integer, dimension(*) iad_edge,
integer, dimension(*) fr_edge,
integer, dimension(*) fr_nbedge,
integer, dimension(*) nodlevxf,
type (xfem_edge_), dimension(nxlaymax) crkedge,
integer, dimension(4,*) xedge4n,
integer, dimension(3,*) xedge3n )

Definition at line 39 of file inixfem.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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
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