OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
find_edge_from_remote_proc.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!|| find_edge_from_remote_proc ../engine/source/interfaces/interf/find_edge_from_remote_proc.F
25!||--- called by ------------------------------------------------------
26!|| spmd_exch_deleted_surf_edge ../engine/source/mpi/interfaces/spmd_exch_deleted_surf_edge.F
27!||--- calls -----------------------------------------------------
28!|| check_edge_state ../engine/source/interfaces/interf/check_edge_state.F
29!||--- uses -----------------------------------------------------
30!|| element_mod ../common_source/modules/elements/element_mod.F90
31!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
32!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
33!|| shooting_node_mod ../engine/share/modules/shooting_node_mod.F90
34!||====================================================================
35 SUBROUTINE find_edge_from_remote_proc(SHOOT_STRUCT,NB_EDGE,LIST_NODE,INTBUF_TAB,NODES,
36 . NEWFRONT,IPARI,GEO,
37 . IXS,IXC,IXT,IXP,IXR,IXTG,IXS10,
38 . ADDCNEL,CNEL,TAG_NODE,TAG_ELEM )
39!$COMMENT
40! FIND_EDGE_FROM_REMOTE_PROC description
41! deactivation of edges coming from remote proc
42! FIND_EDGE_FROM_REMOTE_PROC organization
43! the element associated to the edge is on a remote proc
44! the remote proc send me : "you must deactivate this edge because my element is
45! deleted"
46! local procs find the local edge/interfaces
47! local procs deactivate the edge from the interfaces
48!$ENDCOMMENT
49 USE nodal_arrays_mod
50 USE intbufdef_mod
51 USE shooting_node_mod
52 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com04_c.inc"
61#include "param_c.inc"
62#include "scr17_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 TYPE(nodal_arrays_), INTENT(inout) :: NODES
67 INTEGER, INTENT(in) :: NB_EDGE ! number of "edge" (ie. 2 nodes)
68 INTEGER, DIMENSION(2*NB_EDGE), INTENT(in) :: LIST_NODE ! list of 2 nodes
69 TYPE(shooting_node_type), INTENT(inout) :: SHOOT_STRUCT ! structure for shooting node algo
70 TYPE(intbuf_struct_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB ! interface data
71 INTEGER, DIMENSION(NINTER), INTENT(inout) :: NEWFRONT !< flag to force some exchanges related to S nodes between processor (if a 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)
72 INTEGER, DIMENSION(NIXS,NUMELS), INTENT(in) :: IXS ! solid array
73 INTEGER, DIMENSION(NIXC,NUMELC), INTENT(in) :: IXC ! shell array
74 INTEGER, DIMENSION(NIXT,NUMELT), INTENT(in) :: IXT! truss array
75 INTEGER, DIMENSION(NIXP,NUMELP), INTENT(in) :: IXP! beam array
76 INTEGER, DIMENSION(NIXR,NUMELR), INTENT(in) :: IXR! spring array
77 INTEGER, DIMENSION(NIXTG,NUMELTG), INTENT(in) :: IXTG! triangle array
78 INTEGER, DIMENSION(6,NUMELS10), INTENT(in) :: IXS10!< tetra10 data
79 INTEGER, DIMENSION(0:NUMNOD+1), INTENT(in) :: ADDCNEL ! address for the CNEL array
80 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
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
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER :: I,J,NODE_ID
89 INTEGER :: MY_SIZE
90 INTEGER :: NB_EDGE_R_PROC_M,NB_EDGE_R_PROC_S
91 INTEGER, DIMENSION(2) :: LOCAL_NODE,GLOBAL_NODE
92 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_EDGE_R_PROC
93
94 INTEGER :: SHIFT
95 INTEGER :: NB_RESULT_INTERSECT,NB_EDGE_1,NB_EDGE_2
96 INTEGER, DIMENSION(:), ALLOCATABLE :: RESULT_INTERSECT,INTERSECT_1,INTERSECT_2
97 INTEGER, DIMENSION(:), ALLOCATABLE :: TMP_ARRAY
98C-----------------------------------------------
99C E x t e r n a l F u n c t i o n s
100C-----------------------------------------------
101C-----------------------------------------------
102 ALLOCATE( list_edge_r_proc(4*nb_edge) )
103 nb_edge_r_proc_m = 0
104 nb_edge_r_proc_s = 0
105
106 ! --------------------------
107 ! working array : edge
108 ALLOCATE( result_intersect( shoot_struct%MAX_EDGE_NB ) )
109 ALLOCATE( intersect_1( shoot_struct%MAX_EDGE_NB ) )
110 ALLOCATE( intersect_2( shoot_struct%MAX_EDGE_NB ) )
111
112
113 DO i=1,nb_edge
114 global_node(1:2) = list_node( (i-1)*2+1:(i-1)*2+2)
115 DO j=1,2
116 local_node(j) = get_local_node_id(nodes,global_node(j))
117 ENDDO
118 ! ------------------
119 ! MAIN NODE
120 ! Initialization of edge/proc for the first node
121 node_id = local_node(1) ! get the node ID
122 nb_edge_1 = shoot_struct%SHIFT_M_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_M_NODE_EDGE(node_id) ! get the number of edge of the node
123 shift = shoot_struct%SHIFT_M_NODE_EDGE(node_id)
124 intersect_1(1:nb_edge_1) = shoot_struct%M_NODE_EDGE( shift+1:shift+nb_edge_1 )
125 ! ------------------
126 ! Initialization of edge/proc for the second node
127 node_id = local_node(2) ! get the node ID
128 nb_edge_2 = shoot_struct%SHIFT_M_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_M_NODE_EDGE(node_id) ! get the number of edge of the node
129 shift = shoot_struct%SHIFT_M_NODE_EDGE(node_id)
130 intersect_2(1:nb_edge_2) = shoot_struct%M_NODE_EDGE( shift+1:shift+nb_edge_2 )
131 ! ------------------
132
133 ! -----------------------
134 nb_result_intersect = 0
135 IF(nb_edge_1>0.AND.nb_edge_2>0) THEN
136 CALL intersect_2_sorted_sets( intersect_1,nb_edge_1,
137 . intersect_2,nb_edge_2,
138 . result_intersect,nb_result_intersect )
139 ELSE
140 nb_result_intersect = 0
141 ENDIF
142 ! end : intersection of edge : main nodes
143 ! -----------------------
144
145 IF(nb_edge_r_proc_m + nb_result_intersect > SIZE(list_edge_r_proc) ) THEN
146 ALLOCATE( tmp_array(nb_edge_r_proc_m) )
147 tmp_array(1:nb_edge_r_proc_m) = list_edge_r_proc(1:nb_edge_r_proc_m)
148 DEALLOCATE( list_edge_r_proc )
149 ALLOCATE( list_edge_r_proc( (nb_edge_r_proc_m+nb_result_intersect) * 2 ) )
150 list_edge_r_proc(1:nb_edge_r_proc_m) = tmp_array(1:nb_edge_r_proc_m)
151 ENDIF
152 list_edge_r_proc(1+nb_edge_r_proc_m:1+nb_edge_r_proc_m+nb_result_intersect) =
153 . result_intersect(1:nb_result_intersect)
154 nb_edge_r_proc_m = nb_edge_r_proc_m + nb_result_intersect
155 ENDDO
156
157
158
159 DO i=1,nb_edge
160 global_node(1:2) = list_node( (i-1)*2+1:(i-1)*2+2)
161 DO j=1,2
162 local_node(j) = get_local_node_id(nodes,global_node(j))
163 ENDDO
164 ! ------------------
165 ! SECONDARY NODE
166 ! Initialization of edge/proc for the first node
167 node_id = local_node(1) ! get the node ID
168 nb_edge_1 = shoot_struct%SHIFT_S_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_S_NODE_EDGE(node_id) ! get the number of edge of the node
169 shift = shoot_struct%SHIFT_S_NODE_EDGE(node_id)
170 intersect_1(1:nb_edge_1) = shoot_struct%S_NODE_EDGE( shift+1:shift+nb_edge_1 )
171 ! ------------------
172 ! Initialization of edge/proc for the second node
173 node_id = local_node(2) ! get the node ID
174 nb_edge_2 = shoot_struct%SHIFT_S_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_S_NODE_EDGE(node_id) ! get the number of edge of the node
175 shift = shoot_struct%SHIFT_S_NODE_EDGE(node_id)
176 intersect_2(1:nb_edge_2) = shoot_struct%S_NODE_EDGE( shift+1:shift+nb_edge_2 )
177 ! ------------------
178
179 ! -----------------------
180 nb_result_intersect = 0
181 IF(nb_edge_1>0.AND.nb_edge_2>0) THEN
182 CALL intersect_2_sorted_sets( intersect_1,nb_edge_1,
183 . intersect_2,nb_edge_2,
184 . result_intersect,nb_result_intersect )
185 ELSE
186 nb_result_intersect = 0
187 ENDIF
188 ! end : intersection of edge : secondary nodes
189 ! -----------------------
190 my_size = nb_edge_r_proc_s + nb_edge_r_proc_m
191 IF(my_size + nb_result_intersect > SIZE(list_edge_r_proc) ) THEN
192 ALLOCATE( tmp_array(my_size) )
193 tmp_array(1:my_size) = list_edge_r_proc(1:my_size)
194 DEALLOCATE( list_edge_r_proc )
195 ALLOCATE( list_edge_r_proc( (my_size+nb_result_intersect) * 2 ) )
196 list_edge_r_proc(1:my_size) = tmp_array(1:my_size)
197 DEALLOCATE( tmp_array )
198 ENDIF
199 list_edge_r_proc(1+my_size:my_size+nb_result_intersect) =
200 . result_intersect(1:nb_result_intersect)
201 nb_edge_r_proc_s = nb_edge_r_proc_s + nb_result_intersect
202 ENDDO
203
204 CALL check_edge_state( -1,nb_edge_r_proc_m,nb_edge_r_proc_s,
205 . list_edge_r_proc(1),list_edge_r_proc(1+nb_edge_r_proc_m),
206 . shoot_struct%SHIFT_INTERFACE,intbuf_tab,newfront,ipari,geo,
207 . ixs,ixc,ixt,ixp,ixr,ixtg,ixs10,
208 . addcnel,cnel,tag_node,tag_elem,shoot_struct )
209
210 DEALLOCATE( list_edge_r_proc )
211 DEALLOCATE( result_intersect )
212 DEALLOCATE( intersect_1 )
213 DEALLOCATE( intersect_2 )
214 RETURN
215 END SUBROUTINE find_edge_from_remote_proc
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
the
end diagonal values have been computed in the(sparse) matrix id.SOL
find_edge_from_remote_proc
subroutine find_edge_from_remote_proc(shoot_struct, nb_edge, list_node, intbuf_tab, nodes, newfront, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem)
Definition find_edge_from_remote_proc.F:39