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 38 of file spmd_exch_deleted_surf_edge.F.

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