OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_deleted_surf_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!|| spmd_exch_deleted_surf_edge ../engine/source/mpi/interfaces/spmd_exch_deleted_surf_edge.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| find_edge_from_remote_proc ../engine/source/interfaces/interf/find_edge_from_remote_proc.F
29!|| find_surface_from_remote_proc ../engine/source/interfaces/interf/find_surface_from_remote_proc.F
30!||--- uses -----------------------------------------------------
31!|| array_mod ../common_source/modules/array_mod.F
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
34!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
35!|| shooting_node_mod ../engine/share/modules/shooting_node_mod.F90
36!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
37!||====================================================================
38 SUBROUTINE spmd_exch_deleted_surf_edge( IAD_ELEM,NODES,SHOOT_STRUCT,INTBUF_TAB,NEWFRONT,
39 . IPARI,GEO,
40 . IXS,IXC,IXT,IXP,IXR,IXTG,IXS10,
41 . ADDCNEL,CNEL,TAG_NODE,TAG_ELEM )
42!$COMMENT
43! SPMD_EXCH_DELETED_SURF_EDGE description
44! exchange of edge/surface that need to be deactivated
45! SPMD_EXCH_DELETED_SURF_EDGE organization
46! step 1 : exchange the number of edge and surface
47! step 2 : allocation of buffer
48! step 3 : exchange the list of edge and surface
49! step 4 : deactivate the edge/surface
50!$ENDCOMMENT
51 USE nodal_arrays_mod
52 USE array_mod
53 USE shooting_node_mod
54 USE intbufdef_mod
55 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59 USE spmd_comm_world_mod, ONLY : spmd_comm_world
60#include "implicit_f.inc"
61C-----------------------------------------------------------------
62C M e s s a g e P a s s i n g
63C-----------------------------------------------
64#include "spmd.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "com01_c.inc"
69#include "task_c.inc"
70#include "com04_c.inc"
71#include "scr17_c.inc"
72#include "param_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER, DIMENSION(2,NSPMD+1), INTENT(in) :: IAD_ELEM
77 TYPE(nodal_arrays_), INTENT(INOUT) :: NODES
78 TYPE(shooting_node_type), INTENT(inout) :: SHOOT_STRUCT ! structure for shooting node algo
79 TYPE(intbuf_struct_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB ! interface data
80 INTEGER, DIMENSION(NINTER), INTENT(inout) :: NEWFRONT ! array for sorting : 1 --> need to sort the interface NIN
81 INTEGER, DIMENSION(NIXS,NUMELS),TARGET, INTENT(in) :: IXS ! solid array
82 INTEGER, DIMENSION(NIXC,NUMELC),TARGET, INTENT(in) :: IXC ! shell array
83 INTEGER, DIMENSION(NIXT,NUMELT),TARGET, INTENT(in) :: IXT! truss array
84 INTEGER, DIMENSION(NIXP,NUMELP),TARGET, INTENT(in) :: IXP! beam array
85 INTEGER, DIMENSION(NIXR,NUMELR),TARGET, INTENT(in) :: IXR! spring array
86 INTEGER, DIMENSION(NIXTG,NUMELTG),TARGET, INTENT(in) :: IXTG! triangle array
87 INTEGER, DIMENSION(6,NUMELS10), INTENT(in) :: IXS10!< tetra10 data
88 INTEGER, DIMENSION(0:NUMNOD+1), INTENT(in) :: ADDCNEL ! address for the CNEL array
89 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
90 my_real, DIMENSION(NPROPG,NUMGEO), INTENT(in) :: geo
91 INTEGER, DIMENSION(0:LCNEL), INTENT(in) :: CNEL ! connectivity node-->element
92 INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: TAG_NODE
93 INTEGER, DIMENSION(NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG), INTENT(inout) :: TAG_ELEM
94#ifdef MPI
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER :: I,J,K
99 INTEGER :: MSGTYP,MSGOFF1,MSGOFF2
100 INTEGER :: PROC_ID,SIZE_BUFFER_R
101 INTEGER :: RECV_NB,RECV_SURF_NB
102 INTEGER, DIMENSION(2,NSPMD) :: SURF_PER_PROC,REMOTE_SURF_PER_PROC,REMOTE_SURF_PER_PROC_2
103 INTEGER, DIMENSION(NSPMD) :: INDEX_PROC,INDEX_BUFFER_R,INDEX_R_PROC,INDEX_R_PROC_2,INDEX_BUFFER_R_2
104 INTEGER, DIMENSION(NSPMD) :: REQUEST_SIZE_R,REQUEST_SIZE_S
105 INTEGER, DIMENSION(NSPMD) :: REQUEST_SURF_R,REQUEST_SURF_S
106
107 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS_MPI
108 INTEGER, DIMENSION(MPI_STATUS_SIZE,NSPMD) :: ARRAY_STATUSES
109 INTEGER :: IERROR,FRONTIER_ELM,NB_SURFACE,ADDRESS,NB_EDGE
110
111 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFFER_R
112 TYPE(array_type), DIMENSION(NSPMD) :: BUFFER_S
113
114 DATA msgoff1/13010/
115 DATA msgoff2/13011/
116! ----------------------------------------
117
118
119 surf_per_proc(1:2,1:nspmd) = 0
120 remote_surf_per_proc(1:2,1:nspmd) = 0
121
122 ! ----------------
123 ! count the number of surface (ie. 4 nodes) per processor
124 DO i=1,shoot_struct%SAVE_PROC_NB,5
125 proc_id = shoot_struct%SAVE_PROC(i)
126 surf_per_proc(1,proc_id) = surf_per_proc(1,proc_id) + 1
127 ENDDO
128 ! ----------------
129 ! count the number of edge (ie. 2 nodes) per processor
130 DO i=1,shoot_struct%SAVE_PROC_NB_EDGE,3
131 proc_id = shoot_struct%SAVE_PROC_EDGE(i)
132 surf_per_proc(2,proc_id) = surf_per_proc(2,proc_id) + 1
133 ENDDO
134 ! ----------------
135 ! allocate the S buffer
136 index_proc(1:nspmd) = 0
137 DO i=1,nspmd
138 buffer_s(i)%SIZE_INT_ARRAY_1D = 4*surf_per_proc(1,i) +
139 . 2 * surf_per_proc(2,i)
140 CALL alloc_1d_array(buffer_s(i))
141 ENDDO
142 ! ----------------
143 ! initialize the S buffer
144 ! surface initialization
145 DO i=1,shoot_struct%SAVE_PROC_NB,5
146 proc_id = shoot_struct%SAVE_PROC(i)
147 DO j=1,4
148 index_proc(proc_id) = index_proc(proc_id) + 1
149 buffer_s(proc_id)%INT_ARRAY_1D( index_proc(proc_id) ) = shoot_struct%SAVE_PROC(i+j)
150 ENDDO
151 ENDDO
152
153 ! main edge initialization
154 DO i=1,shoot_struct%SAVE_PROC_NB_EDGE,3
155 proc_id = shoot_struct%SAVE_PROC_EDGE(i)
156 DO j=1,2
157 index_proc(proc_id) = index_proc(proc_id) + 1
158 buffer_s(proc_id)%INT_ARRAY_1D( index_proc(proc_id) ) = shoot_struct%SAVE_PROC_EDGE(i+j)
159 ENDDO
160 ENDDO
161 ! ----------------
162
163 ! ----------------
164 ! receive the data : "number of 4 nodes defining a surface + number of 2 nodes def. an edge"
165 recv_nb = 0
166 DO i=1,nspmd
167 frontier_elm = iad_elem(1,i+1)-iad_elem(1,i)
168 IF(frontier_elm>0) THEN
169 recv_nb = recv_nb + 1
170 index_r_proc(recv_nb) = i
171 msgtyp = msgoff1
172 CALL mpi_irecv( remote_surf_per_proc(1,recv_nb),2,mpi_integer,it_spmd(i),msgtyp,
173 . spmd_comm_world,request_size_r(recv_nb),ierror )
174 ENDIF
175 ENDDO
176 ! ----------------
177
178 ! ----------------
179 ! send the data : "number of 4 nodes defining a surface + number of 2 nodes def. an edge"
180 DO i=1,nspmd
181 frontier_elm = iad_elem(1,i+1)-iad_elem(1,i)
182 IF(frontier_elm>0) THEN
183 msgtyp = msgoff1
184 CALL mpi_isend( surf_per_proc(1,i),2,mpi_integer,it_spmd(i),msgtyp,
185 . spmd_comm_world,request_size_s(i),ierror )
186 ENDIF
187 ENDDO
188 ! ----------------
189
190 ! ----------------
191 ! wait the R comm "number of 4 nodes defining a surface + number of 2 nodes def. an edge"
192 IF(recv_nb>0) CALL mpi_waitall(recv_nb,request_size_r,array_statuses,ierror)
193 ! allocation of R buffer "list of 4 nodes defining a surface"
194 size_buffer_r = 0
195 index_buffer_r(1:nspmd) = 0
196 index_buffer_r(1) = 1
197 DO i=1,recv_nb
198 IF(i>1) index_buffer_r(i) = index_buffer_r(i-1) + 4*remote_surf_per_proc(1,i-1) +
199 . 2 * remote_surf_per_proc(2,i-1)
200 size_buffer_r = size_buffer_r + 4*remote_surf_per_proc(1,i) + 2*remote_surf_per_proc(2,i)
201 ENDDO
202 ALLOCATE( buffer_r( size_buffer_r ) )
203 ! ----------------
204
205 ! ----------------
206 ! receive the data : "list of 4 nodes defining a surface + 2 nodes def. an edge"
207 recv_surf_nb = 0
208 index_buffer_r_2(1:nspmd) = 0
209 remote_surf_per_proc_2(1:2,1:nspmd) = 0
210 index_r_proc_2(1:nspmd) = 0
211 DO i=1,recv_nb
212 IF(remote_surf_per_proc(1,i)+remote_surf_per_proc(2,i)>0) THEN
213 proc_id = index_r_proc(i)
214 msgtyp = msgoff2
215 recv_surf_nb = recv_surf_nb + 1
216 index_r_proc_2(recv_surf_nb) = index_r_proc(i)
217 index_buffer_r_2(recv_surf_nb) = index_buffer_r(i)
218 remote_surf_per_proc_2(1:2,recv_surf_nb) = remote_surf_per_proc(1:2,i)
219 CALL mpi_irecv( buffer_r(index_buffer_r(i)),4*remote_surf_per_proc(1,i)+2*remote_surf_per_proc(2,i),
220 . mpi_integer,it_spmd(proc_id),msgtyp,
221 . spmd_comm_world,request_surf_r(recv_surf_nb),ierror )
222 ENDIF
223 ENDDO
224 ! ----------------
225
226
227 ! ----------------
228 ! send the data : "list of 4 nodes defining a surface + 2 nodes def. an edge"
229 DO i=1,nspmd
230 IF(surf_per_proc(1,i)+surf_per_proc(2,i)>0) THEN
231 msgtyp = msgoff2
232 CALL mpi_isend( buffer_s(i)%INT_ARRAY_1D,index_proc(i),mpi_integer,it_spmd(i),msgtyp,
233 . spmd_comm_world,request_surf_s(i),ierror )
234 ENDIF
235 ENDDO
236 ! ----------------
237
238 ! ----------------
239 DO i=1,recv_surf_nb
240 CALL mpi_waitany(recv_surf_nb,request_surf_r,k,status_mpi,ierror)
241 proc_id = index_r_proc_2(k)
242 nb_surface = remote_surf_per_proc_2(1,k)
243 address = index_buffer_r_2(k)
244
245 CALL find_surface_from_remote_proc(shoot_struct,nb_surface,buffer_r(address),intbuf_tab,nodes,
246 . ipari,geo,
247 . ixs,ixc,ixt,ixp,ixr,ixtg,ixs10,
248 . addcnel,cnel,tag_node,tag_elem )
249 nb_edge = remote_surf_per_proc_2(2,k)
250 address = index_buffer_r_2(k)+4*nb_surface
251 CALL find_edge_from_remote_proc( shoot_struct,nb_edge,buffer_r(address),intbuf_tab,nodes,
252 . newfront,ipari,geo,
253 . ixs,ixc,ixt,ixp,ixr,ixtg,ixs10,
254 . addcnel,cnel,tag_node,tag_elem )
255 ENDDO
256 ! ----------------
257
258 ! ----------------
259 DO i=1,nspmd
260 frontier_elm = iad_elem(1,i+1)-iad_elem(1,i)
261 IF(frontier_elm>0) THEN
262 CALL mpi_wait(request_size_s(i),status_mpi,ierror)
263 ENDIF
264 ENDDO
265
266 DO i=1,nspmd
267 IF(surf_per_proc(1,i)+surf_per_proc(2,i)>0) THEN
268 CALL mpi_wait(request_surf_s(i),status_mpi,ierror)
269 ENDIF
270 ENDDO
271 ! ----------------
272
273 ! ----------------
274 DO i=1,nspmd
275 CALL dealloc_1d_array(buffer_s(i))
276 ENDDO
277 ! ----------------
278#endif
279 RETURN
280 END SUBROUTINE spmd_exch_deleted_surf_edge
281
282
283! ----------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
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
find_surface_from_remote_proc
subroutine find_surface_from_remote_proc(shoot_struct, nb_surface, list_node, intbuf_tab, nodes, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem)
Definition find_surface_from_remote_proc.F:39
array_mod::alloc_1d_array
Definition array_mod.F:95
array_mod::dealloc_1d_array
Definition array_mod.F:99
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_waitall
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
Definition mpi.f:536
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
array_mod
Definition array_mod.F:51
spmd_exch_deleted_surf_edge
subroutine spmd_exch_deleted_surf_edge(iad_elem, nodes, shoot_struct, intbuf_tab, newfront, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem)
Definition spmd_exch_deleted_surf_edge.F:42
array_mod::array_type
Definition array_mod.F:61