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, 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
282 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: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
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: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