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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exchmsr_idel (bufs, lbufs, ixs, ixc, ixtg, ixq, iparg, itagl, nodes, irsize, irecv, cnel, addcnel, ofc, oft, oftg, ofur, ofr, ofp, lindex, ixp, ixr, ixt, geo, tagel, iad_elem)

Function/Subroutine Documentation

◆ spmd_exchmsr_idel()

subroutine spmd_exchmsr_idel ( integer, dimension(*) bufs,
integer lbufs,
integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixq,*) ixq,
integer, dimension(nparg,*) iparg,
integer, dimension(*) itagl,
type(nodal_arrays_), intent(inout) nodes,
integer irsize,
integer, dimension(*) irecv,
integer, dimension(0:*) cnel,
integer, dimension(0:*) addcnel,
integer ofc,
integer oft,
integer oftg,
integer ofur,
integer ofr,
integer ofp,
integer lindex,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixt,*) ixt,
geo,
integer, dimension(*) tagel,
integer, dimension(2,nspmd+1), intent(in) iad_elem )

Definition at line 34 of file spmd_exchmsr_idel.F.

41 USE nodal_arrays_mod
42 USE spmd_comm_world_mod, ONLY : spmd_comm_world
43 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------------------------
49C M e s s a g e P a s s i n g
50C-----------------------------------------------
51#include "spmd.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "task_c.inc"
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "param_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 TYPE(nodal_arrays_), INTENT(INOUT) :: NODES
63 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), IXP(NIXP,*),
64 . IXR(NIXR,*), IXT(NIXT,*), TAGEL(*),
65 . IXTG(NIXTG,*), IPARG(NPARG,*),
66 . BUFS(*),ITAGL(*), IRECV(*), CNEL(0:*), ADDCNEL(0:*),
67 . IRSIZE, LBUFS, OFC, OFT, OFTG, OFUR, OFR, OFP, LINDEX
68 INTEGER, DIMENSION(2,NSPMD+1), INTENT(in) :: IAD_ELEM
69
70C REAL
71 my_real
72 . geo(npropg,*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76#ifdef MPI
77 INTEGER MSGOFF2 ,MSGOFF3, MSGTYP, LOC_PROC,
78 . IERROR,I, IDEB, LEN, N1, N2, N3, N4,
79 . K, IX, II, NN, J, IOFF,
80 . IDEL, ITYP, NBEL,
81 .
82 . REQ_S2(NSPMD),REQ_S3(NSPMD),STATUS(MPI_STATUS_SIZE),
83 . REQ_R1(NSPMD)
84 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFR, BUFS2
85 INTEGER :: SIZ
86 DATA msgoff2/188/
87 DATA msgoff3/189/
88C-----------------------------------------------
89 ALLOCATE(bufr(irsize))
90 loc_proc = ispmd+1
91
92 ideb = 1
93 ioff = 0
94 len = 0
95 req_r1(1:nspmd) = mpi_request_null
96 DO i = 1, nspmd
97 IF(irecv(i)>0) THEN
98 msgtyp = msgoff2
99 CALL mpi_irecv(
100 . bufr(ideb),irecv(i),mpi_integer,it_spmd(i),msgtyp,
101 . spmd_comm_world,req_r1(i),ierror)
102 len = len+irecv(i)
103 ideb = len + 1
104 ENDIF
105 ENDDO
106
107C Proc sends the same BUFS to everybody
108 DO i = 1, nspmd
109 siz = (iad_elem(1,i+1)-iad_elem(1,i))
110 IF(i.NE.loc_proc.AND.lbufs.GT.0.AND.siz>0) THEN
111 msgtyp = msgoff2
112 CALL mpi_isend(
113 c bufs,lbufs,mpi_integer,it_spmd(i),msgtyp,
114 g spmd_comm_world,req_s2(i),ierror)
115 ENDIF
116 ENDDO
117 ideb = 1
118 ioff = 0
119 len = 0
120C Proc receive only if IRECV(I) > 0
121 DO i = 1, nspmd
122 IF(irecv(i)>0) THEN
123 msgtyp = msgoff2
124 CALL mpi_wait(req_r1(i),status,ierror)
125c CALL MPI_RECV(
126c . BUFR(IDEB),IRECV(I),MPI_INTEGER,IT_SPMD(I),MSGTYP,
127c . SPMD_COMM_WORLD,STATUS,IERROR)
128 len = len+irecv(i)
129 irecv(i)=0
130 DO WHILE (ideb<=len)
131 idel = bufr(ideb)
132 ityp = bufr(ideb+1)
133 nbel = bufr(ideb+2)+bufr(ideb+3)
134 ideb = ideb+4
135C
136 IF(((ityp==7.OR.ityp==10.OR.ityp==3.OR.ityp==5.OR.
137 + ityp==20.OR.ityp==22.OR.ityp==23.OR.ityp==24.OR.
138 + ityp==25.OR.ityp==2 ).AND.idel==2) )THEN
139 DO nn = 1, nbel
140 n1 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+1))
141 bufr(nn+ioff) = 0
142 IF(n1/=0) THEN
143 n2 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+2))
144 IF(n2/=0) THEN
145 n3 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+3))
146 IF(n3/=0) THEN
147 n4 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+4))
148 IF(n4/=0) THEN
149 DO j=addcnel(n1),addcnel(n1+1)-1
150 ii = cnel(j)
151 IF(tagel(ii)<0) THEN ! elt detruit trouve
152 itagl(n1) = 0
153 itagl(n2) = 0
154 itagl(n3) = 0
155 itagl(n4) = 0
156 IF(ii<=ofc) THEN ! solide detruit
157 DO k = 2, 9
158 ix = ixs(k,ii)
159 itagl(ix) = 1
160 END DO
161 ELSEIF(ii>ofc.AND.ii<=oft) THEN ! shell detruit
162 ii = ii - ofc
163 DO k=2,5
164 ix = ixc(k,ii)
165 itagl(ix)=1
166 END DO
167 ELSEIF(ii>oftg.AND.ii<=ofur)THEN
168 ii = ii - oftg
169 DO k=2,4
170 ix = ixtg(k,ii)
171 itagl(ix) = 1
172 END DO
173 END IF
174 IF(itagl(n1)+itagl(n2)+itagl(n3)+itagl(n4)==4)THEN
175 bufr(nn+ioff) = 1
176 GOTO 400
177 END IF
178 END IF
179 END DO
180 400 CONTINUE
181 ENDIF
182 ENDIF
183 ENDIF
184 ENDIF
185 ENDDO
186 ideb = ideb + 4*nbel
187 ELSEIF(((ityp==7.OR.ityp==10.OR.ityp==3.OR.ityp==5
188 + .OR.ityp==20.OR.ityp==22.OR.ityp==23.OR.ityp==24
189 + .OR.ityp==25.OR.ityp==2) .AND. idel == 1))THEN
190 DO nn = 1, nbel
191 n1 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+1))
192 bufr(nn+ioff) = 0
193 IF(n1/=0) THEN
194 n2 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+2))
195 IF(n2/=0) THEN
196 n3 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+3))
197 IF(n3/=0) THEN
198 n4 = get_local_node_id(nodes, bufr(ideb-1+4*(nn-1)+4))
199 IF(n4/=0) THEN
200 DO j=addcnel(n1),addcnel(n1+1)-1
201 ii = cnel(j)
202 IF(tagel(ii)>0) THEN ! ELT Active finds
203 itagl(n1) = 0
204 itagl(n2) = 0
205 itagl(n3) = 0
206 itagl(n4) = 0
207 IF(ii<=ofc) THEN ! solide actif
208 DO k = 2, 9
209 ix = ixs(k,ii)
210 itagl(ix) = 1
211 END DO
212 ELSEIF(ii>ofc.AND.ii<=oft) THEN ! shell actif
213 ii = ii - ofc
214 DO k=2,5
215 ix = ixc(k,ii)
216 itagl(ix)=1
217 END DO
218 ELSEIF(ii>oftg.AND.ii<=ofur)THEN ! triangle actif
219 ii = ii - oftg
220 DO k=2,4
221 ix = ixtg(k,ii)
222 itagl(ix) = 1
223 END DO
224 END IF
225 IF(itagl(n1)+itagl(n2)+itagl(n3)+itagl(n4)==4)THEN
226 bufr(nn+ioff) = 1
227 GOTO 410
228 ENDIF
229 END IF
230 ENDDO
231 410 CONTINUE
232 ENDIF
233 ENDIF
234 ENDIF
235 ENDIF
236 END DO
237 ideb = ideb + 4*nbel
238 ELSEIF((ityp==11.OR.ityp==-20).AND.idel==2)THEN ! -20 => type20 edge
239 DO nn = 1, nbel
240 n1 = get_local_node_id(nodes, bufr(ideb-1+2*(nn-1)+1))
241 bufr(nn+ioff) = 0
242 IF(n1/=0) THEN
243 n2 = get_local_node_id(nodes, bufr(ideb-1+2*(nn-1)+2))
244 IF(n2/=0) THEN
245 DO j=addcnel(n1),addcnel(n1+1)-1
246 ii = cnel(j)
247 IF(tagel(ii)<0) THEN ! elt detruit trouve
248 itagl(n1) = 0
249 itagl(n2) = 0
250 IF(ii<=ofc) THEN ! solide detruit
251 DO k = 2, 9
252 ix = ixs(k,ii)
253 itagl(ix) = 1
254 END DO
255 ELSEIF(ii>ofc.AND.ii<=oft) THEN ! shell detruit
256 ii = ii - ofc
257 DO k=2,5
258 ix = ixc(k,ii)
259 itagl(ix)=1
260 END DO
261 ELSEIF(ii>oftg.AND.ii<=ofur)THEN
262 ii = ii - oftg
263 DO k=2,4
264 ix = ixtg(k,ii)
265 itagl(ix) = 1
266 END DO
267 ELSEIF(ii>oft.AND.ii<=ofp)THEN
268 ii = ii - oft
269 DO k=2,3
270 ix = ixt(k,ii)
271 itagl(ix) = 1
272 ENDDO
273 ELSEIF(ii>ofp.AND.ii<=ofr)THEN
274 ii = ii - ofp
275 DO k=2,3
276 ix = ixp(k,ii)
277 itagl(ix) = 1
278 ENDDO
279 ELSEIF(ii>ofr.AND.ii<=oftg)THEN
280 ii = ii - ofr
281 DO k=2,3
282 ix = ixr(k,ii)
283 itagl(ix) = 1
284 ENDDO
285 IF(nint(geo(12,ixr(1,ii)))==12) THEN
286 ix = ixr(4,ii)
287 itagl(ix) = 1
288 ENDIF
289 END IF
290 IF(itagl(n1)+itagl(n2)==2)THEN
291 bufr(nn+ioff) = 1
292 GO TO 420
293 END IF
294 END IF
295 END DO
296C
297 420 CONTINUE
298 END IF
299 END IF
300 END DO
301 ideb = ideb + 2*nbel
302 ELSEIF((ityp==11.OR.ityp==-20).AND.idel==1)THEN ! -20 => type20 edge
303 DO nn = 1, nbel
304 n1 = get_local_node_id(nodes, bufr(ideb-1+2*(nn-1)+1))
305 bufr(nn+ioff) = 0
306 IF(n1/=0) THEN
307 n2 = get_local_node_id(nodes, bufr(ideb-1+2*(nn-1)+2))
308 IF(n2/=0) THEN
309 DO j=addcnel(n1),addcnel(n1+1)-1
310 ii = cnel(j)
311 IF(tagel(ii)>0) THEN ! ELT Active finds
312 itagl(n1) = 0
313 itagl(n2) = 0
314 IF(ii<=ofc) THEN ! solide actif
315 DO k = 2, 9
316 ix = ixs(k,ii)
317 itagl(ix) = 1
318 END DO
319 ELSEIF(ii>ofc.AND.ii<=oft) THEN ! shell actif
320 ii = ii - ofc
321 DO k=2,5
322 ix = ixc(k,ii)
323 itagl(ix)=1
324 END DO
325 ELSEIF(ii>oftg.AND.ii<=ofur)THEN ! triangle actif
326 ii = ii - oftg
327 DO k=2,4
328 ix = ixtg(k,ii)
329 itagl(ix) = 1
330 END DO
331 ELSEIF(ii>oft.AND.ii<=ofp)THEN ! truss actif
332 ii = ii - oft
333 DO k=2,3
334 ix = ixt(k,ii)
335 itagl(ix) = 1
336 ENDDO
337 ELSEIF(ii>ofp.AND.ii<=ofr)THEN ! active beam
338 ii = ii - ofp
339 DO k=2,3
340 ix = ixp(k,ii)
341 itagl(ix) = 1
342 ENDDO
343 ELSEIF(ii>ofr.AND.ii<=oftg)THEN ! active
344 ii = ii - ofr
345 DO k=2,3
346 ix = ixr(k,ii)
347 itagl(ix) = 1
348 ENDDO
349 IF(nint(geo(12,ixr(1,ii)))==12) THEN ! active
350 ix = ixr(4,ii)
351 itagl(ix) = 1
352 ENDIF
353 END IF
354 IF(itagl(n1)+itagl(n2)==2)THEN
355 bufr(nn+ioff) = 1
356 GOTO 430
357 ENDIF
358 ENDIF
359 ENDDO
360C
361 430 CONTINUE
362 ENDIF
363 ENDIF
364 END DO
365 ideb = ideb + 2*nbel
366 ELSE ! autre idel ou interf a reecrire
367 END IF
368 ioff = ioff + nbel
369 irecv(i)=irecv(i)+nbel
370 END DO
371 ENDIF
372 ENDDO
373C
374C Envoi BUFR
375C
376 ideb = 1
377 DO i = 1, nspmd
378 IF(irecv(i)>0) THEN
379 len = irecv(i)
380 msgtyp = msgoff3
381 CALL mpi_isend(
382 c bufr(ideb),len,mpi_integer,it_spmd(i),msgtyp,
383 g spmd_comm_world,req_s3(i),ierror)
384 ideb = ideb + len
385 ENDIF
386 ENDDO
387C
388C Test Reception Shipping Buds
389C
390 DO i = 1, nspmd
391 siz = (iad_elem(1,i+1)-iad_elem(1,i))
392 IF(i.NE.loc_proc.AND.lbufs.GT.0.AND.siz>0) THEN
393 CALL mpi_wait(req_s2(i),status,ierror)
394 ENDIF
395 ENDDO
396C
397C Reception BUFR in BUFS2
398C
399 ALLOCATE(bufs2(lindex))
400 IF(lindex>0) THEN
401 DO i = 1, lindex
402 bufs(i) = 0
403 ENDDO
404 DO i = 1, nspmd
405 siz = (iad_elem(1,i+1)-iad_elem(1,i))
406 IF(i.NE.loc_proc.AND.lindex.GT.0.AND.siz>0) THEN
407 msgtyp = msgoff3
408 CALL mpi_recv(
409 . bufs2,lindex,mpi_integer,it_spmd(i),msgtyp,
410 . spmd_comm_world,status,ierror)
411 DO j = 1, lindex
412 bufs(j) = max(bufs(j),bufs2(j))
413 ENDDO
414 ENDIF
415 ENDDO
416 ENDIF
417 DEALLOCATE(bufs2)
418
419C
420C Test Reception Bufr
421C
422 DO i = 1, nspmd
423 IF(irecv(i)>0) THEN
424 CALL mpi_wait(req_s3(i),status,ierror)
425 ENDIF
426 ENDDO
427C
428 DEALLOCATE(bufr)
429#endif
430 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372