OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_nor.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!||====================================================================
24!|| spmd_exch_nor ../engine/source/mpi/interfaces/spmd_exch_nor.f
25!||--- called by ------------------------------------------------------
26!|| i25normp ../engine/source/interfaces/int25/i25norm.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_exch_nor(
33 1 NI25,IAD_FREDG,FR_EDG,NOD_NORMAL,WNOD_NORMAL,SIZE,NADMSR,
34 2 REQ_R ,REQ_S ,IRINDEX,ISINDEX,IAD_RECV ,
35 3 NBIRECV,NBISEND,RBUF ,SBUF ,VTX_BISECTOR,
36 4 LBOUND ,IAD_FRNOR,FR_NOR,IFLAG ,FSKYN ,ISHIFT,
37 5 ADDCSRECT, PROCNOR,SOL_EDGE)
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
295 END
296
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
spmd_exch_nor
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)
Definition spmd_exch_nor.F:38