OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_inter_18.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exch_inter_18 (ninter, nspmd, number_inter18, sxcell, inter18_list, xcell, multi_fvm, xcell_remote, intbuf_tab, ale_connectivity)

Function/Subroutine Documentation

◆ spmd_exch_inter_18()

subroutine spmd_exch_inter_18 ( integer, intent(in) ninter,
integer, intent(in) nspmd,
integer, intent(inout) number_inter18,
integer, intent(in) sxcell,
integer, dimension(number_inter18), intent(inout) inter18_list,
intent(in) xcell,
type(multi_fvm_struct), intent(inout) multi_fvm,
type(array_type), dimension(ninter), intent(inout) xcell_remote,
type(intbuf_struct_), dimension(ninter), intent(inout) intbuf_tab,
type(t_ale_connectivity), intent(in) ale_connectivity )
Parameters
[in]ninternumber of interface
[in]nspmdnumber of mpi tasks
[in,out]number_inter18number of interface 18
[in]sxcellsize of characteristic length array
[in,out]inter18_listlist of interface 18
[in,out]xcell_remoteremote data structure for interface 18
[in,out]intbuf_tabinterface data
[in]ale_connectivityale connectivity structure

Definition at line 38 of file spmd_exch_inter_18.F.

40!$COMMENT
41! spmd_exch_inter_18 description : exchange of remote data (xcell) between processor
42!
43! SPMD_EXCH_INTER_18 organization :
44! * allocation of buffer + remote xcell array
45! * compute the size & adress for mpi comm
46! * post the rcv comm
47! * send the data
48! * wait the rcv comm + save the remote data
49! * wait the send comm
50!$ENDCOMMENT
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE intbufdef_mod
55 USE array_mod
56 USE tri7box
57 USE multi_fvm_mod
58 USE ale_connectivity_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62 USE spmd_comm_world_mod, ONLY : spmd_comm_world
63#include "implicit_f.inc"
64C-----------------------------------------------
65C M e s s a g e P a s s i n g
66C-----------------------------------------------
67#include "spmd.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "task_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER, INTENT(in) :: NINTER !< number of interface
76 INTEGER, INTENT(in) :: NSPMD !< number of mpi tasks
77 INTEGER, INTENT(inout) :: NUMBER_INTER18 !< number of interface 18
78 INTEGER, INTENT(in) :: SXCELL !< size of characteristic length array
79 INTEGER, DIMENSION(NUMBER_INTER18), INTENT(inout) :: INTER18_LIST !< list of interface 18
80 my_real, DIMENSION(3,SXCELL), INTENT(in) :: xcell !< characteristic length
81 TYPE(MULTI_FVM_STRUCT), INTENT(inout) :: MULTI_FVM
82 TYPE(array_type), DIMENSION(NINTER), INTENT(inout) :: XCELL_REMOTE !< remote data structure for interface 18
83 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB !< interface data
84 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY !< ale connectivity structure
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88#ifdef MPI
89 INTEGER :: I,J,K,IJK,P,N
90 INTEGER :: MY_SIZE
91 INTEGER :: LOC_PROC
92 INTEGER :: NIN,NODE_ID,ELEM_ID,NUMBER_REMOTE_NODE
93 INTEGER :: BUFFER_SEND_SIZE,BUFFER_RCV_SIZE
94 INTEGER :: SEND_SIZE,RCV_SIZE
95 INTEGER :: LOCAL_ADRESS
96 INTEGER, DIMENSION(NINTER) :: ADRESS_INTER
97 INTEGER, DIMENSION(NSPMD+1) :: ADRESS_SEND,ADRESS_RCV
98
99 INTEGER :: IAD1,IAD2
100 my_real :: dl
101 my_real, DIMENSION(:), ALLOCATABLE :: buffer_send,buffer_rcv
102
103 INTEGER :: MSGTYP
104 INTEGER :: ERROR_MPI
105 INTEGER, DIMENSION(NSPMD) :: REQUEST_SEND,REQUEST_RCV
106 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS_MPI
107 INTEGER :: MSGOFF
108 DATA msgoff/13016/
109! --------------------------------------------------------------------
110 loc_proc = ispmd + 1
111
112 ! ---------------------------
113 ! allocation of remote array
114 DO i=1,number_inter18
115 nin = inter18_list(i)
116 my_size = 0
117 DO p=1,nspmd
118 my_size = my_size + nsnfi(nin)%P(p)
119 ENDDO
120 IF(xcell_remote(nin)%SIZE_MY_REAL_ARRAY_1D < my_size) THEN
121 IF( ALLOCATED(xcell_remote(nin)%MY_REAL_ARRAY_1D) ) CALL dealloc_my_real_1d_array(xcell_remote(nin))
122 xcell_remote(nin)%SIZE_MY_REAL_ARRAY_1D = my_size
123 CALL alloc_my_real_1d_array(xcell_remote(nin))
124 ENDIF
125 ENDDO
126 ! ---------------------------
127
128 ! ---------------------------
129 ! compute the size (send & rcv) and the adress in the buffer (send & rcv)
130 buffer_send_size = 0
131 buffer_rcv_size = 0
132
133 adress_send(1:nspmd+1) = 0
134 adress_rcv(1:nspmd+1) = 0
135
136 DO p=1,nspmd
137 adress_send(p) = buffer_send_size + 1
138 adress_rcv(p) = buffer_rcv_size + 1
139 DO i=1,number_inter18
140 nin = inter18_list(i)
141 buffer_send_size = buffer_send_size + nsnsi(nin)%P(p)
142 buffer_rcv_size = buffer_rcv_size + nsnfi(nin)%P(p)
143 ENDDO
144 ENDDO
145
146 adress_send(nspmd+1) = buffer_send_size + 1
147 adress_rcv(nspmd+1) = buffer_rcv_size + 1
148 ALLOCATE( buffer_send(buffer_send_size) )
149 ALLOCATE( buffer_rcv(buffer_rcv_size) )
150 ! ---------------------------
151
152 ! ---------------------------
153 ! rcv of buffer
154 DO p=1,nspmd
155 rcv_size = adress_rcv(p+1)-adress_rcv(p)
156 IF(p/=loc_proc.AND.rcv_size>0) THEN
157 msgtyp = msgoff
158 CALL mpi_irecv( buffer_rcv(adress_rcv(p)),rcv_size,real,
159 . it_spmd(p),msgtyp,spmd_comm_world,request_rcv(p),error_mpi )
160 ENDIF
161 ENDDO
162 ! ---------------------------
163
164 ! ---------------------------
165 ! initialize the buffer (send)
166 ijk = 0
167 adress_inter(1:ninter) = 0
168 DO p=1,nspmd
169 IF(p/=loc_proc) THEN
170 DO i=1,number_inter18
171 nin = inter18_list(i)
172 DO j =1,nsnsi(nin)%P(p)
173 n = nsvsi(nin)%P(adress_inter(nin)+j)
174 node_id = intbuf_tab(nin)%NSV(n)
175 dl = zero
176 IF(.NOT.multi_fvm%IS_USED) THEN
177 iad1 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id)
178 iad2 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id + 1) - 1
179 DO k=iad1,iad2
180 elem_id = ale_connectivity%NE_CONNECT%CONNECTED(k)
181 dl=max(dl, xcell(1,elem_id))
182 ENDDO
183 ELSE
184 dl=xcell(1,node_id)
185 ENDIF
186 ijk = ijk + 1
187 buffer_send(ijk) = dl
188 ENDDO
189 adress_inter(nin) = adress_inter(nin) + nsnsi(nin)%P(p)
190 ENDDO
191 ENDIF
192 ENDDO
193 ! ---------------------------
194
195 ! ---------------------------
196 ! send the buffer
197 DO p=1,nspmd
198 send_size = adress_send(p+1)-adress_send(p)
199 IF(p/=loc_proc.AND.send_size>0) THEN
200 msgtyp = msgoff
201 CALL mpi_isend( buffer_send(adress_send(p)),send_size,real,
202 . it_spmd(p),msgtyp,spmd_comm_world,request_send(p),error_mpi )
203 ENDIF
204 ENDDO
205 ! ---------------------------
206
207 ! ---------------------------
208 ! wait the rcv comm
209 ! and save the remote data in the remote XCELL array
210 adress_inter(1:ninter) = 0
211 DO p=1,nspmd
212 rcv_size = adress_rcv(p+1)-adress_rcv(p)
213 IF(p/=loc_proc.AND.rcv_size>0) THEN
214 local_adress = 0
215 msgtyp = msgoff
216 CALL mpi_wait(request_rcv(p),status_mpi,error_mpi)
217 DO i=1,number_inter18
218 nin = inter18_list(i)
219 number_remote_node = nsnfi(nin)%P(p)
220 IF(number_remote_node>0) THEN
221 DO j =1,number_remote_node
222 xcell_remote(nin)%MY_REAL_ARRAY_1D(adress_inter(nin)+j) = buffer_rcv(local_adress+adress_rcv(p)-1+j)
223 ENDDO
224 adress_inter(nin) = adress_inter(nin) + number_remote_node
225 local_adress = local_adress + number_remote_node
226 ENDIF
227 ENDDO
228 ENDIF
229 ENDDO
230 ! ---------------------------
231
232 ! ---------------------------
233 ! wait the send comm
234 DO p=1,nspmd
235 send_size = adress_send(p+1)-adress_send(p)
236 IF(p/=loc_proc.AND.send_size>0) THEN
237 CALL mpi_wait(request_send(p),status_mpi,error_mpi)
238 ENDIF
239 ENDDO
240 ! ---------------------------
241
242 DEALLOCATE( buffer_send )
243 DEALLOCATE( buffer_rcv )
244
245! --------------------------------------------------------------------
246#endif
247 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
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_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
array_mod
Definition array_mod.F:51
array_mod::alloc_my_real_1d_array
subroutine alloc_my_real_1d_array(this)
Definition array_mod.F:233
array_mod::dealloc_my_real_1d_array
subroutine dealloc_my_real_1d_array(this)
Definition array_mod.F:251
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_exch_inter_18
subroutine spmd_exch_inter_18(ninter, nspmd, number_inter18, sxcell, inter18_list, xcell, multi_fvm, xcell_remote, intbuf_tab, ale_connectivity)
Definition spmd_exch_inter_18.F:40