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