OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
upoffc.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!|| upoffc ../engine/source/elements/xfem/upoffc.f
25!||--- called by ------------------------------------------------------
26!|| xfeoff ../engine/source/elements/xfem/xfeoff.F
27!||--- uses -----------------------------------------------------
28!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
29!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
30!|| element_mod ../common_source/modules/elements/element_mod.F90
31!||====================================================================
32 SUBROUTINE upoffc(XFEM_TAB ,NG ,
33 . NFT ,JFT ,JLT ,IXFEM ,IEL_CRK ,
34 . ELCUTC ,INOD_CRK,IADC_CRK ,IXC ,NXLAY ,
35 . CRKEDGE ,XEDGE4N )
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE crackxfem_mod
40 USE elbufdef_mod
41 use element_mod , only : nixc
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com_xfem1.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NG,NFT,JFT,JLT,IXFEM,NXLAY,
55 . IEL_CRK(*),ELCUTC(2,*),INOD_CRK(*),IADC_CRK(4,*),XEDGE4N(4,*),
56 . IXC(NIXC,*)
57C
58 TYPE(elbuf_struct_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
59 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,K,IEL,NEL,ELCRK,ICUT,ILAYCUT,ILAY,ILEV,ITRI,P1,P2,
64 . IEDGE,IBOUNDEDGE,IXEL,IR,IS,IT,IEDGE0,FAC,ICUT0
65 INTEGER D(4),NN(4),OPEN_EDGE(4,NXLAY),ENR_NOD(4),IADC(4),IOFF(NXEL,JLT)
66 my_real, DIMENSION(:) ,POINTER :: xoff
67 DATA d/2,3,4,1/
68C=======================================================================
69 ioff = 0
70 ir = 1
71 is = 1
72 it = 1
73 nel = jlt - jft + 1
74C
75 DO i=jft,jlt
76 iel = i+nft
77 icut = elcutc(1,iel)
78 IF (icut == 0) cycle
79 elcrk = iel_crk(iel)
80C
81 iadc(1) = iadc_crk(1,elcrk)
82 iadc(2) = iadc_crk(2,elcrk)
83 iadc(3) = iadc_crk(3,elcrk)
84 iadc(4) = iadc_crk(4,elcrk)
85C
86 nn(1) = inod_crk(ixc(2,iel)) ! noeud sys xfem
87 nn(2) = inod_crk(ixc(3,iel))
88 nn(3) = inod_crk(ixc(4,iel))
89 nn(4) = inod_crk(ixc(5,iel))
90C
91 DO ilay=1,nxlay
92 ilaycut = crkedge(ilay)%LAYCUT(elcrk)
93 DO k=1,4
94 open_edge(k,ilay) = 0
95 ENDDO
96c
97 DO ixel=1,nxel
98 IF (nxlay> 1) THEN
99 xoff => xfem_tab(ng,ixel)%BUFLY(ilay)%LBUF(ir,is,it)%OFF(1:nel)
100 ELSEIF (nxlay== 1) THEN
101 xoff => xfem_tab(ng,ixel)%GBUF%OFF(1:nel)
102 ENDIF
103C---
104 IF (abs(ilaycut) == 1) THEN ! new crack initialized ou avance (+1,-1)
105c activate new cracked layer:
106 xoff(i) = -xoff(i)
107 ELSE IF (ilaycut == 2) THEN ! old cut layer
108c delete already cracked phantom element if new crack is touching it
109c
110 ilev = nxel*(ilay-1) + ixel
111 enr_nod(1) = crklvset(ilev)%ENR0(1,iadc(1))
112 enr_nod(2) = crklvset(ilev)%ENR0(1,iadc(2))
113 enr_nod(3) = crklvset(ilev)%ENR0(1,iadc(3))
114 enr_nod(4) = crklvset(ilev)%ENR0(1,iadc(4))
115 DO k=1,4
116 p1 = k
117 p2 = d(k)
118 iedge = xedge4n(k,elcrk)
119 iboundedge = 0
120 icut0 = 0
121 iedge0 = crkedge(ilay)%IEDGEC(k,elcrk)
122 IF (iedge > 0) THEN
123 iboundedge = crkedge(ilay)%IBORDEDGE(iedge)
124 icut0 = crkedge(ilay)%ICUTEDGE(iedge)
125 ENDIF
126 IF (iboundedge == 0 .AND. iedge0 == 0 .AND. icut0 > 0) THEN
127 IF (enr_nod(p1) == 0 .AND. enr_nod(p2) == 0) THEN
128 xoff(i) = zero
129 ioff(ixel,i) = 1
130 open_edge(k,ilay) = 1 ! bord libre
131 ENDIF
132 ENDIF
133 ENDDO
134C---
135 ENDIF ! IF (ABS(ILAYCUT) == 1)
136 ENDDO ! DO IXEL=1,NXEL
137c
138 fac = 0
139 DO k=1,4
140 IF (open_edge(k,ilay) == 1) fac = fac + 1
141 ENDDO
142 IF (fac > 0) THEN
143 DO k=1,4
144 iedge = xedge4n(k,elcrk)
145 IF (open_edge(k,ilay) == 1) THEN
146 crkedge(ilay)%IBORDEDGE(iedge) = 2
147 ENDIF
148 ENDDO
149 ENDIF
150C--------------------------
151c delete both phantoms on the same side for ITRI /= 0
152C--------------------------
153 itri = xfem_phantom(ilay)%ITRI(1,elcrk)
154 IF (itri < 0) THEN
155 IF (nxlay > 1) THEN
156 IF (xfem_tab(ng,2)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
157 xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) = zero
158 ELSEIF (xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
159 xfem_tab(ng,2)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) = zero
160 ENDIF
161 ELSE
162 IF (xfem_tab(ng,2)%GBUF%OFF(i) == zero) THEN
163 xfem_tab(ng,3)%GBUF%OFF(i) = zero
164 ELSEIF (xfem_tab(ng,3)%GBUF%OFF(i) == zero) THEN
165 xfem_tab(ng,2)%GBUF%OFF(i) = zero
166 ENDIF
167 ENDIF
168 ELSEIF (itri > 0) THEN
169 IF (nxlay > 1) THEN
170 IF (xfem_tab(ng,1)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
171 xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) = zero
172 ELSEIF (xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
173 xfem_tab(ng,1)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) = zero
174 ENDIF
175 ELSE
176 IF (xfem_tab(ng,1)%GBUF%OFF(i) == zero) THEN
177 xfem_tab(ng,3)%GBUF%OFF(i) = zero
178 ELSEIF (xfem_tab(ng,3)%GBUF%OFF(i) == zero) THEN
179 xfem_tab(ng,1)%GBUF%OFF(i) = zero
180 ENDIF
181 ENDIF
182 ENDIF
183C---
184 ENDDO ! DO ILAY=1,NXLAY
185 ENDDO ! DO I=JFT,JLT
186C-----------------------------------------------
187 RETURN
188 END
my_real
#define my_real
Definition cppsort.cpp:32
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::xfem_phantom
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
Definition crackxfem_mod.F:139
crackxfem_mod::crklvset
type(xfem_lvset_), dimension(:), allocatable crklvset
Definition crackxfem_mod.F:146
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