OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri17box.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!||====================================================================
25!|| spmd_tri17box ../engine/source/mpi/interfaces/spmd_tri17box.F
26!||--- called by ------------------------------------------------------
27!|| i17buce ../engine/source/interfaces/int17/i17buce.F
28!|| i17main_tri ../engine/source/interfaces/int17/i17main_pena.f
29!||--- calls -----------------------------------------------------
30!|| ancmsg ../engine/source/output/message/message.F
31!|| arret ../engine/source/system/arret.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
35!|| tri7box ../engine/share/modules/tri7box.F
36!||====================================================================
37 SUBROUTINE spmd_tri17box(NELEMS ,NMES ,X ,V ,FROTS ,
38 2 KS ,BMINMAL ,WEIGHT ,NIN ,ISENDTO,
39 3 IRCVFROM,NMESR ,IXS ,IXS16,EMINXS )
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE tri7box
44 USE message_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48 USE spmd_comm_world_mod, ONLY : spmd_comm_world
49#include "implicit_f.inc"
50C-----------------------------------------------
51C M e s s a g e P a s s i n g
52C-----------------------------------------------
53#include "spmd.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "task_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NELEMS(*), WEIGHT(*), IXS(NIXS,*), IXS16(8,*),
64 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*),
65 . nmes, nmesr, nin
66 my_real
67 . bminmal(6),
68 . x(3,*), v(3,*), frots(7,*), ks(2,*), eminxs(6,*)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72#ifdef MPI
73 INTEGER MSGTYP,INFO,I,NOD, LOC_PROC,P,IDEB,
74 . SIZ,J, L, BUFSIZ, LEN, NB, N1, NE,
75 . status(mpi_status_size),ierror,req_sb(nspmd),
76 . req_rb(nspmd),kk,nbirecv,irindexi(nspmd),
77 . req_rd(nspmd),req_sd(nspmd),req_sd2(nspmd),
78 . indexi,isindexi(nspmd),index(nmes),nbox(nspmd),
79 . msgoff, msgoff2, msgoff3
80 DATA msgoff/129/
81 DATA msgoff2/130/
82 DATA msgoff3/131/
83
84 my_real bminma(6,nspmd)
85 TYPE(real_pointer), DIMENSION(NSPMD) :: BUF
86C-----------------------------------------------
87C S o u r c e L i n e s
88C-----------------------------------------------
89 loc_proc = ispmd + 1
90C
91C boite minmax pour le tri provenant de i7buce BMINMA
92C
93 IF(ircvfrom(nin,loc_proc)==0.AND.
94 . isendto(nin,loc_proc)==0) RETURN
95 bminma(1,loc_proc) = bminmal(1)
96 bminma(2,loc_proc) = bminmal(2)
97 bminma(3,loc_proc) = bminmal(3)
98 bminma(4,loc_proc) = bminmal(4)
99 bminma(5,loc_proc) = bminmal(5)
100 bminma(6,loc_proc) = bminmal(6)
101C
102C envoi boite
103C
104 IF(ircvfrom(nin,loc_proc)/=0) THEN
105 DO p = 1, nspmd
106 IF(isendto(nin,p)/=0) THEN
107 IF(p/=loc_proc) THEN
108 msgtyp = msgoff
109 CALL mpi_isend(
110 . bminma(1,loc_proc),6 ,real ,it_spmd(p),msgtyp,
111 . spmd_comm_world ,req_sb(p),ierror)
112 ENDIF
113 ENDIF
114 ENDDO
115 ENDIF
116C
117C reception des boites min-max
118C
119 IF(isendto(nin,loc_proc)/=0) THEN
120 nbirecv=0
121 DO p = 1, nspmd
122 IF(ircvfrom(nin,p)/=0) THEN
123 IF(loc_proc/=p) THEN
124 msgtyp = msgoff
125 nbirecv=nbirecv+1
126 irindexi(nbirecv)=p
127 CALL mpi_irecv(
128 . bminma(1,p) ,6 ,real ,it_spmd(p),msgtyp,
129 . spmd_comm_world,req_rb(nbirecv),ierror)
130 ENDIF
131 ENDIF
132 ENDDO
133 ENDIF
134C
135C envoi de XREM
136C
137 siz = 112
138 IF(isendto(nin,loc_proc)/=0) THEN
139 DO kk = 1, nbirecv
140 CALL mpi_waitany(nbirecv,req_rb,indexi,status,ierror)
141 p=irindexi(indexi)
142C
143 nb = 0
144 DO i=1,nmes
145 IF(eminxs(4,i)>bminma(1,p).AND.
146 . eminxs(5,i)>bminma(2,p).AND.
147 . eminxs(6,i)>bminma(3,p).AND.
148 . eminxs(1,i)<bminma(4,p).AND.
149 . eminxs(2,i)<bminma(5,p).AND.
150 . eminxs(3,i)<bminma(6,p))THEN
151 nb = nb + 1
152 index(nb) = i
153 ENDIF
154 ENDDO
155 nbox(p) = nb
156C
157C Envoi taille msg
158C
159 msgtyp = msgoff2
160 CALL mpi_isend(nbox(p),1,mpi_integer,it_spmd(p),msgtyp,
161 . spmd_comm_world,req_sd(p),ierror)
162C
163C Alloc buffer
164C
165 IF (nb>0) THEN
166 ALLOCATE(buf(p)%P(siz*nb),stat=ierror)
167 IF(ierror/=0) THEN
168 CALL ancmsg(msgid=20,anmode=aninfo)
169 CALL arret(2)
170 ENDIF
171 l = 0
172 DO j = 1, nb
173 i = index(j)
174 buf(p)%p(l+1) = eminxs(1,i)
175 buf(p)%p(l+2) = eminxs(2,i)
176 buf(p)%p(l+3) = eminxs(3,i)
177 buf(p)%p(l+4) = eminxs(4,i)
178 buf(p)%p(l+5) = eminxs(5,i)
179 buf(p)%p(l+6) = eminxs(6,i)
180 buf(p)%p(l+7) = i
181 ne = nelems(i)
182C
183 n1 = ixs(2,ne)
184 buf(p)%p(l+8) = x(1,n1)
185 buf(p)%p(l+9) = x(2,n1)
186 buf(p)%p(l+10) = x(3,n1)
187 buf(p)%p(l+11) = v(1,n1)
188 buf(p)%p(l+12) = v(2,n1)
189 buf(p)%p(l+13) = v(3,n1)
190 n1 = ixs(3,ne)
191 buf(p)%p(l+14) = x(1,n1)
192 buf(p)%p(l+15) = x(2,n1)
193 buf(p)%p(l+16) = x(3,n1)
194 buf(p)%p(l+17) = v(1,n1)
195 buf(p)%p(l+18) = v(2,n1)
196 buf(p)%p(l+19) = v(3,n1)
197 n1 = ixs(4,ne)
198 buf(p)%p(l+20) = x(1,n1)
199 buf(p)%p(l+21) = x(2,n1)
200 buf(p)%p(l+22) = x(3,n1)
201 buf(p)%p(l+23) = v(1,n1)
202 buf(p)%p(l+24) = v(2,n1)
203 buf(p)%p(l+25) = v(3,n1)
204 n1 = ixs(5,ne)
205 buf(p)%p(l+26) = x(1,n1)
206 buf(p)%p(l+27) = x(2,n1)
207 buf(p)%p(l+28) = x(3,n1)
208 buf(p)%p(l+29) = v(1,n1)
209 buf(p)%p(l+30) = v(2,n1)
210 buf(p)%p(l+31) = v(3,n1)
211 n1 = ixs(6,ne)
212 buf(p)%p(l+32) = x(1,n1)
213 buf(p)%p(l+33) = x(2,n1)
214 buf(p)%p(l+34) = x(3,n1)
215 buf(p)%p(l+35) = v(1,n1)
216 buf(p)%p(l+36) = v(2,n1)
217 buf(p)%p(l+37) = v(3,n1)
218 n1 = ixs(7,ne)
219 buf(p)%p(l+38) = x(1,n1)
220 buf(p)%p(l+39) = x(2,n1)
221 buf(p)%p(l+40) = x(3,n1)
222 buf(p)%p(l+41) = v(1,n1)
223 buf(p)%p(l+42) = v(2,n1)
224 buf(p)%p(l+43) = v(3,n1)
225 n1 = ixs(8,ne)
226 buf(p)%p(l+44) = x(1,n1)
227 buf(p)%p(l+45) = x(2,n1)
228 buf(p)%p(l+46) = x(3,n1)
229 buf(p)%p(l+47) = v(1,n1)
230 buf(p)%p(l+48) = v(2,n1)
231 buf(p)%p(l+49) = v(3,n1)
232 n1 = ixs(9,ne)
233 buf(p)%p(l+50) = x(1,n1)
234 buf(p)%p(l+51) = x(2,n1)
235 buf(p)%p(l+52) = x(3,n1)
236 buf(p)%p(l+53) = v(1,n1)
237 buf(p)%p(l+54) = v(2,n1)
238 buf(p)%p(l+55) = v(3,n1)
239C
240 n1 = ixs16(1,ne-numels8-numels10-numels20)
241 buf(p)%p(l+56) = x(1,n1)
242 buf(p)%p(l+57) = x(2,n1)
243 buf(p)%p(l+58) = x(3,n1)
244 buf(p)%p(l+59) = v(1,n1)
245 buf(p)%p(l+60) = v(2,n1)
246 buf(p)%p(l+61) = v(3,n1)
247 n1 = ixs16(2,ne-numels8-numels10-numels20)
248 buf(p)%p(l+62) = x(1,n1)
249 buf(p)%p(l+63) = x(2,n1)
250 buf(p)%p(l+64) = x(3,n1)
251 buf(p)%p(l+65) = v(1,n1)
252 buf(p)%p(l+66) = v(2,n1)
253 buf(p)%p(l+67) = v(3,n1)
254 n1 = ixs16(3,ne-numels8-numels10-numels20)
255 buf(p)%p(l+68) = x(1,n1)
256 buf(p)%p(l+69) = x(2,n1)
257 buf(p)%p(l+70) = x(3,n1)
258 buf(p)%p(l+71) = v(1,n1)
259 buf(p)%p(l+72) = v(2,n1)
260 buf(p)%p(l+73) = v(3,n1)
261 n1 = ixs16(4,ne-numels8-numels10-numels20)
262 buf(p)%p(l+74) = x(1,n1)
263 buf(p)%p(l+75) = x(2,n1)
264 buf(p)%p(l+76) = x(3,n1)
265 buf(p)%p(l+77) = v(1,n1)
266 buf(p)%p(l+78) = v(2,n1)
267 buf(p)%p(l+79) = v(3,n1)
268 n1 = ixs16(5,ne-numels8-numels10-numels20)
269 buf(p)%p(l+80) = x(1,n1)
270 buf(p)%p(l+81) = x(2,n1)
271 buf(p)%p(l+82) = x(3,n1)
272 buf(p)%p(l+83) = v(1,n1)
273 buf(p)%p(l+84) = v(2,n1)
274 buf(p)%p(l+85) = v(3,n1)
275 n1 = ixs16(6,ne-numels8-numels10-numels20)
276 buf(p)%p(l+86) = x(1,n1)
277 buf(p)%p(l+87) = x(2,n1)
278 buf(p)%p(l+88) = x(3,n1)
279 buf(p)%p(l+89) = v(1,n1)
280 buf(p)%p(l+90) = v(2,n1)
281 buf(p)%p(l+91) = v(3,n1)
282 n1 = ixs16(7,ne-numels8-numels10-numels20)
283 buf(p)%p(l+92) = x(1,n1)
284 buf(p)%p(l+93) = x(2,n1)
285 buf(p)%p(l+94) = x(3,n1)
286 buf(p)%p(l+95) = v(1,n1)
287 buf(p)%p(l+96) = v(2,n1)
288 buf(p)%p(l+97) = v(3,n1)
289 n1 = ixs16(8,ne-numels8-numels10-numels20)
290 buf(p)%p(l+98) = x(1,n1)
291 buf(p)%p(l+99) = x(2,n1)
292 buf(p)%p(l+100) = x(3,n1)
293 buf(p)%p(l+101) = v(1,n1)
294 buf(p)%p(l+102) = v(2,n1)
295 buf(p)%p(l+103) = v(3,n1)
296
297C
298 buf(p)%p(l+104) = frots(1,i)
299 buf(p)%p(l+105) = frots(2,i)
300 buf(p)%p(l+106) = frots(3,i)
301 buf(p)%p(l+107) = frots(4,i)
302 buf(p)%p(l+108) = frots(5,i)
303 buf(p)%p(l+109) = frots(6,i)
304 buf(p)%p(l+110) = frots(7,i)
305C
306 buf(p)%p(l+111) = ks(1,i)
307 buf(p)%p(l+112) = ks(2,i)
308C
309 l = l + siz
310 END DO
311C
312 msgtyp = msgoff3
313 CALL mpi_isend(
314 1 buf(p)%P(1),l,real,it_spmd(p),msgtyp,
315 2 spmd_comm_world,req_sd2(p),ierror)
316 ENDIF
317 ENDDO
318 ENDIF
319C
320C reception des donnees XREM
321C
322 IF(ircvfrom(nin,loc_proc)/=0) THEN
323 nmesr = 0
324 l=0
325 DO p = 1, nspmd
326 nsnfi(nin)%P(p) = 0
327 IF(isendto(nin,p)/=0) THEN
328 IF(loc_proc/=p) THEN
329 msgtyp = msgoff2
330 CALL mpi_recv(nsnfi(nin)%P(p),1,mpi_integer,it_spmd(p),
331 . msgtyp,spmd_comm_world,status,ierror)
332 IF(nsnfi(nin)%P(p)>0) THEN
333 l=l+1
334 isindexi(l)=p
335 nmesr = nmesr + nsnfi(nin)%P(p)
336 ENDIF
337 ENDIF
338 ENDIF
339 ENDDO
340 nbirecv=l
341C
342C Allocate total size
343C
344 IF(nmesr>0) THEN
345 ALLOCATE(xrem(siz,nmesr),stat=ierror)
346 IF(ierror/=0) THEN
347 CALL ancmsg(msgid=20,anmode=aninfo)
348 CALL arret(2)
349 ENDIF
350 ideb = 1
351 DO l = 1, nbirecv
352 p = isindexi(l)
353 len = nsnfi(nin)%P(p)*siz
354 msgtyp = msgoff3
355 CALL mpi_irecv(
356 1 xrem(1,ideb),len,real,it_spmd(p),
357 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
358 ideb = ideb + nsnfi(nin)%P(p)
359 ENDDO
360 DO l = 1, nbirecv
361 CALL mpi_waitany(nbirecv,req_rd,indexi,status,ierror)
362C P=ISINDEXI(INDEXI)
363 ENDDO
364 ENDIF
365 ENDIF
366C
367 IF(ircvfrom(nin,loc_proc)/=0) THEN
368 DO p = 1, nspmd
369 IF(isendto(nin,p)/=0) THEN
370 IF(p/=loc_proc) THEN
371 CALL mpi_wait(req_sb(p),status,ierror)
372 ENDIF
373 ENDIF
374 ENDDO
375 ENDIF
376C
377 IF(isendto(nin,loc_proc)/=0) THEN
378 DO p = 1, nspmd
379 IF(ircvfrom(nin,p)/=0) THEN
380 IF(p/=loc_proc) THEN
381 CALL mpi_wait(req_sd(p),status,ierror)
382 IF(nbox(p)/=0) THEN
383 CALL mpi_wait(req_sd2(p),status,ierror)
384 DEALLOCATE(buf(p)%p)
385 END IF
386 ENDIF
387 ENDIF
388 ENDDO
389 ENDIF
390C
391#endif
392 RETURN
393 END
my_real
#define my_real
Definition cppsort.cpp:32
i17main_tri
subroutine i17main_tri(timers, ipari, intbuf_tab, x, nin, itask, igrbric, nme, nmes, eminx, ixs, ixs16, ixs20, weight, isendto, irecvfrom, retri, iad_elem, fr_elem, itab, v, nme_t, esh_t)
Definition i17main_pena.F:159
i17main_pena
subroutine i17main_pena(nin, ipari, intbuf_tab, x, v, a, itask, igrbric, eminx, ms, ixs, ixs16, ixs20, stifn, fskyi, isky, fsav, fcont, niskyfi, h3d_data)
Definition i17main_pena.F:373
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
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
message_mod
Definition message_mod.F:1249
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_tri17box
subroutine spmd_tri17box(nelems, nmes, x, v, frots, ks, bminmal, weight, nin, isendto, ircvfrom, nmesr, ixs, ixs16, eminxs)
Definition spmd_tri17box.F:40
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