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 34 of file spmd_exchseg_idel.F.

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