OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_nor.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exch_nor (ni25, iad_fredg, fr_edg, nod_normal, wnod_normal, size, nadmsr, req_r, req_s, irindex, isindex, iad_recv, nbirecv, nbisend, rbuf, sbuf, vtx_bisector, lbound, iad_frnor, fr_nor, iflag, fskyn, ishift, addcsrect, procnor, sol_edge)

Function/Subroutine Documentation

◆ spmd_exch_nor()

subroutine spmd_exch_nor ( integer ni25,
integer, dimension(ninter25,*) iad_fredg,
integer, dimension(2,*) fr_edg,
real*4, dimension(3,4,*) nod_normal,
real*4, dimension(3,4,*) wnod_normal,
integer size,
integer, intent(in) nadmsr,
integer, dimension(nspmd) req_r,
integer, dimension(nspmd) req_s,
integer, dimension(nspmd) irindex,
integer, dimension(nspmd) isindex,
integer, dimension(nspmd+1) iad_recv,
integer nbirecv,
integer nbisend,
real*4, dimension(*) rbuf,
real*4, dimension(*) sbuf,
real*4, dimension(3,2,nadmsr) vtx_bisector,
integer, dimension(*) lbound,
integer, dimension(ninter25,*) iad_frnor,
integer, dimension(*) fr_nor,
integer iflag,
real*4, dimension(3,*) fskyn,
integer ishift,
integer, dimension(*) addcsrect,
integer, dimension(*) procnor,
integer, intent(in) sol_edge )

