OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_deleted_surf_edge.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.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 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)

Function/Subroutine Documentation

◆ spmd_exch_deleted_surf_edge()

subroutine spmd_exch_deleted_surf_edge ( integer, dimension(2,nspmd+1), intent(in) iad_elem,
type(nodal_arrays_), intent(inout) nodes,
type(shooting_node_type), intent(inout) shoot_struct,
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), target ixs,
integer, dimension(nixc,numelc), intent(in), target ixc,
integer, dimension(nixt,numelt), intent(in), target ixt,
integer, dimension(nixp,numelp), intent(in), target ixp,
integer, dimension(nixr,numelr), intent(in), target ixr,
integer, dimension(nixtg,numeltg), intent(in), target 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 )
Parameters
[in]ixs10tetra10 data

Definition at line 37 of file spmd_exch_deleted_surf_edge.F.

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
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