OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
upenric3_nx.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!|| upenric3_n4 ../engine/source/elements/xfem/upenric3_nx.F
25!||--- called by ------------------------------------------------------
26!|| upxfem_tagxp ../engine/source/elements/xfem/upxfem_tagxp.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 upenric3_n4(XFEM_TAB,
33 . IPARG ,IXC ,NFT ,JFT ,JLT ,
34 . ELCUTC ,IADC_CRK,IEL_CRK,INOD_CRK,IXFEM,
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 G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com_xfem1.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IPARG(NPARG,*),IXC(NIXC,*),NFT,JFT,JLT,IXFEM,
59 . ELCUTC(2,*),IADC_CRK(4,*),IEL_CRK(*),XEDGE4N(4,*),
60 . INOD_CRK(*)
61 TYPE(elbuf_struct_), TARGET ,DIMENSION(NXEL) :: XFEM_TAB
62 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,K,ELCRK,IADC1,IADC2,IADC3,IADC4,LAYCUT,
67 . IR,IS,IT,ILEV,ILAY,IXEL,NXLAY,NCUT,NELCRK,ELCUT,IECUT,EDGE
68 INTEGER JCT(MVSIZ)
69 my_real, DIMENSION(:) ,POINTER :: xoff
70C=======================================================================
71 nelcrk = 0
72 DO i=jft,jlt
73 jct(i) = 0
74 IF (elcutc(1,i+nft) /= 0) THEN
75 nelcrk = nelcrk + 1
76 jct(nelcrk) = i
77 ENDIF
78 ENDDO
79 IF (nelcrk == 0) RETURN
80C-----
81 ir = 1
82 is = 1
83 it = 1
84C
85 DO ixel=1,nxel
86 nxlay = xfem_tab(ixel)%NLAY
87 DO ilay=1,nxlay
88 ilev = nxel*(ilay-1) + ixel
89 IF (nxlay> 1) THEN
90 xoff => xfem_tab(ixel)%BUFLY(ilay)%LBUF(ir,is,it)%OFF
91 ELSEIF (nxlay== 1) THEN
92 xoff => xfem_tab(ixel)%GBUF%OFF
93 ENDIF
94C---
95 DO ncut=1,nelcrk
96 i = jct(ncut)
97 elcrk = iel_crk(i+nft)
98 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
99 IF (elcut /= 0) THEN
100c--- set nodal enrichment to zero for desactivated phantom elements
101 IF (xoff(i) == zero) THEN
102 iadc1 = iadc_crk(1,elcrk)
103 iadc2 = iadc_crk(2,elcrk)
104 iadc3 = iadc_crk(3,elcrk)
105 iadc4 = iadc_crk(4,elcrk)
106 crklvset(ilev)%ENR0(1,iadc1) = 0
107 crklvset(ilev)%ENR0(1,iadc2) = 0
108 crklvset(ilev)%ENR0(1,iadc3) = 0
109 crklvset(ilev)%ENR0(1,iadc4) = 0
110 END IF
111c update ICUTEDGE (ICUTEDGE=1) : tip edge becomes internal
112 DO k=1,4
113 edge = xedge4n(k,elcrk)
114 iecut = crkedge(ilay)%ICUTEDGE(edge)
115 IF (iecut /= 0) crkedge(ilay)%ICUTEDGE(edge) = 1
116 ENDDO
117C
118 laycut = crkedge(ilay)%LAYCUT(elcrk)
119 IF (abs(laycut) == 1) crkedge(ilay)%LAYCUT(elcrk) = 2
120 ENDIF ! IF(ELCUT /= 0)
121 ENDDO ! DO NCUT=1,NELCRK
122 ENDDO ! DO ILAY=1,NXLAY
123 ENDDO ! DO IXEL=1,NXEL
124C-----------------------------------------------
125 RETURN
126 END
127!||====================================================================
128!|| upenric3_n3 ../engine/source/elements/xfem/upenric3_nx.F
129!||--- called by ------------------------------------------------------
130!|| upxfem_tagxp ../engine/source/elements/xfem/upxfem_tagxp.F
131!||--- uses -----------------------------------------------------
132!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
133!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
134!|| element_mod ../common_source/modules/elements/element_mod.F90
135!||====================================================================
136 SUBROUTINE upenric3_n3(XFEM_TAB,
137 . IPARG ,IXTG ,NFT ,JFT ,JLT ,
138 . ELCUTC ,IAD_CRKTG,IEL_CRKTG,INOD_CRK,IXFEM,
139 . CRKEDGE,XEDGE3N )
140C-----------------------------------------------
141C M o d u l e s
142C-----------------------------------------------
143 USE crackxfem_mod
144 USE elbufdef_mod
145 use element_mod , only : nixtg
146C-----------------------------------------------
147C I m p l i c i t T y p e s
148C-----------------------------------------------
149#include "implicit_f.inc"
150C-----------------------------------------------
151C G l o b a l P a r a m e t e r s
152C-----------------------------------------------
153#include "mvsiz_p.inc"
154C-----------------------------------------------
155C C o m m o n B l o c k s
156C-----------------------------------------------
157#include "com_xfem1.inc"
158#include "param_c.inc"
159C-----------------------------------------------
160C D u m m y A r g u m e n t s
161C-----------------------------------------------
162 INTEGER IPARG(NPARG,*),IXTG(NIXTG,*),NFT,JFT,JLT,IXFEM,
163 . ELCUTC(2,*),IAD_CRKTG(3,*),XEDGE3N(3,*),IEL_CRKTG(*),
164 . INOD_CRK(*)
165C
166 TYPE(ELBUF_STRUCT_), TARGET ,DIMENSION(NXEL) :: XFEM_TAB
167 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
168C-----------------------------------------------
169C L o c a l V a r i a b l e s
170C-----------------------------------------------
171 INTEGER I,K,ELCRK,ELCRKTG,ELCUT,IADC(3),
172 . jct(mvsiz),nelcrk,edge,laycut,iecut,ncut,
173 . ir,is,it,ilay,nxlay,ixel,ilev
174 my_real, DIMENSION(:) ,POINTER :: xoff
175C=======================================================================
176 nelcrk = 0
177 DO i=jft,jlt
178 jct(i) = 0
179 IF (elcutc(1,i+nft) /= 0) THEN
180 nelcrk = nelcrk + 1
181 jct(nelcrk) = i
182 ENDIF
183 ENDDO
184 IF (nelcrk == 0) RETURN
185C-----------------------------------------------
186 ir = 1
187 is = 1
188 it = 1
189C
190 DO ixel=1,nxel
191 nxlay = xfem_tab(ixel)%NLAY
192 DO ilay=1,nxlay
193 IF (nxlay> 1) THEN
194 xoff => xfem_tab(ixel)%BUFLY(ilay)%LBUF(ir,is,it)%OFF
195 ELSEIF (nxlay== 1) THEN
196 xoff => xfem_tab(ixel)%GBUF%OFF
197 ENDIF
198C---
199 ilev = nxel*(ilay-1) + ixel
200C---
201 DO ncut=1,nelcrk
202 i = jct(ncut)
203 elcrktg = iel_crktg(i+nft)
204 elcrk = elcrktg + ecrkxfec
205 elcut = xfem_phantom(ilay)%ELCUT(elcrk)
206 IF (elcut /= 0) THEN
207C
208 iadc(1) = iad_crktg(1,elcrktg)
209 iadc(2) = iad_crktg(2,elcrktg)
210 iadc(3) = iad_crktg(3,elcrktg)
211C---
212 IF (xoff(i) == zero) THEN
213 crklvset(ilev)%ENR0(1,iadc(1)) = 0
214 crklvset(ilev)%ENR0(1,iadc(2)) = 0
215 crklvset(ilev)%ENR0(1,iadc(3)) = 0
216 ENDIF ! IF(OFF == ZERO)
217C
218 DO k=1,3
219 edge = xedge3n(k,elcrktg)
220 iecut = crkedge(ilay)%ICUTEDGE(edge)
221 IF (iecut /= 0) crkedge(ilay)%ICUTEDGE(edge) = 1
222 ENDDO
223C
224 laycut = crkedge(ilay)%LAYCUT(elcrk)
225 IF (abs(laycut) == 1) crkedge(ilay)%LAYCUT(elcrk) = 2
226 ENDIF ! IF(ELCUT /= 0)
227 ENDDO ! DO NCUT=1,NELCRK
228 ENDDO ! DO ILAY=1,NXLAY
229 ENDDO ! DO IXEL=1,NXEL
230C-----------------------------------------------
231 RETURN
232 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
upenric3_n4
subroutine upenric3_n4(xfem_tab, iparg, ixc, nft, jft, jlt, elcutc, iadc_crk, iel_crk, inod_crk, ixfem, crkedge, xedge4n)
Definition upenric3_nx.F:36
upenric3_n3
subroutine upenric3_n3(xfem_tab, iparg, ixtg, nft, jft, jlt, elcutc, iad_crktg, iel_crktg, inod_crk, ixfem, crkedge, xedge3n)
Definition upenric3_nx.F:140