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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_tri22vox (irectm, nrtm, x, v, bminmal, stife, nin, isendto, ircvfrom, iad_elem, fr_elem, nshelr, itab, itask)

Function/Subroutine Documentation

◆ spmd_tri22vox()

subroutine spmd_tri22vox ( integer, dimension(4,nrtm) irectm,
integer nrtm,
x,
v,
bminmal,
stife,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer nshelr,
integer, dimension(*) itab,
integer itask )

Definition at line 38 of file spmd_tri22vox.F.

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, 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)
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79#ifdef MPI
80 INTEGER MSGTYP, I, LOC_PROC, P, IDEB,
81 . MSGOFF, MSGOFF2, MSGOFF3, MSGOFF4,
82 . J, L, LEN, NB_, 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,
89 . IX1,IY1,IZ1,IX2,IY2,IZ2
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 LOGICAL ::
97 . TEST
98 DATA msgoff/138/
99 DATA msgoff2/139/
100 DATA msgoff3/140/
101 DATA msgoff4/141/
102C-----------------------------------------------
103C S o u r c e L i n e s
104C-----------------------------------------------
105C
106C=======================================================================
107C Generation of candidates list from lagrangian shells
108C by testing Voxel marking
109C=======================================================================
110 loc_proc = ispmd + 1
111 nbx = lrvoxel
112 nby = lrvoxel
113 nbz = lrvoxel
114 !-------------------------------------------!
115 ! Domain Bounds from i22xsave !
116 !-------------------------------------------!
117 IF(ircvfrom(nin,loc_proc)==0.AND.
118 . isendto(nin,loc_proc)==0) RETURN
119 bminma(1,loc_proc) = bminmal(1)
120 bminma(2,loc_proc) = bminmal(2)
121 bminma(3,loc_proc) = bminmal(3)
122 bminma(4,loc_proc) = bminmal(4)
123 bminma(5,loc_proc) = bminmal(5)
124 bminma(6,loc_proc) = bminmal(6)
125 !-------------------------------------------!
126 ! Voxel Sending !
127 ! + Min-Max Boxes Sending !
128 !-------------------------------------------!
129 IF(ircvfrom(nin,loc_proc)/=0) THEN
130 DO p = 1, nspmd
131 IF(isendto(nin,p)/=0) THEN
132 IF(p/=loc_proc) THEN
133 msgtyp = msgoff
134 CALL mpi_isend(
135 . crvoxel(0,0,loc_proc),
136 . (lrvoxel+1)*(lrvoxel+1),
137 . mpi_integer,
138 . it_spmd(p),msgtyp,spmd_comm_world,req_sc(p),ierror)
139 msgtyp = msgoff2
140 CALL mpi_isend(
141 . bminma(1,loc_proc),6 ,real ,it_spmd(p),msgtyp,
142 . spmd_comm_world ,req_sb(p),ierror)
143 ENDIF
144 ENDIF
145 ENDDO
146 ENDIF
147 !-------------------------------------------!
148 ! Voxel Reception !
149 ! + Min-Max Boxes Reception !
150 !-------------------------------------------!
151 IF(isendto(nin,loc_proc)/=0) THEN
152 nbirecv=0
153 DO p = 1, nspmd
154 IF(ircvfrom(nin,p)/=0) THEN
155 IF(loc_proc/=p) THEN
156 nbirecv=nbirecv+1
157 irindexi(nbirecv)=p
158 msgtyp = msgoff + nspmd*ispmd + p +nin
159 CALL mpi_irecv(
160 . crvoxel(0,0,p),
161 . (lrvoxel+1)*(lrvoxel+1),
162 . mpi_integer,
163 . it_spmd(p),msgtyp,spmd_comm_world,req_rc(nbirecv),ierror)
164 msgtyp = msgoff2
165 CALL mpi_irecv(
166 . bminma(1,p) ,6 ,real ,it_spmd(p),msgtyp,
167 . spmd_comm_world,req_rb(nbirecv),ierror)
168 ENDIF
169 ENDIF
170 ENDDO
171 ENDIF
172 !-------------------------------------------!
173 ! XREM sending !
174 ! (remote lagrangian shells) !
175 !-------------------------------------------!
176 ideb = 1
177 IF(isendto(nin,loc_proc)/=0) THEN
178 DO kk = 1, nbirecv
179 CALL mpi_waitany(nbirecv,req_rb,indexi,status,ierror)
180 p=irindexi(indexi)
181 CALL mpi_wait(req_rc(indexi),status,ierror)
182 l = ideb
183 nbox(p) = 0
184 nb_ = 0
185 xmaxb = bminma(1,p)
186 ymaxb = bminma(2,p)
187 zmaxb = bminma(3,p)
188 xminb = bminma(4,p)
189 yminb = bminma(5,p)
190 zminb = bminma(6,p)
191 dx = xmaxb-xminb
192 dy = ymaxb-yminb
193 dz = zmaxb-zminb
194 !-------------------------------------------!
195 ! Voxel Testing and !
196 ! Remote Shell List Generation !
197 !-------------------------------------------!
198 DO i=1,nrtm
199 IF(stife(i)==zero) cycle
200 ix1=int(nbx*(xmine(i)-xminb)/dx)
201 ix2=int(nbx*(xmaxe(i)-xminb)/dx)
202 ix1=max(0,ix1)
203 ix2=min(ix2,nbx)
204 IF(ix2 < 0.OR.ix1 > nbx) cycle
205 iy1=int(nby*(ymine(i)-yminb)/dy)
206 iy2=int(nby*(ymaxe(i)-yminb)/dy)
207 iy1=max(0,iy1)
208 iy2=min(iy2,nby)
209 IF(iy2 < 0.OR.iy1 > nby) cycle
210 iz1=int(nbz*(zmine(i)-zminb)/dz)
211 iz2=int(nbz*(zmaxe(i)-zminb)/dz)
212 iz1=max(0,iz1)
213 iz2=min(iz2,nbz)
214 IF(iz2 < 0.OR.iz1 > nbz) cycle
215 DO iy=iy1,iy2
216 DO iz=iz1,iz2
217 DO ix=ix1,ix2
218 test = btest(crvoxel(iy,iz,p),ix)
219 IF(test) THEN
220 nb_ = nb_ + 1
221 index(nb_) = i
222 GOTO 111 !next I
223 END IF
224 END DO !IX
225 END DO !IZ
226 END DO !IY
227 111 CONTINUE
228 ENDDO !I=1,NRTM
229 nbox(p) = nb_
230 !NSHELR = NB_
231 !-------------------------------------------!
232 ! Message Length for Sending !
233 !-------------------------------------------!
234 msgtyp = msgoff3
235 CALL mpi_isend(nbox(p),1,mpi_integer,it_spmd(p),msgtyp,
236 . spmd_comm_world,req_sd(p),ierror)
237 !-------------------------------------------!
238 ! Buffer Allocation !
239 !-------------------------------------------!
240 IF (nb_>0) THEN
241 ALLOCATE(buf(p)%P(siz_xrem*nb_),stat=ierror)
242 IF(ierror/=0) THEN
243 CALL ancmsg(msgid=20,anmode=aninfo)
244 CALL arret(2)
245 ENDIF
246 l = 0
247 !-------------------------------------------!
248 ! Buffer Affectation !
249 !-------------------------------------------!
250 DO j = 1, nb_
251 i = index(j)
252 buf(p)%p(l+1:l+4) = itab(irectm(1:4,i))
253 buf(p)%p(l+5:l+8) = x(1,irectm(1:4,i))
254 buf(p)%p(l+9:l+12) = x(2,irectm(1:4,i))
255 buf(p)%p(l+13:l+16)= x(3,irectm(1:4,i))
256 buf(p)%p(l+17:l+19)= (/xmine(i),ymine(i),zmine(i)/)
257 buf(p)%p(l+20:l+22)= (/xmaxe(i),ymaxe(i),zmaxe(i)/)
258 buf(p)%p(l+23) = stife(i)
259 buf(p)%p(l+24) = sum(v(1,irectm(1:4,i)))/four
260 buf(p)%p(l+25) = sum(v(2,irectm(1:4,i)))/four
261 buf(p)%p(l+26) = sum(v(3,irectm(1:4,i)))/four
262 l = l + siz_xrem ! Attention siz_xrem to update in tri22_mod if modification
263 END DO
264 msgtyp = msgoff4
265 CALL mpi_isend(
266 1 buf(p)%P(1),l,mpi_double_precision,it_spmd(p),msgtyp,
267 2 spmd_comm_world,req_sd2(p),ierror)
268 ENDIF
269 ENDDO
270 ENDIF
271 !-------------------------------------------!
272 ! XREM data reception !
273 !-------------------------------------------!
274 IF(ircvfrom(nin,loc_proc)/=0) THEN
275 nshelr = 0
276 l=0
277 DO p = 1, nspmd
278 nsnfi(nin)%P(p) = 0
279 IF(isendto(nin,p)/=0) THEN
280 IF(loc_proc/=p) THEN
281 msgtyp = msgoff3
282 CALL mpi_recv(nsnfi(nin)%P(p),1,mpi_integer,it_spmd(p),
283 . msgtyp,spmd_comm_world,status,ierror)
284 IF(nsnfi(nin)%P(p)>0) THEN
285 l=l+1
286 isindexi(l)=p
287 nshelr = nshelr + nsnfi(nin)%P(p)
288 ENDIF
289 ENDIF
290 ENDIF
291 ENDDO
292 nbirecv=l
293 !-------------------------------------------!
294 ! Allocating total size !
295 !-------------------------------------------!
296 IF(nshelr>0) THEN
297 IF (ir4r8 == 2) THEN
298 ALLOCATE(xrem(siz_xrem,nshelr),stat=ierror)
299 ELSE
300 ALLOCATE(xrem(siz_xrem,2*nshelr),stat=ierror)
301 ALLOCATE(irem(2,nshelr),stat=ierror1)
302 ierror=ierror+ierror1
303 END IF
304 IF(ierror/=0) THEN
305 CALL ancmsg(msgid=20,anmode=aninfo)
306 CALL arret(2)
307 ENDIF
308 ideb = 1
309 DO l = 1, nbirecv
310 p = isindexi(l)
311 len = nsnfi(nin)%P(p)*siz_xrem
312 msgtyp = msgoff4
313 iad = ideb
314 ! Correction Address for Passage REM SP Table used in DP DS the commout routine
315 IF(ir4r8 == 1) iad = 2*ideb-1
316 CALL mpi_irecv(
317 1 xrem(1,iad),len,mpi_double_precision,it_spmd(p),
318 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
319 ideb = ideb + nsnfi(nin)%P(p)
320 ENDDO
321 DO l = 1, nbirecv
322 CALL mpi_waitany(nbirecv,req_rd,indexi,status,ierror)
323 ENDDO
324 IF(ir4r8 == 1)THEN
325 CALL conversion11(xrem,xrem,irem,siz_xrem,ideb-1)
326 END IF
327 ENDIF
328 ENDIF
329
330 IF(ircvfrom(nin,loc_proc)/=0) THEN
331 DO p = 1, nspmd
332 IF(isendto(nin,p)/=0) THEN
333 IF(p/=loc_proc) THEN
334 CALL mpi_wait(req_sc(p),status,ierror)
335 CALL mpi_wait(req_sb(p),status,ierror)
336 ENDIF
337 ENDIF
338 ENDDO
339 ENDIF
340
341 IF(isendto(nin,loc_proc)/=0) THEN
342 DO p = 1, nspmd
343 IF(ircvfrom(nin,p)/=0) THEN
344 IF(p/=loc_proc) THEN
345 CALL mpi_wait(req_sd(p),status,ierror)
346 IF(nbox(p)/=0) THEN
347 CALL mpi_wait(req_sd2(p),status,ierror)
348 DEALLOCATE(buf(p)%p)
349 END IF
350 ENDIF
351 ENDIF
352 ENDDO
353 ENDIF
354#endif
355 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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:1257
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:7205
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