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