OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
check_active_elem_edge.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!|| check_active_elem_edge ../engine/source/interfaces/interf/check_active_elem_edge.F
25!||--- called by ------------------------------------------------------
26!|| check_edge_state ../engine/source/interfaces/interf/check_edge_state.F
27!|| check_surface_state ../engine/source/interfaces/interf/check_surface_state.F
28!||--- uses -----------------------------------------------------
29!|| element_mod ../common_source/modules/elements/element_mod.F90
30!||====================================================================
31 SUBROUTINE check_active_elem_edge( NUMBER_NODE, N1,N2,N3,N4,
32 . DEACTIVATION,GEO,IXS,IXC,
33 . IXT,IXP,IXR,IXTG,IXS10,ADDCNEL,CNEL,
34 . TAG_NODE,TAG_ELEM )
35!$COMMENT
36! CHECK_ACTIVE_ELEM_EDGE description
37! check if a element associated to an edge is active
38! CHECK_ACTIVE_ELEM_EDGE organization
39! loop over the element associated to the N1 node
40! if 1 active element contains N1 & N2, the edge must be kept (for interface 11)
41! if 1 active element contains N1 & N2 & N3 & N4, the surface must be kept (for interface 7)
42!$ENDCOMMENT
43 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com04_c.inc"
52#include "param_c.inc"
53#include "scr17_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 LOGICAL, INTENT(inout) :: DEACTIVATION
58 INTEGER, INTENT(in) :: NUMBER_NODE ! number of node of the edge/surface
59 INTEGER, INTENT(in) :: N1,N2,N3,N4 ! node id : for interface type11 -> N3&N4 are fake node id (ie. =0)
60 INTEGER, DIMENSION(NIXS,NUMELS), INTENT(in) :: IXS ! solid array
61 INTEGER, DIMENSION(NIXC,NUMELC), INTENT(in) :: IXC ! shell array
62 INTEGER, DIMENSION(NIXT,NUMELT), INTENT(in) :: IXT! truss array
63 INTEGER, DIMENSION(NIXP,NUMELP), INTENT(in) :: IXP! beam array
64 INTEGER, DIMENSION(NIXR,NUMELR), INTENT(in) :: IXR! spring array
65 INTEGER, DIMENSION(NIXTG,NUMELTG), INTENT(in) :: IXTG! triangle array
66 INTEGER, DIMENSION(6,NUMELS10), INTENT(in) :: IXS10!< tetra10 data
67 INTEGER, DIMENSION(0:NUMNOD+1), INTENT(in) :: ADDCNEL ! address for the CNEL array
68 my_real, DIMENSION(NPROPG,NUMGEO), INTENT(in) :: geo
69 INTEGER, DIMENSION(0:LCNEL), INTENT(in) :: CNEL ! connectivity node-->element
70 INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: TAG_NODE
71 INTEGER, DIMENSION(NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG), INTENT(inout) :: TAG_ELEM
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 LOGICAL :: STILL_COMPUTE,STILL_ALIVE
76 INTEGER :: I,K
77 INTEGER :: NEXT
78 INTEGER :: ELEM_ID,NODE_ID,OTHER_NODE
79 INTEGER :: OFFSET_SOLID,OFFSET_QUAD,OFFSET_SHELL
80 INTEGER :: OFFSET_TRUSS,OFFSET_BEAM,OFFSET_SPRING
81 INTEGER :: OFFSET_TRIANGLE,OFFSET_UR
82C-----------------------------------------------
83 ! --------------------------
84 offset_solid = 0
85 offset_quad=offset_solid+numels
86 offset_shell=offset_quad+numelq
87 offset_truss=offset_shell+numelc
88 offset_beam=offset_truss+numelt
89 offset_spring=offset_beam+numelp
90 offset_triangle=offset_spring+numelr
91 offset_ur=offset_triangle+numeltg
92 ! --------------------------
93
94 still_compute = .true.
95 next = 0
96 i = addcnel(n1) + next
97 deactivation = .false.
98 still_alive = .false.
99
100 ! ------------------
101 ! check if 1 or more elements is/are associated to
102 ! N1 node
103 ! if no element, the edge can be deactivated (only if
104 ! the remote elements associated to N1/N2 are all deleted)
105 IF((addcnel(n1+1) - addcnel(n1)) ==0) THEN
106 deactivation = .true.
107 still_compute = .false.
108 ENDIF
109 ! ------------------
110
111 DO WHILE( still_compute )
112
113 elem_id = cnel(i)
114 tag_node(n1) = 0
115 tag_node(n2) = 0
116 IF(number_node>2) THEN
117 tag_node(n3) = 0
118 tag_node(n4) = 0
119 ENDIF
120 ! -------------------------
121 ! loop over the active element
122 ! for interface 11 : if still 1 or more active elements with N1 & N2 : need to keep the edge
123 ! else : need to deactivate the edge
124 ! for interface 7 : if still 1 or more active elements with N1 & N2 & N3 & N4 : need to keep the surface
125 ! else : need to deactivate the surface
126 IF(tag_elem(elem_id)>0) THEN
127 ! -----------------
128 ! solid element
129 IF(elem_id<=offset_shell) THEN
130 DO k=2,9
131 node_id = ixs(k,elem_id)
132 tag_node(node_id) = 1
133 ENDDO
134 IF(elem_id>numels8.AND.elem_id<=numels8+numels10) THEN
135 DO k=1,6
136 node_id = ixs10(k,elem_id-numels8)
137 tag_node(node_id) = 1
138 ENDDO
139 ENDIF
140 ELSEIF(elem_id>offset_shell.AND.elem_id<=offset_truss) THEN
141 ! -----------------
142 ! shell element
143 DO k=2,5
144 node_id = ixc(k,elem_id-offset_shell)
145 tag_node(node_id) = 1
146 ENDDO
147 ELSEIF(elem_id>offset_truss.AND.elem_id<=offset_beam) THEN
148 ! -----------------
149 ! truss
150 DO k=2,3
151 node_id = ixt(k,elem_id-offset_truss)
152 tag_node(node_id) = 1
153 ENDDO
154 ELSEIF(elem_id>offset_beam.AND.elem_id<=offset_spring) THEN
155 ! -----------------
156 ! beam element
157 DO k=2,3
158 node_id = ixp(k,elem_id-offset_beam)
159 tag_node(node_id) = 1
160 ENDDO
161 ELSEIF(elem_id>offset_spring.AND.elem_id<=offset_triangle) THEN
162 ! -----------------
163 ! spring element
164 DO k=2,3
165 node_id = ixr(k,elem_id-offset_spring)
166 tag_node(node_id) = 1
167 ENDDO
168
169 IF(nint(geo(12,ixr(1,elem_id-offset_spring))) == 12) THEN
170 node_id = ixr(4,elem_id-offset_spring)
171 tag_node(node_id) = 1
172 ENDIF
173 ELSEIF(elem_id>offset_triangle.AND.elem_id<=offset_ur) THEN
174 ! -----------------
175 ! triangle element
176 DO k=2,4
177 node_id = ixtg(k,elem_id-offset_triangle)
178 tag_node(node_id) = 1
179 ENDDO
180 ENDIF
181 ! -----------------
182
183 ! -----------------
184 ! for interface 7 : need to check if the element has N3 & N4
185 other_node = 0
186 IF(number_node>2) other_node = tag_node(n3)
187 IF(number_node>3) other_node = other_node + tag_node(n4)
188
189 ! -----------------
190
191 ! -----------------
192 ! check if the element has N1 & N2
193 IF(tag_node(n1)+tag_node(n2)+other_node==number_node) THEN
194 still_compute = .false.
195 still_alive = .true.
196 ENDIF
197 ! -----------------
198
199 ENDIF
200 next = next + 1
201 i = addcnel(n1) + next
202 IF(i>addcnel(n1+1)-1) THEN
203 still_compute = .false.
204 ENDIF
205 ! -------------------------
206 ENDDO
207
208 IF(.NOT.still_alive) THEN
209 deactivation = .true.
210 ENDIF
211
212 RETURN
213 END SUBROUTINE check_active_elem_edge
214
check_active_elem_edge
subroutine check_active_elem_edge(number_node, n1, n2, n3, n4, deactivation, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem)
Definition check_active_elem_edge.F:35
my_real
#define my_real
Definition cppsort.cpp:32