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