OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_cell_exchange.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_cell_exchange (timers, nin, isendto, ircvfrom, nsn, nsnr, igap, ifq, inacti, nsnfiold, intth, ityp, stfns, nsv, nrtm, x, itied, nmn, inter_struct, sort_comm, got_preview)

Function/Subroutine Documentation

◆ spmd_cell_exchange()

subroutine spmd_cell_exchange ( type(timer_) timers,
integer nin,
integer, dimension(ninter+1,nspmd+1) isendto,
integer, dimension(ninter+1,nspmd+1) ircvfrom,
integer nsn,
integer nsnr,
integer igap,
integer ifq,
integer inacti,
integer, dimension(nspmd) nsnfiold,
integer intth,
integer ityp,
stfns,
integer, dimension(nsn) nsv,
integer nrtm,
x,
integer itied,
integer nmn,
type(inter_struct_type), dimension(ninter), intent(inout) inter_struct,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm,
integer got_preview )
Parameters
got_previewflag to indicate if -preview is available

Definition at line 44 of file spmd_cell_exchange.F.

48!$COMMENT
49! SPMD_CELL_EXCHANGE description :
50! exchange of secondary node data (x, v, temp...)
51! SPMD_CELL_EXCHANGE organization :
52! proc P needs to :
53! * send data if local NSN > 0 & remote NMN > 0 (--> SORT_COMM(NIN)%NB(P)>0)
54! * rcv data if local nmn > 0 & remote nsn > 0 (--> given by sort_comm(nin)%NBIRECV)
55!$ENDCOMMENT
56C-----------------------------------------------
57C M o d u l e s
58C-----------------------------------------------
59 USE timer_mod
60 USE fill_voxel_mod
61 USE tri7box
62 USE message_mod
63 USE multi_fvm_mod
64 USE inter_sorting_mod
65 USE inter_struct_mod
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69 USE spmd_comm_world_mod, ONLY : spmd_comm_world
70#include "implicit_f.inc"
71C-----------------------------------------------
72C M e s s a g e P a s s i n g
73C-----------------------------------------------
74#include "spmd.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "com01_c.inc"
79#include "com04_c.inc"
80#include "task_c.inc"
81#include "timeri_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 TYPE(TIMER_) :: TIMERS
86 INTEGER NIN, IFQ, INACTI, IGAP,INTTH,NSN,NSNR,
87 . ITIED,
88 . NSNFIOLD(NSPMD),
89 . ISENDTO(NINTER+1,NSPMD+1), IRCVFROM(NINTER+1,NSPMD+1),
90 . ITYP
91 INTEGER :: GOT_PREVIEW !< flag to indicate if -preview is available
92 INTEGER :: NMN
93 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT ! structure for interface
94 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
95 my_real :: stfns(nsn)
96 INTEGER :: NSV(NSN)
97 INTEGER :: NRTM
98 my_real :: x(3,numnod)
99C-----------------------------------------------
100C L o c a l V a r i a b l e s
101C-----------------------------------------------
102#ifdef MPI
103 INTEGER MSGTYP,INFO,I,NOD, DT_CST, LOC_PROC,P,IDEB,
104 . SIZ,J, L, BUFSIZ, LEN, NB, IERROR1, IAD,
105 . STATUS(MPI_STATUS_SIZE),IERROR,REQ_SB(NSPMD),
106 . REQ_RB(NSPMD),KK,NBIRECV,IRINDEXI(NSPMD),
107 . REQ_RD(NSPMD),REQ_SD(NSPMD),
108 . REQ_RC(NSPMD),REQ_SC(NSPMD),
109 . INDEXI,ISINDEXI(NSPMD),
110 . MSGOFF, MSGOFF2, MSGOFF3, MSGOFF4, MSGOFF5,
111 . RSIZ, ISIZ, L2, REQ_RD2(NSPMD),
112 . LEN2, RSHIFT, ISHIFT, ND, JDEB, Q, NBB
113
114 INTEGER :: P_LOC
115 INTEGER :: KEY,CODE
116
117 DATA msgoff4/6026/
118 DATA msgoff5/6027/
119
120 my_real
121 . xmaxb,ymaxb,zmaxb,xminb,yminb,zminb
122
123 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGNSNFI
124 my_real, DIMENSION(:,:), ALLOCATABLE :: xtmp
125 INTEGER :: ADRESS, LOCAL_RANK
126 INTEGER :: SIZE_S
127 INTEGER :: OFFSET(NSPMD)
128 INTEGER :: DUMMY(1)
129C-----------------------------------------------
130C S o u r c e L i n e s
131C-----------------------------------------------
132C
133C================================================================
134C tag des boites contenant des facettes
135C et creation des candidats
136C================================================================
137 loc_proc = ispmd + 1
138 ! save the old NSNFI values
139 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0
140 . .OR.itied/=0.OR.ityp==23.OR.ityp==24
141 . .OR.ityp==25) THEN
142 DO p = 1, nspmd
143 nsnfiold(p) = inter_struct(nin)%NSNFIOLD(p)
144 END DO
145 END IF
146 nsnr = sort_comm(nin)%NSNR
147 offset(1:nspmd) = nsnr+1
148
149
150 IF(.NOT. (ircvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0)) THEN
151
152 IF (imonm > 0) CALL startime(timers,25)
153
154 ! ---------------------------------------
155 ! prepare the rcv --> local number of main node > 0
156 ! allocation of buffer + reception
157 IF(ircvfrom(nin,loc_proc)/=0) THEN ! local nmn>0
158
159 rsiz = sort_comm(nin)%RSIZ
160 isiz = sort_comm(nin)%ISIZ
161
162 IF(nsnr>0) THEN ! nsn remote > 0 --> only on proc with nmn>0
163
164 ALLOCATE(xrem(rsiz,nsnr),stat=ierror)
165 ALLOCATE(irem(isiz,nsnr),stat=ierror)
166
167
168 IF(ierror/=0) THEN
169 CALL ancmsg(msgid=20,anmode=aninfo)
170 CALL arret(2)
171 ENDIF
172 ideb = 1
173 DO l = 1, sort_comm(nin)%NBIRECV
174 p = sort_comm(nin)%ISINDEXI(l)
175 len = nsnfi(nin)%P(p)*rsiz
176 msgtyp = msgoff4
177 offset(l) = ideb
178 CALL mpi_irecv(
179 1 xrem(1,ideb),len,real,it_spmd(p),
180 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
181
182 len2 = nsnfi(nin)%P(p)*isiz
183 msgtyp = msgoff5
184 CALL mpi_irecv(
185 1 irem(1,ideb),len2,mpi_integer,it_spmd(p),
186 2 msgtyp,spmd_comm_world,req_rd2(l),ierror)
187 ideb = ideb + nsnfi(nin)%P(p)
188 ENDDO
189 ENDIF
190 ENDIF
191 ! ---------------------------------------
192
193 ! ---------------------------------------
194 ! prepare the send --> local number of secondary node > 0 & remote number of main node > 0
195 DO p=1,nspmd
196 IF(p/=loc_proc) THEN
197 IF(sort_comm(nin)%NB(p)/=0 ) THEN
198 msgtyp = msgoff4
199 size_s = sort_comm(nin)%NB(p) * sort_comm(nin)%RSIZ
200 CALL mpi_isend(
201 1 sort_comm(nin)%DATA_PROC(p)%RBUF(1),size_s,real,it_spmd(p),msgtyp,
202 2 spmd_comm_world,sort_comm(nin)%REQ_SD2(p),ierror)
203 msgtyp = msgoff5
204 size_s = sort_comm(nin)%NB(p) * sort_comm(nin)%ISIZ
205 CALL mpi_isend(
206 1 sort_comm(nin)%DATA_PROC(p)%IBUF(1),size_s,mpi_integer,
207 2 it_spmd(p),msgtyp,
208 3 spmd_comm_world,sort_comm(nin)%REQ_SD3(p),ierror)
209 ENDIF
210 ENDIF
211 ENDDO
212
213
214 ! -----------------------------
215 if(got_preview == 1) THEN
216 ! finish the last groups of secondary nodes, if any
217 CALL fill_voxel_local_partial(nsn,nsv,nsnr,nrtm,numnod,x,stfns,inter_struct(nin),dummy,0)
218 ENDIF
219
220
221 ! ---------------------------------------
222 ! wait the rcv comm
223 IF(ircvfrom(nin,loc_proc)/=0) THEN ! nmn > 0
224 IF(nsnr>0) THEN ! nsnr>0 only on proc with nmn>0
225 DO l = 1, sort_comm(nin)%NBIRECV
226 CALL mpi_waitany(sort_comm(nin)%NBIRECV,req_rd,indexi,status,ierror) !XREM
227
228 ! CALL MPI_WAITANY(SORT_COMM(NIN)%NBIRECV,REQ_RD2,INDEXI,STATUS,IERROR)
229
230 if(got_preview==1) then
231 call fill_voxel_remote(
232 . offset(indexi),
233 . offset(indexi+1)-1,
234 . nsn,
235 . nsnr,
236 . inter_struct(nin)%nbx,
237 . inter_struct(nin)%nby,
238 . inter_struct(nin)%nbz,
239 . size(xrem,1),
240 . inter_struct(nin)%voxel,
241 . inter_struct(nin)%next_nod,
242 . inter_struct(nin)%size_node,
243 . inter_struct(nin)%nb_voxel_on,
244 . inter_struct(nin)%list_nb_voxel_on,
245 . inter_struct(nin)%last_nod,
246 . xrem,
247 . inter_struct(nin)%box_limit_main)
248 endif
249 CALL mpi_wait(req_rd2(indexi),status,ierror) !IREM
250
251
252 ENDDO
253 !set specifics IREM and XREM indexes for INT24 sorting
254 igapxremp = irem(4,1)
255 i24xremp = irem(5,1)
256 i24iremp = irem(6,1)
257 ENDIF
258 ENDIF
259
260 ! ---------------------------------------
261 ! wait the send comm : only for proc with nsn>0 & nmn>0
262 ! for proc with nsn>0 & nmn=0, wait is done after the sort
263 IF(isendto(nin,loc_proc)/=0) THEN ! nsn >0
264 DO p = 1, nspmd
265 IF(ircvfrom(nin,p)/=0) THEN ! nmn >0
266 IF(p/=loc_proc) THEN
267 IF(sort_comm(nin)%NB(p)/=0) THEN
268 IF(nmn/=0) THEN
269 CALL mpi_wait(sort_comm(nin)%REQ_SD2(p),status,ierror)
270 DEALLOCATE(sort_comm(nin)%DATA_PROC(p)%RBUF)
271 ! can be moved if local nsn>0 & local nmn=0
272 CALL mpi_wait(sort_comm(nin)%REQ_SD3(p),status,ierror)
273 DEALLOCATE(sort_comm(nin)%DATA_PROC(p)%IBUF)
274 sort_comm(nin)%NB(p) = 0
275 ENDIF
276 END IF
277 ENDIF
278 ENDIF
279 ENDDO
280 ENDIF
281 ! ---------------------------------------
282 ELSE
283
284 if(got_preview == 1) THEN
285 ! finish the last groups of secondary nodes, if any
286 CALL fill_voxel_local_partial(nsn,nsv,nsnr,nrtm,numnod,x,stfns,inter_struct(nin),dummy,0)
287 ENDIF
288
289 ENDIF
290
291 IF (imonm > 0) CALL stoptime(timers,25)
292#endif
293 RETURN
294
my_real
#define my_real
Definition cppsort.cpp:32
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_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
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_struct_mod
Definition inter_struct_mod.F:49
message_mod
Definition message_mod.F:1249
tri7box::i24iremp
integer i24iremp
Definition tri7box.F:423
tri7box::i24xremp
integer i24xremp
Definition tri7box.F:423
tri7box::igapxremp
integer igapxremp
Definition tri7box.F:423
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135