OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_cell_exchange.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| spmd_cell_exchange ../engine/source/mpi/generic/spmd_cell_exchange.f
25!||--- called by ------------------------------------------------------
26!|| inter_sort_07 ../engine/source/interfaces/int07/inter_sort_07.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| fill_voxel_local_partial ../engine/source/interfaces/intsort/fill_voxel.F90
31!|| fill_voxel_remote ../engine/source/interfaces/intsort/fill_voxel.F90
32!|| startime ../engine/source/system/timer_mod.F90
33!|| stoptime ../engine/source/system/timer_mod.F90
34!||--- uses -----------------------------------------------------
35!|| fill_voxel_mod ../engine/source/interfaces/intsort/fill_voxel.F90
36!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
37!|| inter_struct_mod ../engine/share/modules/inter_struct_mod.F
38!|| message_mod ../engine/share/message_module/message_mod.F
39!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
40!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
41!|| timer_mod ../engine/source/system/timer_mod.F90
42!|| tri7box ../engine/share/modules/tri7box.F
43!||====================================================================
44 SUBROUTINE spmd_cell_exchange(TIMERS, NIN,ISENDTO,IRCVFROM,NSN,NSNR,IGAP,
45 1 IFQ,INACTI,NSNFIOLD,INTTH,ITYP,STFNS, NSV,
46 2 NRTM, X,
47 2 ITIED,NMN,INTER_STRUCT,SORT_COMM, GOT_PREVIEW)
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
295 END SUBROUTINE spmd_cell_exchange
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
spmd_cell_exchange
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)
Definition spmd_cell_exchange.F:48
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
inter_sorting_mod::sorting_comm_type
Definition inter_sorting_mod.F:91