OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
check_edge_state.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_edge_state ../engine/source/interfaces/interf/check_edge_state.F
25!||--- called by ------------------------------------------------------
26!|| find_edge_from_remote_proc ../engine/source/interfaces/interf/find_edge_from_remote_proc.F
27!|| resol ../engine/source/engine/resol.F
28!||--- calls -----------------------------------------------------
29!|| check_active_elem_edge ../engine/source/interfaces/interf/check_active_elem_edge.F
30!||--- uses -----------------------------------------------------
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
33!|| shooting_node_mod ../engine/share/modules/shooting_node_mod.F90
34!||====================================================================
35 SUBROUTINE check_edge_state( ITASK,M_EDGE_NB,S_EDGE_NB,M_EDGE_ID,S_EDGE_ID,
36 . SHIFT_INTERFACE,INTBUF_TAB,NEWFRONT,IPARI,GEO,
37 . IXS,IXC,IXT,IXP,IXR,IXTG,IXS10,
38 . ADDCNEL,CNEL,TAG_NODE,TAG_ELEM,SHOOT_STRUCT )
39!$COMMENT
40! CHECK_EDGE_STATE description
41! check the state of an edge (active or not)
42! CHECK_EDGE_STATE organization
43! loop over a list of edge :
44! -check if 1 or more element associated to the edge is/are active
45! - if there is no active element, the edge is deactivate
46!$ENDCOMMENT
47 USE intbufdef_mod
48 USE shooting_node_mod
49 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "task_c.inc"
58#include "com04_c.inc"
59#include "scr17_c.inc"
60#include "param_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, INTENT(in) :: ITASK ! omp thread ID
65 INTEGER, INTENT(in) :: M_EDGE_NB,S_EDGE_NB ! number of local edge surface
66 INTEGER, DIMENSION(M_EDGE_NB), INTENT(in) :: M_EDGE_ID ! id of main edge that needs to be deactivated
67 INTEGER, DIMENSION(S_EDGE_NB), INTENT(in) :: S_EDGE_ID ! id of second edge that needs to be deactivated
68 INTEGER, DIMENSION(NINTER), INTENT(inout) :: NEWFRONT !< flag to force some exchanges related to S nodes between processor (if an S node becomes a shooting node - all interface) / force the collision detection algo if a new segment is activated for the (interface 25 + solid erosion)
69 INTEGER, DIMENSION(NINTER+1,2), INTENT(in) :: SHIFT_INTERFACE ! interface shift
70 TYPE(intbuf_struct_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB ! interface data
71 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
72
73 INTEGER, DIMENSION(NIXS,NUMELS), INTENT(in) :: IXS ! solid array
74 INTEGER, DIMENSION(NIXC,NUMELC), INTENT(in) :: IXC ! shell array
75 INTEGER, DIMENSION(NIXT,NUMELT), INTENT(in) :: IXT! truss array
76 INTEGER, DIMENSION(NIXP,NUMELP), INTENT(in) :: IXP! beam array
77 INTEGER, DIMENSION(NIXR,NUMELR), INTENT(in) :: IXR! spring array
78 INTEGER, DIMENSION(NIXTG,NUMELTG), INTENT(in) :: IXTG! triangle array
79 INTEGER, DIMENSION(6,NUMELS10), INTENT(in) :: IXS10!< tetra10 data
80 INTEGER, DIMENSION(0:NUMNOD+1), INTENT(in) :: ADDCNEL ! address for the CNEL array
81 my_real, DIMENSION(NPROPG,NUMGEO), INTENT(in) :: geo
82 INTEGER, DIMENSION(0:LCNEL), INTENT(in) :: CNEL ! connectivity node-->element
83 INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: TAG_NODE
84 INTEGER, DIMENSION(NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG), INTENT(inout) :: TAG_ELEM
85 TYPE(shooting_node_type), INTENT(inout) :: SHOOT_STRUCT ! structure for shooting node algo
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 LOGICAL :: DEACTIVATION
90 INTEGER :: I,K,FIRST,LAST
91 INTEGER :: NIN,ID_INTER,NUMBER_INTER
92 INTEGER :: ITY,IDEL
93 INTEGER :: N1,N2,N3,N4
94 INTEGER :: NUMBER_NODE
95 INTEGER :: DICHOTOMIC_SEARCH_I_ASC ! function
96C-----------------------------------------------
97 IF(itask==-1) THEN
98 first = 1
99 last = m_edge_nb
100 ELSE
101 first = 1 + itask * (m_edge_nb / nthread)
102 last = (itask + 1) * (m_edge_nb / nthread)
103 IF((itask+1)==nthread) last = m_edge_nb
104 ENDIF
105 number_inter = shift_interface(ninter+1,2)
106 ! --------------------------
107 ! loop over the deactivated edge: main node
108 DO i=first,last
109 k = m_edge_id(i) ! get the global edge id
110 id_inter = dichotomic_search_i_asc(k, shift_interface(1,1), number_inter+1) ! find the interface of the surface
111 nin = shift_interface(id_inter,2)
112 k = k - shift_interface(id_inter,1) + 1 ! get the surface id in the NIN interface
113
114 ity = ipari(7,nin)
115 idel = ipari(17,nin)
116
117 IF(itask==-1) THEN
118 IF(ity==11.AND.idel==1) THEN
119 shoot_struct%INTER(nin)%REMOTE_ELM_M(k) = shoot_struct%INTER(nin)%REMOTE_ELM_M(k) - 1
120 ENDIF
121 ENDIF
122
123 ! check if the edge is active, if yes --> deactivate it
124 IF(intbuf_tab(nin)%STFM(k)/=zero) THEN
125
126 IF(ity==11.AND.idel==1) THEN
127 n1 = intbuf_tab(nin)%IRECTM((k-1)*2+1)
128 n2 = intbuf_tab(nin)%IRECTM((k-1)*2+2)
129 n3 = 0
130 n4 = 0
131 number_node = 2
132 IF(shoot_struct%INTER(nin)%REMOTE_ELM_M(k)<1) THEN
133 CALL check_active_elem_edge( number_node, n1,n2,n3,n4,
134 . deactivation,geo,ixs,ixc,
135 . ixt,ixp,ixr,ixtg,ixs10,addcnel,cnel,
136 . tag_node,tag_elem )
137 ELSE
138 deactivation = .false.
139 ENDIF
140 ELSE
141 deactivation=.true.
142 ENDIF
143 IF(deactivation) intbuf_tab(nin)%STFM(k) = zero
144 ENDIF
145 ENDDO
146 ! --------------------------
147
148 IF(itask==-1) THEN
149 first = 1
150 last = s_edge_nb
151 ELSE
152 first = 1 + itask * (s_edge_nb / nthread)
153 last = (itask + 1) * (s_edge_nb / nthread)
154 IF((itask+1)==nthread) last = s_edge_nb
155 ENDIF
156 ! --------------------------
157 ! loop over the deactivated edge : secondary node
158 DO i=first,last
159 k = s_edge_id(i) ! get the global edge id
160 id_inter = dichotomic_search_i_asc(k, shift_interface(1,1), number_inter+1) ! find the interface of the surface
161 nin = shift_interface(id_inter,2)
162 k = k - shift_interface(id_inter,1) + 1 ! get the surface id in the NIN interface
163
164 ity = ipari(7,nin)
165 idel = ipari(17,nin)
166
167 IF(itask==-1) THEN
168 IF(ity==11.AND.idel==1) THEN
169 shoot_struct%INTER(nin)%REMOTE_ELM_S(k) = shoot_struct%INTER(nin)%REMOTE_ELM_S(k) - 1
170 ENDIF
171 ENDIF
172
173 ! check if the edge is active, if yes --> deactivate it
174 IF(intbuf_tab(nin)%STFS(k)/=zero) THEN
175 IF(ity==11.AND.idel==1) THEN
176 n1 = intbuf_tab(nin)%IRECTS((k-1)*2+1)
177 n2 = intbuf_tab(nin)%IRECTS((k-1)*2+2)
178 n3 = 0
179 n4 = 0
180 number_node = 2
181 IF(shoot_struct%INTER(nin)%REMOTE_ELM_S(k)<1) THEN
182 CALL check_active_elem_edge( number_node, n1,n2,n3,n4,
183 . deactivation,geo,ixs,ixc,
184 . ixt,ixp,ixr,ixtg,ixs10,addcnel,cnel,
185 . tag_node,tag_elem )
186 ELSE
187 deactivation = .false.
188 ENDIF
189 ELSE
190 deactivation=.true.
191 ENDIF
192
193 IF(deactivation) THEN
194 intbuf_tab(nin)%STFS(k) = -abs(intbuf_tab(nin)%STFS(k))
195 newfront(nin) = -1
196 ENDIF
197 ENDIF
198 ENDDO
199 ! --------------------------
200
201 RETURN
202 END SUBROUTINE check_edge_state
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
check_edge_state
subroutine check_edge_state(itask, m_edge_nb, s_edge_nb, m_edge_id, s_edge_id, shift_interface, intbuf_tab, newfront, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem, shoot_struct)
Definition check_edge_state.F:39
my_real
#define my_real
Definition cppsort.cpp:32