OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xfeoff.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!|| xfeoff ../engine/source/elements/xfem/xfeoff.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| activ_xfem ../engine/source/elements/xfem/activ_xfem.F
29!|| spmd_exch_iedge ../engine/source/mpi/elements/spmd_xfem.F
30!|| spmd_max_xfe_i ../engine/source/mpi/elements/spmd_xfem.F
31!|| startimeg ../engine/source/system/timer.F
32!|| stoptimeg ../engine/source/system/timer.F
33!|| upoffc ../engine/source/elements/xfem/upoffc.F
34!|| upofftg ../engine/source/elements/xfem/upofftg.F
35!||--- uses -----------------------------------------------------
36!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
37!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
38!|| element_mod ../common_source/modules/elements/element_mod.F90
39!||====================================================================
40 SUBROUTINE xfeoff(XFEM_TAB ,
41 . IPARG ,IXC ,NGROUC ,IGROUC ,IEL_CRK ,
42 . ELCUTC ,IXTG ,IADC_CRK ,IAD_ELEM,IAD_EDGE,
43 . FR_EDGE ,FR_NBEDGE,FR_ELEM ,NLAY ,INOD_CRK,
44 . CRKEDGE ,XEDGE4N ,XEDGE3N )
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE crackxfem_mod
49 USE elbufdef_mod
50 use element_mod , only : nixc,nixtg
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "com_xfem1.inc"
61#include "param_c.inc"
62#include "task_c.inc"
63#include "vect01_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER IPARG(NPARG,*),IXC(NIXC,*),NGROUC,IGROUC(*),
68 . IEL_CRK(*),ELCUTC(2,*),IXTG(NIXTG,*),IADC_CRK(*),
69 . IAD_ELEM(2,*),IAD_EDGE(*),FR_EDGE(*),FR_NBEDGE(*),
70 . NLAY,FR_ELEM(*),INOD_CRK(*),XEDGE4N(4,*),XEDGE3N(3,*)
71C
72 TYPE(elbuf_struct_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
73 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER IG,NG,JFT,JLT,NEL,IXFEM,NXLAY,OFF,
78 . ITG1,ITG2,FLAG,SIZE,LSDRC,ACTIFXFEM
79C=======================================================================
80C activation of new group if crack advancing or new crack initiate
81c-----------------------------------------------------------------------
82 IF (nspmd > 1) THEN
83 flag = 1
84 SIZE = nlay
85 lsdrc = fr_nbedge(nspmd+1)
86 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
87 . flag ,crkedge)
88 ENDIF
89C---
90C_tmp IF(NUMELCRK2 == NUMELCRK)RETURN ! check in hypethreading, SPMD
91C---
92C----------------------------------------
93 itg1 = 1+numelc
94 itg2 = 1+4*ecrkxfec
95c-------------------------------
96C SMP dynamic parallel loop
97c-------------------------------
98!$OMP DO SCHEDULE(DYNAMIC,1)
99c
100 DO ig = 1, ngrouc
101 ng = igrouc(ig)
102 off = iparg(8,ng)
103 ixfem = iparg(54,ng)
104 IF (ixfem > 0 .and. off < 1) THEN
105 IF (iddw > 0) CALL startimeg(ng)
106C---
107 nel = iparg(2,ng)
108 nft = iparg(3,ng)
109 ity = iparg(5,ng)
110 nxlay = iparg(59,ng)
111 lft = 1
112 llt = min(nvsiz,nel)
113 jft=lft
114 jlt=llt
115C---
116 IF (ity == 3) THEN
117 CALL activ_xfem(iparg ,nft ,jft ,jlt ,nxlay,
118 . ng ,elcutc,iel_crk,ity ,crkedge)
119C---
120 ELSE IF (ity == 7) THEN
121 CALL activ_xfem(iparg ,nft ,jft ,jlt ,nxlay,
122 . ng ,elcutc(1,itg1),iel_crk(itg1),ity,crkedge)
123 ENDIF
124C---
125 IF (iddw > 0) CALL stoptimeg(ng)
126 ENDIF
127 ENDDO
128!$OMP END DO
129C-------------
130C
131C SMP dynamic parallel loop
132C
133!$OMP DO SCHEDULE(DYNAMIC,1)
134 DO ig = 1, ngrouc
135 ng = igrouc(ig)
136 off = iparg(8,ng)
137 ixfem = iparg(54,ng)
138 actifxfem = iparg(70,ng)
139 IF (ixfem > 0 .and. off < 1 .and. actifxfem > 0) THEN
140 IF (iddw > 0) CALL startimeg(ng)
141C---
142 nel = iparg(2,ng)
143 nft = iparg(3,ng)
144 ity = iparg(5,ng)
145 npt = iparg(6,ng)
146 nxlay = iparg(59,ng)
147 lft = 1
148 llt = min(nvsiz,nel)
149 jft=lft
150 jlt=llt
151C---
152 IF (ity == 3) THEN
153 CALL upoffc(xfem_tab ,ng ,
154 . nft ,jft ,jlt ,ixfem ,iel_crk ,
155 . elcutc ,inod_crk,iadc_crk ,ixc ,nxlay ,
156 . crkedge ,xedge4n )
157C---
158 ELSE IF (ity == 7) THEN
159 CALL upofftg(xfem_tab ,ng ,
160 . nft ,jft ,jlt ,ixfem ,iel_crk(itg1),
161 . elcutc(1,itg1),inod_crk,iadc_crk(itg2),ixtg ,nxlay ,
162 . crkedge ,xedge3n )
163 ENDIF
164C---
165 IF (iddw > 0) CALL stoptimeg(ng)
166 ENDIF
167 ENDDO
168!$OMP END DO
169C-------------
170 IF (nspmd > 1) THEN
171 flag = 0
172 SIZE = nlay
173 lsdrc = fr_nbedge(nspmd+1)
174 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
175 . flag ,crkedge)
176C
177 flag = 3
178 SIZE = 6*nlay
179 lsdrc = fr_nbedge(nspmd+1)
180 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
181 . flag ,crkedge)
182C
183 CALL spmd_max_xfe_i(numelcrk) ! no more used (just for anim reasons)
184 ENDIF
185C-------------
186 RETURN
187 END
startimeg
subroutine startimeg(ng)
Definition timer.F:1371
stoptimeg
subroutine stoptimeg(ng)
Definition timer.F:1419
activ_xfem
subroutine activ_xfem(iparg, nft, lft, llt, nxlay, ng, iel_crk, ity, crkedge)
Definition lslocal.F:564
min
#define min(a, b)
Definition macros.h:20
crackxfem_mod
Definition crackxfem_mod.F:121
spmd_max_xfe_i
subroutine spmd_max_xfe_i(int)
Definition spmd_xfem.F:1130
spmd_exch_iedge
subroutine spmd_exch_iedge(iad_edge, fr_edge, size, lsdrc, fr_nbedge, flag, crkedge)
Definition spmd_xfem.F:619
upoffc
subroutine upoffc(xfem_tab, ng, nft, jft, jlt, ixfem, iel_crk, elcutc, inod_crk, iadc_crk, ixc, nxlay, crkedge, xedge4n)
Definition upoffc.F:36
upofftg
subroutine upofftg(xfem_tab, ng, nft, jft, jlt, ixfem, iel_crk, elcutc, inod_crk, iadtg_crk, ixtg, nxlay, crkedge, xedge3n)
Definition upofftg.F:36
xfeoff
subroutine xfeoff(xfem_tab, iparg, ixc, ngrouc, igrouc, iel_crk, elcutc, ixtg, iadc_crk, iad_elem, iad_edge, fr_edge, fr_nbedge, fr_elem, nlay, inod_crk, crkedge, xedge4n, xedge3n)
Definition xfeoff.F:45