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
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
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: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
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