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