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!||====================================================================
39 SUBROUTINE xfeoff(XFEM_TAB ,
40 . IPARG ,IXC ,NGROUC ,IGROUC ,IEL_CRK ,
41 . ELCUTC ,IXTG ,IADC_CRK ,IAD_ELEM,IAD_EDGE,
42 . FR_EDGE ,FR_NBEDGE,FR_ELEM ,NLAY ,INOD_CRK,
43 . CRKEDGE ,XEDGE4N ,XEDGE3N )
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
48 USE elbufdef_mod
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 "com01_c.inc"
57#include "com04_c.inc"
58#include "com_xfem1.inc"
59#include "param_c.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,*),NGROUC,IGROUC(*),
66 . IEL_CRK(*),ELCUTC(2,*),IXTG(NIXTG,*),IADC_CRK(*),
67 . IAD_ELEM(2,*),IAD_EDGE(*),FR_EDGE(*),FR_NBEDGE(*),
68 . NLAY,FR_ELEM(*),INOD_CRK(*),XEDGE4N(4,*),XEDGE3N(3,*)
69C
70 TYPE(elbuf_struct_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
71 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,IG,NG,JFT,JLT,NEL,NF1,IXFEM,IADXFEM,NXLAY,OFF,
76 . STEP,ITG1,ITG2,FLAG,SIZE,LSDRC,ACTIFXFEM
77C=======================================================================
78C activation of new group if crack advancing or new crack initiate
79c-----------------------------------------------------------------------
80 IF (nspmd > 1) THEN
81 flag = 1
82 SIZE = nlay
83 lsdrc = fr_nbedge(nspmd+1)
84 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
85 . flag ,crkedge)
86 ENDIF
87C---
88C_tmp IF(NUMELCRK2 == NUMELCRK)RETURN ! check in hypethreading, SPMD
89C---
90C----------------------------------------
91 itg1 = 1+numelc
92 itg2 = 1+4*ecrkxfec
93c-------------------------------
94C Boucle parallele dynamique SMP
95c-------------------------------
96!$OMP DO SCHEDULE(DYNAMIC,1)
97c
98 DO ig = 1, ngrouc
99 ng = igrouc(ig)
100 off = iparg(8,ng)
101 ixfem = iparg(54,ng)
102 IF (ixfem > 0 .and. off < 1) THEN
103 IF (iddw > 0) CALL startimeg(ng)
104C---
105 nel = iparg(2,ng)
106 nft = iparg(3,ng)
107 ity = iparg(5,ng)
108 nxlay = iparg(59,ng)
109 lft = 1
110 llt = min(nvsiz,nel)
111 jft=lft
112 jlt=llt
113C---
114 IF (ity == 3) THEN
115 CALL activ_xfem(iparg ,nft ,jft ,jlt ,nxlay,
116 . ng ,elcutc,iel_crk,ity ,crkedge)
117C---
118 ELSE IF (ity == 7) THEN
119 CALL activ_xfem(iparg ,nft ,jft ,jlt ,nxlay,
120 . ng ,elcutc(1,itg1),iel_crk(itg1),ity,crkedge)
121 ENDIF
122C---
123 IF (iddw > 0) CALL stoptimeg(ng)
124 ENDIF
125 ENDDO
126!$OMP END DO
127C-------------
128C
129C Boucle parallele dynamique SMP
130C
131!$omp DO schedule(dynamic,1)
132 DO ig = 1, ngrouc
133 ng = igrouc(ig)
134 off = iparg(8,ng)
135 ixfem = iparg(54,ng)
136 actifxfem = iparg(70,ng)
137 IF (ixfem > 0 .and. off < 1 .and. actifxfem > 0) THEN
138 IF (iddw > 0) CALL startimeg(ng)
139C---
140 nel = iparg(2,ng)
141 nft = iparg(3,ng)
142 ity = iparg(5,ng)
143 npt = iparg(6,ng)
144 nxlay = iparg(59,ng)
145 lft = 1
146 llt = min(nvsiz,nel)
147 jft=lft
148 jlt=llt
149C---
150 IF (ity == 3) THEN
151 CALL upoffc(xfem_tab ,ng ,
152 . nft ,jft ,jlt ,ixfem ,iel_crk ,
153 . elcutc ,inod_crk,iadc_crk ,ixc ,nxlay ,
154 . crkedge ,xedge4n )
155C---
156 ELSE IF (ity == 7) THEN
157 CALL upofftg(xfem_tab ,ng ,
158 . nft ,jft ,jlt ,ixfem ,iel_crk(itg1),
159 . elcutc(1,itg1),inod_crk,iadc_crk(itg2),ixtg ,nxlay ,
160 . crkedge ,xedge3n )
161 ENDIF
162C---
163 IF (iddw > 0) CALL stoptimeg(ng)
164 ENDIF
165 ENDDO
166!$OMP END DO
167C-------------
168 IF (nspmd > 1) THEN
169 flag = 0
170 SIZE = nlay
171 lsdrc = fr_nbedge(nspmd+1)
172 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
173 . flag ,crkedge)
174C
175 flag = 3
176 SIZE = 6*nlay
177 lsdrc = fr_nbedge(nspmd+1)
178 CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE ,lsdrc,fr_nbedge,
179 . flag ,crkedge)
180C
181 CALL spmd_max_xfe_i(numelcrk) ! no more used (just for anim reasons)
182 ENDIF
183C-------------
184 RETURN
185 END
subroutine startimeg(ng)
Definition timer.F:1487
subroutine stoptimeg(ng)
Definition timer.F:1535
subroutine activ_xfem(iparg, nft, lft, llt, nxlay, ng, iel_crk, ity, crkedge)
Definition lslocal.F:563
#define min(a, b)
Definition macros.h:20
subroutine spmd_max_xfe_i(int)
Definition spmd_xfem.F:1130
subroutine spmd_exch_iedge(iad_edge, fr_edge, size, lsdrc, fr_nbedge, flag, crkedge)
Definition spmd_xfem.F:619
subroutine upoffc(xfem_tab, ng, nft, jft, jlt, ixfem, iel_crk, elcutc, inod_crk, iadc_crk, ixc, nxlay, crkedge, xedge4n)
Definition upoffc.F:35
subroutine upofftg(xfem_tab, ng, nft, jft, jlt, ixfem, iel_crk, elcutc, inod_crk, iadtg_crk, ixtg, nxlay, crkedge, xedge3n)
Definition upofftg.F:35
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:44