OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exchseg_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_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)

Function/Subroutine Documentation

◆ spmd_exchseg_idel()

subroutine spmd_exchseg_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(in) nodes,
integer, dimension(*) tagel,
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 ofq,
integer lindex,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixt,*) ixt,
geo,
integer, dimension(2,nspmd+1), intent(in) iad_elem )

Definition at line 35 of file spmd_exchseg_idel.F.

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
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