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, LOC_PROC, P, IDEB,
104 . L, LEN,
105 . STATUS(MPI_STATUS_SIZE),IERROR,
106 . REQ_RD(NSPMD),
107 . INDEXI,
108 . MSGOFF4,MSGOFF5,
109 . RSIZ, ISIZ, REQ_RD2(NSPMD),
110 . LEN2
111 DATA msgoff4/6026/
112 DATA msgoff5/6027/
113 INTEGER :: SIZE_S
114 INTEGER :: OFFSET(NSPMD)
115 INTEGER :: DUMMY(1)
116C-----------------------------------------------
117C S o u r c e L i n e s
118C-----------------------------------------------
119C
120C================================================================
121C tag of the boxes containing facets
122C and creation of candidates
123C================================================================
124 loc_proc = ispmd + 1
125 ! save the old nsnfi values
126 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0
127 . .OR.itied/=0.OR.ityp==23.OR.ityp==24
128 . .OR.ityp==25) THEN
129 DO p = 1, nspmd
130 nsnfiold(p) = inter_struct(nin)%NSNFIOLD(p)
131 END DO
132 END IF
133 nsnr = sort_comm(nin)%NSNR
134 offset(1:nspmd) = nsnr+1
135
136
137 IF(.NOT. (ircvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0)) THEN
138
139 IF (imonm > 0) CALL startime(timers,25)
140
141 ! ---------------------------------------
142 ! prepare the rcv --> local number of main node > 0
143 ! allocation of buffer + reception
144 IF(ircvfrom(nin,loc_proc)/=0) THEN ! local nmn>0
145
146 rsiz = sort_comm(nin)%RSIZ
147 isiz = sort_comm(nin)%ISIZ
148
149 IF(nsnr>0) THEN ! nsn remote > 0 --> only on proc with nmn>0
150
151 ALLOCATE(xrem(rsiz,nsnr),stat=ierror)
152 ALLOCATE(irem(isiz,nsnr),stat=ierror)
153
154
155 IF(ierror/=0) THEN
156 CALL ancmsg(msgid=20,anmode=aninfo)
157 CALL arret(2)
158 ENDIF
159 ideb = 1
160 DO l = 1, sort_comm(nin)%NBIRECV
161 p = sort_comm(nin)%ISINDEXI(l)
162 len = nsnfi(nin)%P(p)*rsiz
163 msgtyp = msgoff4
164 offset(l) = ideb
165 CALL mpi_irecv(
166 1 xrem(1,ideb),len,real,it_spmd(p),
167 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
168
169 len2 = nsnfi(nin)%P(p)*isiz
170 msgtyp = msgoff5
171 CALL mpi_irecv(
172 1 irem(1,ideb),len2,mpi_integer,it_spmd(p),
173 2 msgtyp,spmd_comm_world,req_rd2(l),ierror)
174 ideb = ideb + nsnfi(nin)%P(p)
175 ENDDO
176 ENDIF
177 ENDIF
178 ! ---------------------------------------
179
180 ! ---------------------------------------
181 ! prepare the send --> local number of secondary node > 0 & remote number of main node > 0
182 DO p=1,nspmd
183 IF(p/=loc_proc) THEN
184 IF(sort_comm(nin)%NB(p)/=0 ) THEN
185 msgtyp = msgoff4
186 size_s = sort_comm(nin)%NB(p) * sort_comm(nin)%RSIZ
187 CALL mpi_isend(
188 1 sort_comm(nin)%DATA_PROC(p)%RBUF(1),size_s,real,it_spmd(p),msgtyp,
189 2 spmd_comm_world,sort_comm(nin)%REQ_SD2(p),ierror)
190 msgtyp = msgoff5
191 size_s = sort_comm(nin)%NB(p) * sort_comm(nin)%ISIZ
192 CALL mpi_isend(
193 1 sort_comm(nin)%DATA_PROC(p)%IBUF(1),size_s,mpi_integer,
194 2 it_spmd(p),msgtyp,
195 3 spmd_comm_world,sort_comm(nin)%REQ_SD3(p),ierror)
196 ENDIF
197 ENDIF
198 ENDDO
199
200
201 ! -----------------------------
202 if(got_preview == 1) THEN
203 ! finish the last groups of secondary nodes, if any
204 CALL fill_voxel_local_partial(nsn,nsv,nsnr,nrtm,numnod,x,stfns,inter_struct(nin),dummy,0)
205 ENDIF
206
207
208 ! ---------------------------------------
209 ! wait the rcv comm
210 IF(ircvfrom(nin,loc_proc)/=0) THEN ! nmn > 0
211 IF(nsnr>0) THEN ! nsnr>0 only on proc with nmn>0
212 DO l = 1, sort_comm(nin)%NBIRECV
213 CALL mpi_waitany(sort_comm(nin)%NBIRECV,req_rd,indexi,status,ierror) !XREM
214
215 ! CALL MPI_WAITANY(SORT_COMM(NIN)%NBIRECV,REQ_RD2,INDEXI,STATUS,IERROR)
216
217 if(got_preview==1) then
218 call fill_voxel_remote(
219 . offset(indexi),
220 . offset(indexi+1)-1,
221 . nsn,
222 . nsnr,
223 . inter_struct(nin)%nbx,
224 . inter_struct(nin)%nby,
225 . inter_struct(nin)%nbz,
226 . size(xrem,1),
227 . inter_struct(nin)%voxel,
228 . inter_struct(nin)%next_nod,
229 . inter_struct(nin)%size_node,
230 . inter_struct(nin)%nb_voxel_on,
231 . inter_struct(nin)%list_nb_voxel_on,
232 . inter_struct(nin)%last_nod,
233 . xrem,
234 . inter_struct(nin)%box_limit_main)
235 endif
236 CALL mpi_wait(req_rd2(indexi),status,ierror) !IREM
237
238
239 ENDDO
240 !set specifics IREM and XREM indexes for INT24 sorting
241 igapxremp = irem(4,1)
242 i24xremp = irem(5,1)
243 i24iremp = irem(6,1)
244 ENDIF
245 ENDIF
246
247 ! ---------------------------------------
248 ! wait the send comm : only for proc with nsn>0 & nmn>0
249 ! for proc with nsn>0 & nmn=0, wait is done after the sort
250 IF(isendto(nin,loc_proc)/=0) THEN ! nsn >0
251 DO p = 1, nspmd
252 IF(ircvfrom(nin,p)/=0) THEN ! nmn >0
253 IF(p/=loc_proc) THEN
254 IF(sort_comm(nin)%NB(p)/=0) THEN
255 IF(nmn/=0) THEN
256 CALL mpi_wait(sort_comm(nin)%REQ_SD2(p),status,ierror)
257 DEALLOCATE(sort_comm(nin)%DATA_PROC(p)%RBUF)
258 ! can be moved if local nsn>0 & local nmn=0
259 CALL mpi_wait(sort_comm(nin)%REQ_SD3(p),status,ierror)
260 DEALLOCATE(sort_comm(nin)%DATA_PROC(p)%IBUF)
261 sort_comm(nin)%NB(p) = 0
262 ENDIF
263 END IF
264 ENDIF
265 ENDIF
266 ENDDO
267 ENDIF
268 ! ---------------------------------------
269 ELSE
270
271 if(got_preview == 1) THEN
272 ! finish the last groups of secondary nodes, if any
273 CALL fill_voxel_local_partial(nsn,nsv,nsnr,nrtm,numnod,x,stfns,inter_struct(nin),dummy,0)
274 ENDIF
275
276 ENDIF
277
278 IF (imonm > 0) CALL stoptime(timers,25)
279#endif
280 RETURN
281
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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:1257
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:895
arret
subroutine arret(nn)
Definition arret.F:86
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135