OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri22vox.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/.
23C
24!||====================================================================
25!|| spmd_tri22vox ../engine/source/mpi/interfaces/spmd_tri22vox.F
26!||--- called by ------------------------------------------------------
27!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../engine/source/output/message/message.f
30!|| arret ../engine/source/system/arret.f
31!|| conversion11 ../engine/source/mpi/interfaces/spmd_i7tool.F
32!||--- uses -----------------------------------------------------
33!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
34!|| message_mod ../engine/share/message_module/message_mod.F
35!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
36!|| tri7box ../engine/share/modules/tri7box.F
37!||====================================================================
38 SUBROUTINE spmd_tri22vox(
39 1 IRECTM ,NRTM ,X ,V ,BMINMAL ,
40 2 STIFE ,NIN ,ISENDTO,IRCVFROM,IAD_ELEM ,
41 3 FR_ELEM ,NSHELR ,ITAB ,ITASK )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE tri7box
46 USE i22tri_mod
47 USE message_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51 USE spmd_comm_world_mod, ONLY : spmd_comm_world
52#include "implicit_f.inc"
53#include "r4r8_p.inc"
54C-----------------------------------------------
55C M e s s a g e P a s s i n g
56C-----------------------------------------------
57#include "spmd.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "com01_c.inc"
62#include "com04_c.inc"
63#include "task_c.inc"
64#include "timeri_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER NIN, INACTI, IGAP, NRTM,
69 . IRECTM(4,NRTM), NSHELR,
70 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*),
71 . iad_elem(2,*), fr_elem(*), itab(*) , itask
72
73 my_real
74 . x(3,*), v(3,*), bminmal(6),
75 . stife(nrtm), tzinf
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79#ifdef MPI
80 INTEGER MSGTYP,INFO,I, LOC_PROC,P,IDEB,
81 . MSGOFF, MSGOFF2, MSGOFF3, MSGOFF4,
82 . J, L, LEN, NB_, NRTMR, IERROR1, IAD,
83 . status(mpi_status_size),ierror,req_sb(nspmd),
84 . req_rb(nspmd),kk,nbirecv,irindexi(nspmd),
85 . req_rd(nspmd),req_sd(nspmd),req_sd2(nspmd),
86 . req_rc(nspmd),req_sc(nspmd),
87 . indexi,isindexi(nspmd),index(nrtm),nbox(nspmd),
88 . nbx,nby,nbz,ix,iy,iz, n1, n2, n3, n4,
89 . ix1,iy1,iz1,ix2,iy2,iz2, nod
90 my_real
91 . bminma(6,nspmd),
92 . xmaxb,ymaxb,zmaxb,xminb,yminb,zminb
93 TYPE(r8_pointer), DIMENSION(NSPMD) :: BUF
94 my_real ::
95 . DX, DY, DZ,
96 . xmin,ymin,zmin,xmax,ymax,zmax
97 LOGICAL ::
98 . TEST
99 DATA MSGOFF/138/
100 DATA msgoff2/139/
101 DATA msgoff3/140/
102 DATA msgoff4/141/
103C-----------------------------------------------
104C S o u r c e L i n e s
105C-----------------------------------------------
106C
107C=======================================================================
108C Generation of candidates list from lagrangian shells
109C by testing Voxel marking
110C=======================================================================
111 loc_proc = ispmd + 1
112 nbx = lrvoxel
113 nby = lrvoxel
114 nbz = lrvoxel
115 !-------------------------------------------!
116 ! Domain Bounds from i22xsave !
117 !-------------------------------------------!
118 IF(ircvfrom(nin,loc_proc)==0.AND.
119 . isendto(nin,loc_proc)==0) RETURN
120 bminma(1,loc_proc) = bminmal(1)
121 bminma(2,loc_proc) = bminmal(2)
122 bminma(3,loc_proc) = bminmal(3)
123 bminma(4,loc_proc) = bminmal(4)
124 bminma(5,loc_proc) = bminmal(5)
125 bminma(6,loc_proc) = bminmal(6)
126 !-------------------------------------------!
127 ! Voxel Sending !
128 ! + Min-Max Boxes Sending !
129 !-------------------------------------------!
130 IF(ircvfrom(nin,loc_proc)/=0) THEN
131 DO p = 1, nspmd
132 IF(isendto(nin,p)/=0) THEN
133 IF(p/=loc_proc) THEN
134 msgtyp = msgoff
135 CALL mpi_isend(
136 . crvoxel(0,0,loc_proc),
137 . (lrvoxel+1)*(lrvoxel+1),
138 . mpi_integer,
139 . it_spmd(p),msgtyp,spmd_comm_world,req_sc(p),ierror)
140 msgtyp = msgoff2
141 CALL mpi_isend(
142 . bminma(1,loc_proc),6 ,real ,it_spmd(p),msgtyp,
143 . spmd_comm_world ,req_sb(p),ierror)
144 ENDIF
145 ENDIF
146 ENDDO
147 ENDIF
148 !-------------------------------------------!
149 ! Voxel Reception !
150 ! + Min-Max Boxes Reception !
151 !-------------------------------------------!
152 IF(isendto(nin,loc_proc)/=0) THEN
153 nbirecv=0
154 DO p = 1, nspmd
155 IF(ircvfrom(nin,p)/=0) THEN
156 IF(loc_proc/=p) THEN
157 nbirecv=nbirecv+1
158 irindexi(nbirecv)=p
159 msgtyp = msgoff + nspmd*ispmd + p +nin
160 CALL mpi_irecv(
161 . crvoxel(0,0,p),
162 . (lrvoxel+1)*(lrvoxel+1),
163 . mpi_integer,
164 . it_spmd(p),msgtyp,spmd_comm_world,req_rc(nbirecv),ierror)
165 msgtyp = msgoff2
166 CALL mpi_irecv(
167 . bminma(1,p) ,6 ,real ,it_spmd(p),msgtyp,
168 . spmd_comm_world,req_rb(nbirecv),ierror)
169 ENDIF
170 ENDIF
171 ENDDO
172 ENDIF
173 !-------------------------------------------!
174 ! XREM sending !
175 ! (remote lagrangian shells) !
176 !-------------------------------------------!
177 ideb = 1
178 IF(isendto(nin,loc_proc)/=0) THEN
179 DO kk = 1, nbirecv
180 CALL mpi_waitany(nbirecv,req_rb,indexi,status,ierror)
181 p=irindexi(indexi)
182 CALL mpi_wait(req_rc(indexi),status,ierror)
183 l = ideb
184 nbox(p) = 0
185 nb_ = 0
186 xmaxb = bminma(1,p)
187 ymaxb = bminma(2,p)
188 zmaxb = bminma(3,p)
189 xminb = bminma(4,p)
190 yminb = bminma(5,p)
191 zminb = bminma(6,p)
192 dx = xmaxb-xminb
193 dy = ymaxb-yminb
194 dz = zmaxb-zminb
195 !-------------------------------------------!
196 ! Voxel Testing and !
197 ! remote shell list generation !
198 !-------------------------------------------!
199 DO i=1,nrtm
200 IF(stife(i)==zero) cycle
201 ix1=int(nbx*(xmine(i)-xminb)/dx)
202 ix2=int(nbx*(xmaxe(i)-xminb)/dx)
203 ix1=max(0,ix1)
204 ix2=min(ix2,nbx)
205 IF(ix2 < 0.OR.ix1 > nbx) cycle
206 iy1=int(nby*(ymine(i)-yminb)/dy)
207 iy2=int(nby*(ymaxe(i)-yminb)/dy)
208 iy1=max(0,iy1)
209 iy2=min(iy2,nby)
210 IF(iy2 < 0.OR.iy1 > nby) cycle
211 iz1=int(nbz*(zmine(i)-zminb)/dz)
212 iz2=int(nbz*(zmaxe(i)-zminb)/dz)
213 iz1=max(0,iz1)
214 iz2=min(iz2,nbz)
215 IF(iz2 < 0.OR.iz1 > nbz) cycle
216 DO iy=iy1,iy2
217 DO iz=iz1,iz2
218 DO ix=ix1,ix2
219 test = btest(crvoxel(iy,iz,p),ix)
220 IF(test) THEN
221 nb_ = nb_ + 1
222 index(nb_) = i
223 GOTO 111 !next I
224 END IF
225 END DO !IX
226 END DO !IZ
227 END DO !IY
228 111 CONTINUE
229 ENDDO !I=1,NRTM
230 nbox(p) = nb_
231 !NSHELR = NB_
232 !-------------------------------------------!
233 ! Message Length for Sending !
234 !-------------------------------------------!
235 msgtyp = msgoff3
236 CALL mpi_isend(nbox(p),1,mpi_integer,it_spmd(p),msgtyp,
237 . spmd_comm_world,req_sd(p),ierror)
238 !-------------------------------------------!
239 ! Buffer Allocation !
240 !-------------------------------------------!
241 IF (nb_>0) THEN
242 ALLOCATE(buf(p)%P(siz_xrem*nb_),stat=ierror)
243 IF(ierror/=0) THEN
244 CALL ancmsg(msgid=20,anmode=aninfo)
245 CALL arret(2)
246 ENDIF
247 l = 0
248 !-------------------------------------------!
249 ! Buffer Affectation !
250 !-------------------------------------------!
251 DO j = 1, nb_
252 i = index(j)
253 buf(p)%p(l+1:l+4) = itab(irectm(1:4,i))
254 buf(p)%p(l+5:l+8) = x(1,irectm(1:4,i))
255 buf(p)%p(l+9:l+12) = x(2,irectm(1:4,i))
256 buf(p)%p(l+13:l+16)= x(3,irectm(1:4,i))
257 buf(p)%p(l+17:l+19)= (/xmine(i),ymine(i),zmine(i)/)
258 buf(p)%p(l+20:l+22)= (/xmaxe(i),ymaxe(i),zmaxe(i)/)
259 buf(p)%p(l+23) = stife(i)
260 buf(p)%p(l+24) = sum(v(1,irectm(1:4,i)))/four
261 buf(p)%p(l+25) = sum(v(2,irectm(1:4,i)))/four
262 buf(p)%p(l+26) = sum(v(3,irectm(1:4,i)))/four
263 l = l + siz_xrem ! attention SIZ_XREM a mettre a jour dans tri22_mod si modif
264 END DO
265 msgtyp = msgoff4
266 CALL mpi_isend(
267 1 buf(p)%P(1),l,mpi_double_precision,it_spmd(p),msgtyp,
268 2 spmd_comm_world,req_sd2(p),ierror)
269 ENDIF
270 ENDDO
271 ENDIF
272 !-------------------------------------------!
273 ! XREM data reception !
274 !-------------------------------------------!
275 IF(ircvfrom(nin,loc_proc)/=0) THEN
276 nshelr = 0
277 l=0
278 DO p = 1, nspmd
279 nsnfi(nin)%P(p) = 0
280 IF(isendto(nin,p)/=0) THEN
281 IF(loc_proc/=p) THEN
282 msgtyp = msgoff3
283 CALL mpi_recv(nsnfi(nin)%P(p),1,mpi_integer,it_spmd(p),
284 . msgtyp,spmd_comm_world,status,ierror)
285 IF(nsnfi(nin)%P(p)>0) THEN
286 l=l+1
287 isindexi(l)=p
288 nshelr = nshelr + nsnfi(nin)%P(p)
289 ENDIF
290 ENDIF
291 ENDIF
292 ENDDO
293 nbirecv=l
294 !-------------------------------------------!
295 ! Allocating total size !
296 !-------------------------------------------!
297 IF(nshelr>0) THEN
298 IF (ir4r8 == 2) THEN
299 ALLOCATE(xrem(siz_xrem,nshelr),stat=ierror)
300 ELSE
301 ALLOCATE(xrem(siz_xrem,2*nshelr),stat=ierror)
302 ALLOCATE(irem(2,nshelr),stat=ierror1)
303 ierror=ierror+ierror1
304 END IF
305 IF(ierror/=0) THEN
306 CALL ancmsg(msgid=20,anmode=aninfo)
307 CALL arret(2)
308 ENDIF
309 ideb = 1
310 DO l = 1, nbirecv
311 p = isindexi(l)
312 len = nsnfi(nin)%P(p)*siz_xrem
313 msgtyp = msgoff4
314 iad = ideb
315 ! correction adresse pour passage tableau XREM SP utilise en DP ds la routine de comm
316 IF(ir4r8 == 1) iad = 2*ideb-1
317 CALL mpi_irecv(
318 1 xrem(1,iad),len,mpi_double_precision,it_spmd(p),
319 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
320 ideb = ideb + nsnfi(nin)%P(p)
321 ENDDO
322 DO l = 1, nbirecv
323 CALL mpi_waitany(nbirecv,req_rd,indexi,status,ierror)
324 ENDDO
325 IF(ir4r8 == 1)THEN
326 CALL conversion11(xrem,xrem,irem,siz_xrem,ideb-1)
327 END IF
328 ENDIF
329 ENDIF
330
331 IF(ircvfrom(nin,loc_proc)/=0) THEN
332 DO p = 1, nspmd
333 IF(isendto(nin,p)/=0) THEN
334 IF(p/=loc_proc) THEN
335 CALL mpi_wait(req_sc(p),status,ierror)
336 CALL mpi_wait(req_sb(p),status,ierror)
337 ENDIF
338 ENDIF
339 ENDDO
340 ENDIF
341
342 IF(isendto(nin,loc_proc)/=0) THEN
343 DO p = 1, nspmd
344 IF(ircvfrom(nin,p)/=0) THEN
345 IF(p/=loc_proc) THEN
346 CALL mpi_wait(req_sd(p),status,ierror)
347 IF(nbox(p)/=0) THEN
348 CALL mpi_wait(req_sd2(p),status,ierror)
349 DEALLOCATE(buf(p)%p)
350 END IF
351 ENDIF
352 ENDIF
353 ENDDO
354 ENDIF
355#endif
356 RETURN
357 END
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::siz_xrem
integer siz_xrem
Definition cut-cell-search_mod.F:471
message_mod
Definition message_mod.F:1249
tri7box::crvoxel
integer, dimension(0:lrvoxel, 0:lrvoxel) crvoxel
Definition tri7box.F:56
tri7box::lrvoxel
integer lrvoxel
Definition tri7box.F:54
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
conversion11
subroutine conversion11(xrem, xrem_dp, irem, siz, len)
Definition spmd_i7tool.F:7191
spmd_tri22vox
subroutine spmd_tri22vox(irectm, nrtm, x, v, bminmal, stife, nin, isendto, ircvfrom, iad_elem, fr_elem, nshelr, itab, itask)
Definition spmd_tri22vox.F:42
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