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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_tri17box (nelems, nmes, x, v, frots, ks, bminmal, weight, nin, isendto, ircvfrom, nmesr, ixs, ixs16, eminxs)

Function/Subroutine Documentation

◆ spmd_tri17box()

subroutine spmd_tri17box ( integer, dimension(*) nelems,
integer nmes,
x,
v,
frots,
ks,
bminmal,
integer, dimension(*) weight,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer nmesr,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
eminxs )

Definition at line 38 of file spmd_tri17box.F.

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