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