OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exchseg_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/.
23
24C
25!||====================================================================
26!|| spmd_exchseg_idel ../engine/source/mpi/kinematic_conditions/spmd_exchseg_idel.F
27!||--- called by ------------------------------------------------------
28!|| chkload ../engine/source/interfaces/chkload.F
29!||--- calls -----------------------------------------------------
30!||--- uses -----------------------------------------------------
31!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
32!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
33!||====================================================================
34 SUBROUTINE spmd_exchseg_idel(
35 1 BUFS ,LBUFS ,IXS ,IXC ,IXTG ,
36 2 IXQ ,IPARG ,ITAGL ,NODES,TAGEL ,
37 3 IRSIZE,IRECV ,CNEL ,ADDCNEL,OFC ,
38 4 OFT ,OFTG ,OFUR ,OFR ,OFP ,
39 5 OFQ ,LINDEX,IXP ,IXR ,IXT ,
40 6 GEO ,IAD_ELEM)
41 USE nodal_arrays_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45 USE spmd_comm_world_mod, ONLY : spmd_comm_world
46#include "implicit_f.inc"
47C-----------------------------------------------------------------
48C M e s s a g e P a s s i n g
49C-----------------------------------------------
50#include "spmd.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "task_c.inc"
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "param_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 TYPE(nodal_arrays_), INTENT(IN) :: NODES
62 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), IXP(NIXP,*),
63 . IXR(NIXR,*), IXT(NIXT,*), TAGEL(*),
64 . IXTG(NIXTG,*), IPARG(NPARG,*),
65 . BUFS(*),ITAGL(*), IRECV(*), CNEL(0:*), ADDCNEL(0:*),
66 . IRSIZE, LBUFS, OFC, OFT, OFTG, OFUR, OFR, OFP, LINDEX,
67 . ofq
68 INTEGER, DIMENSION(2,NSPMD+1), INTENT(in) :: IAD_ELEM
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
85 DATA MSGOFF2/188/
86 DATA MSGOFF3/189/
87C-----------------------------------------------
88 ALLOCATE(bufr(irsize))
89 loc_proc = ispmd+1
90
91 ideb = 1
92 ioff = 0
93 len = 0
94 req_r1(1:nspmd) = mpi_request_null
95 DO i = 1, nspmd
96 siz = (iad_elem(1,i+1)-iad_elem(1,i))
97 IF(i/=loc_proc.AND.irecv(i)>0.AND.siz>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
107
108C Proc sends the same BUFS to everybody
109 DO i = 1, nspmd
110 siz = (iad_elem(1,i+1)-iad_elem(1,i))
111 IF(i/=loc_proc.AND.lbufs>0.AND.siz>0) THEN
112 msgtyp = msgoff2
113 CALL mpi_isend(
114 c bufs,lbufs,mpi_integer,it_spmd(i),msgtyp,
115 g spmd_comm_world,req_s2(i),ierror)
116 ENDIF
117 ENDDO
118
119 ideb = 0
120 ioff = 0
121 len = 0
122C Proc receive only if IRECV(I) > 0
123C
124 DO i = 1, nspmd
125 siz = (iad_elem(1,i+1)-iad_elem(1,i))
126 IF(i/=loc_proc.AND.irecv(i)>0.AND.siz>0) THEN
127 msgtyp = msgoff2
128 CALL mpi_wait(req_r1(i),status,ierror)
129 len = len+irecv(i)
130 nbel = irecv(i)/4
131 irecv(i)=0
132
133 DO nn = 1, nbel
134 n1 = get_local_node_id(nodes, bufr(ideb+4*(nn-1)+1))
135 bufr(nn+ioff) = 0
136 IF(n1/=0) THEN
137
138 n2 = get_local_node_id(nodes, bufr(ideb+4*(nn-1)+2))
139 IF(n2/=0) THEN
140
141 n3 = get_local_node_id(nodes, bufr(ideb+4*(nn-1)+3))
142 IF(n3/=0) THEN
143
144 n4 = get_local_node_id(nodes, bufr(ideb+4*(nn-1)+4))
145 IF(n4/=0) THEN
146
147 DO j=addcnel(n1),addcnel(n1+1)-1
148 ii = cnel(j)
149 IF(tagel(ii)>0) THEN ! elt actif found
150 itagl(n1) = 0
151 itagl(n2) = 0
152 itagl(n3) = 0
153 itagl(n4) = 0
154 IF(ii<=ofc) THEN ! solide actif
155 DO k = 2, 9
156 ix = ixs(k,ii)
157 itagl(ix) = 1
158 END DO
159 ELSEIF(ii>ofq.AND.ii<=ofc) THEN ! Quad actif
160 ii = ii - ofq
161 DO k=2,5
162 ix = ixq(k,ii)
163 itagl(ix)=1
164 END DO
165 ELSEIF(ii>ofc.AND.ii<=oft) THEN ! shell actif
166 ii = ii - ofc
167 DO k=2,5
168 ix = ixc(k,ii)
169 itagl(ix)=1
170 END DO
171 ELSEIF(ii>oftg.AND.ii<=ofur)THEN ! triangle actif
172 ii = ii - oftg
173 DO k=2,4
174 ix = ixtg(k,ii)
175 itagl(ix) = 1
176 END DO
177 END IF
178
179 IF(itagl(n1)+itagl(n2)+itagl(n3)+itagl(n4)==4)THEN
180 bufr(nn+ioff) = 1
181 GOTO 410
182 ENDIF
183
184 END IF
185
186 ENDDO
187 410 CONTINUE
188
189 ENDIF
190 ENDIF
191 ENDIF
192 ENDIF
193 END DO
194 ideb = ideb + 4*nbel
195
196 ioff = ioff + nbel
197 irecv(i)=irecv(i)+nbel
198
199 ENDIF
200 ENDDO
201C
202C Envoi BUFR
203C
204 ideb = 1
205 DO i = 1, nspmd
206 siz = (iad_elem(1,i+1)-iad_elem(1,i))
207 IF(i/=loc_proc.AND.irecv(i)>0.AND.siz>0) THEN
208 len = irecv(i)
209 msgtyp = msgoff3
210 CALL mpi_isend(
211 c bufr(ideb),len,mpi_integer,it_spmd(i),msgtyp,
212 g spmd_comm_world,req_s3(i),ierror)
213 ideb = ideb + len
214 ENDIF
215 ENDDO
216C
217C Test reception envoi BUFS
218C
219 DO i = 1, nspmd
220 siz = (iad_elem(1,i+1)-iad_elem(1,i))
221 IF(i/=loc_proc.AND.lbufs>0.AND.siz>0) THEN
222 CALL mpi_wait(req_s2(i),status,ierror)
223 ENDIF
224 ENDDO
225C
226C Reception BUFR dans BUFS2
227C
228 ALLOCATE(bufs2(lindex))
229 IF(lindex>0) THEN
230 DO i = 1, lindex
231 bufs(i) = 0
232 ENDDO
233 DO i = 1, nspmd
234 siz = (iad_elem(1,i+1)-iad_elem(1,i))
235 IF(i/=loc_proc.AND.lindex>0.AND.siz>0) THEN
236 msgtyp = msgoff3
237 CALL mpi_recv(
238 . bufs2,lindex,mpi_integer,it_spmd(i),msgtyp,
239 . spmd_comm_world,status,ierror)
240 DO j = 1, lindex
241 bufs(j) = max(bufs(j),bufs2(j))
242 ENDDO
243 ENDIF
244 ENDDO
245 ENDIF
246 DEALLOCATE(bufs2)
247
248C
249C Test reception envoi BUFR
250C
251 DO i = 1, nspmd
252 siz = (iad_elem(1,i+1)-iad_elem(1,i))
253 IF(i/=loc_proc.AND.siz>0.AND.irecv(i)>0) THEN
254 CALL mpi_wait(req_s3(i),status,ierror)
255 ENDIF
256 ENDDO
257C
258 DEALLOCATE(bufr)
259#endif
260 RETURN
261 END
262
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_exchseg_idel
subroutine spmd_exchseg_idel(bufs, lbufs, ixs, ixc, ixtg, ixq, iparg, itagl, nodes, tagel, irsize, irecv, cnel, addcnel, ofc, oft, oftg, ofur, ofr, ofp, ofq, lindex, ixp, ixr, ixt, geo, iad_elem)
Definition spmd_exchseg_idel.F:41