Definition at line 32 of file spmd_exch_nor.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE intbufdef_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 "com01_c.inc"
55#include "com04_c.inc"
56#include "task_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER, INTENT(IN) :: NADMSR,SOL_EDGE
61 INTEGER NI25, IAD_FREDG(NINTER25,*), FR_EDG(2,*),SIZE,ISHIFT,
62 . REQ_R(NSPMD),REQ_S(NSPMD),IRINDEX(NSPMD),ISINDEX(NSPMD),IAD_RECV(NSPMD+1),
63 . NBIRECV, NBISEND, IAD_FRNOR(NINTER25,*), FR_NOR(*), IFLAG, LBOUND(*),
64 . ADDCSRECT(*), PROCNOR(*)
65 real*4 nod_normal(3,4,*), wnod_normal(3,4,*), vtx_bisector(3,2,nadmsr),fskyn(3,*),
66 . rbuf(*), sbuf(*)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70#ifdef MPI
71 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,INDEX, N, M, E, IS,
72 . SIZ,J,K,L0,L,CC,II, MSGOFF,
73 . STATUS(MPI_STATUS_SIZE)
74 real*4 rzero
75 DATA msgoff/6014/
76C-----------------------------------------------
77C S o u r c e L i n e s
78C-----------------------------------------------
79 rzero = 0.
80C
81 loc_proc = ispmd + 1
82C
83 IF(iflag==1)THEN
84C
85 nbirecv = 0
86 l = 1
87 iad_recv(1) = 1
88 DO i = 1, nspmd
89
90 IF(i/=loc_proc)THEN
91
92 l0 = l
93 l = l+ size*(iad_fredg(ni25,i+1)-iad_fredg(ni25,i))
94 . +2*size*(iad_frnor(ni25,i+1)-iad_frnor(ni25,i))
95 . + (iad_frnor(ni25,i+1)-iad_frnor(ni25,i))
96
97
98 IF(sol_edge/=0)THEN
99 IF(iad_frnor(ni25,i+1)-iad_frnor(ni25,i)>0) THEN
100 DO j=iad_frnor(ni25,i),iad_frnor(ni25,i+1)-1
101 nod = ishift + fr_nor(j)
102 DO cc = addcsrect(nod),addcsrect(nod+1)-1
103 IF(procnor(cc)==i) THEN
104 l = l + SIZE
105 ENDIF
106 END DO
107 END DO
108 ENDIF
109 ENDIF
110
111 siz = l-l0
112c print *,'recoit siz',ispmd+1,i,ni25,siz
113 IF(siz > 0)THEN
114 msgtyp = msgoff
115 nbirecv = nbirecv + 1
116 irindex(nbirecv) = i
117 CALL mpi_irecv(
118 s rbuf(l0),siz,mpi_real4,it_spmd(i),msgtyp,
119 g spmd_comm_world,req_r(nbirecv),ierror)
120 ENDIF
121 ENDIF
122 iad_recv(i+1) = l
123 ENDDO
124C
125 nbisend = 0
126 l = 1
127 DO i=1,nspmd
128
129 IF(i/=loc_proc)THEN
130 l0 = l
131 IF(iad_fredg(ni25,i+1)-iad_fredg(ni25,i)>0) THEN
132 DO j=iad_fredg(ni25,i),iad_fredg(ni25,i+1)-1
133 m = fr_edg(1,j)
134 e= fr_edg(2,j)
135 sbuf(l) = nod_normal(1,e,m)
136 sbuf(l+1) = nod_normal(2,e,m)
137 sbuf(l+2) = nod_normal(3,e,m)
138 l = l + SIZE
139C#ifdef D_ES
140C IF(ISPMD == 0 .AND. I-1 == 1) THEN
141C WRITE(6,"(2I10,A,I10,3Z20)") E,M," SEND TO",I-1,NOD_NORMAL(1,E,M),NOD_NORMAL(3,E,M),NOD_NORMAL(2,E,M)
142C ENDIF
143C#endif
144c print *,'envoi',ispmd+1,i,j-IAD_FREDG(NI25,I)+1,mseglo(m),mvoisin(e,m)
145c if((ispmd==1.or.ispmd==3).and.(i==2.or.i==4).and.ni25==1)print *,'envoi',ispmd+1,NI25,i,j-IAD_FREDG(NI25,I)+1,mseglo(m),mvoisin(e,m)
146
147 ENDDO
148 ENDIF
149 IF(iad_frnor(ni25,i+1)-iad_frnor(ni25,i)>0) THEN
150 DO j=iad_frnor(ni25,i),iad_frnor(ni25,i+1)-1
151 is = fr_nor(j)
152 sbuf(l) = vtx_bisector(1,1,is)
153 sbuf(l+1) = vtx_bisector(2,1,is)
154 sbuf(l+2) = vtx_bisector(3,1,is)
155 l = l + SIZE
156 sbuf(l) = vtx_bisector(1,2,is)
157 sbuf(l+1) = vtx_bisector(2,2,is)
158 sbuf(l+2) = vtx_bisector(3,2,is)
159 l = l + SIZE
160 sbuf(l) = lbound(is)
161 l = l + 1
162 ENDDO
163 ENDIF
164
165 IF(sol_edge/=0)THEN
166
167 IF(iad_frnor(ni25,i+1)-iad_frnor(ni25,i)>0) THEN
168 DO j=iad_frnor(ni25,i),iad_frnor(ni25,i+1)-1
169 nod = ishift + fr_nor(j)
170 DO cc = addcsrect(nod),addcsrect(nod+1)-1
171 IF(procnor(cc)==loc_proc) THEN
172 sbuf(l) = fskyn(1,cc)
173 sbuf(l+1) = fskyn(2,cc)
174 sbuf(l+2) = fskyn(3,cc)
175 l = l + SIZE
176 ENDIF
177 ENDDO
178 ENDDO
179 ENDIF
180 ENDIF
181
182 siz = l-l0
183c print *,'envoi siz',ispmd+1,i,ni25,siz
184 IF(siz > 0)THEN
185 msgtyp = msgoff
186 nbisend = nbisend + 1
187 isindex(nbisend)=i
188 CALL mpi_isend(
189 s sbuf(l0),siz,mpi_real4,it_spmd(i),msgtyp,
190 g spmd_comm_world,req_s(i),ierror)
191 ENDIF
192 END IF
193 ENDDO
194C
195 ELSE ! IF(IFLAG==1)THEN
196C
197C decompactage
198C
199 DO ii=1,nbirecv
200 CALL mpi_waitany(nbirecv,req_r,index,status,ierror)
201 i = irindex(index)
202 l = iad_recv(i)
203
204 DO j=iad_fredg(ni25,i),iad_fredg(ni25,i+1)-1
205 m= fr_edg(1,j)
206 e= fr_edg(2,j)
207 wnod_normal(1,e,m) = rbuf(l)
208 wnod_normal(2,e,m) = rbuf(l+1)
209 wnod_normal(3,e,m) = rbuf(l+2)
210 l = l + SIZE
211c print *,'recoit',ispmd+1,i,j-IAD_FREDG(NI25,I)+1,mseglo(m),mvoisin(e,m)
212 ENDDO
213
214 DO j=iad_frnor(ni25,i),iad_frnor(ni25,i+1)-1
215 is= fr_nor(j)
216 IF(rbuf(l)/=rzero.OR.rbuf(l+1)/=rzero.OR.rbuf(l+2)/=rzero)THEN
217 IF(vtx_bisector(1,1,is)==rzero.AND.
218 . vtx_bisector(2,1,is)==rzero.AND.
219 . vtx_bisector(3,1,is)==rzero)THEN
220 vtx_bisector(1,1,is)=rbuf(l)
221 vtx_bisector(2,1,is)=rbuf(l+1)
222 vtx_bisector(3,1,is)=rbuf(l+2)
223 ELSEIF(vtx_bisector(1,2,is)==rzero.AND.
224 . vtx_bisector(2,2,is)==rzero.AND.
225 . vtx_bisector(3,2,is)==rzero)THEN
226 vtx_bisector(1,2,is)=rbuf(l)
227 vtx_bisector(2,2,is)=rbuf(l+1)
228 vtx_bisector(3,2,is)=rbuf(l+2)
229 ELSE
230 vtx_bisector(1,1,is) = rzero
231 vtx_bisector(2,1,is) = rzero
232 vtx_bisector(3,1,is) = rzero
233 vtx_bisector(1,2,is) = rzero
234 vtx_bisector(2,2,is) = rzero
235 vtx_bisector(3,2,is) = rzero
236 END IF
237 END IF
238 l = l + SIZE
239 IF(rbuf(l)/=rzero.OR.rbuf(l+1)/=rzero.OR.rbuf(l+2)/=rzero)THEN
240 IF(vtx_bisector(1,1,is)==rzero.AND.
241 . vtx_bisector(2,1,is)==rzero.AND.
242 . vtx_bisector(3,1,is)==rzero)THEN
243 vtx_bisector(1,1,is)=rbuf(l)
244 vtx_bisector(2,1,is)=rbuf(l+1)
245 vtx_bisector(3,1,is)=rbuf(l+2)
246 ELSEIF(vtx_bisector(1,2,is)==rzero.AND.
247 . vtx_bisector(2,2,is)==rzero.AND.
248 . vtx_bisector(3,2,is)==rzero)THEN
249 vtx_bisector(1,2,is)=rbuf(l)
250 vtx_bisector(2,2,is)=rbuf(l+1)
251 vtx_bisector(3,2,is)=rbuf(l+2)
252 END IF
253 END IF
254 l = l + SIZE
255
256 lbound(is) = lbound(is)+nint(rbuf(l))
257 IF(lbound(is) > 2) THEN
258 vtx_bisector(1,1,is) = rzero
259 vtx_bisector(2,1,is) = rzero
260 vtx_bisector(3,1,is) = rzero
261 vtx_bisector(1,2,is) = rzero
262 vtx_bisector(2,2,is) = rzero
263 vtx_bisector(3,2,is) = rzero
264 ENDIF
265
266 l = l + 1
267 ENDDO
268
269 IF(sol_edge/=0)THEN
270 DO j=iad_frnor(ni25,i),iad_frnor(ni25,i+1)-1
271 nod = ishift + fr_nor(j)
272 DO cc = addcsrect(nod),addcsrect(nod+1)-1
273 IF(procnor(cc)==i) THEN
274 fskyn(1,cc) = rbuf(l)
275 fskyn(2,cc) = rbuf(l+1)
276 fskyn(3,cc) = rbuf(l+2)
277 l = l + SIZE
278 END IF
279 END DO
280 ENDDO
281 ENDIF
282
283
284 ENDDO
285C
286 DO ii=1,nbisend
287 i = isindex(ii)
288 CALL mpi_wait(req_s(i),status,ierror)
289 ENDDO
290C
291 END IF
292C
293#endif
294 RETURN
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_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372