OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
check_edge_state.F File Reference
#include "implicit_f.inc"
#include "task_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ check_edge_state()

subroutine check_edge_state ( integer, intent(in) itask,
integer, intent(in) m_edge_nb,
integer, intent(in) s_edge_nb,
integer, dimension(m_edge_nb), intent(in) m_edge_id,
integer, dimension(s_edge_nb), intent(in) s_edge_id,
integer, dimension(ninter+1,2), intent(in) shift_interface,
type(intbuf_struct_), dimension(ninter), intent(inout) intbuf_tab,
integer, dimension(ninter), intent(inout) newfront,
integer, dimension(npari,ninter), intent(in) ipari,
intent(in) geo,
integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(nixc,numelc), intent(in) ixc,
integer, dimension(nixt,numelt), intent(in) ixt,
integer, dimension(nixp,numelp), intent(in) ixp,
integer, dimension(nixr,numelr), intent(in) ixr,
integer, dimension(nixtg,numeltg), intent(in) ixtg,
integer, dimension(6,numels10), intent(in) ixs10,
integer, dimension(0:numnod+1), intent(in) addcnel,
integer, dimension(0:lcnel), intent(in) cnel,
integer, dimension(numnod), intent(inout) tag_node,
integer, dimension(numels+numelq+numelc+numelt+numelp+numelr+numeltg), intent(inout) tag_elem,
type(shooting_node_type), intent(inout) shoot_struct )
Parameters
[in,out]newfrontflag 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)
[in]ixs10tetra10 data

Definition at line 34 of file check_edge_state.F.

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