OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_sync_mmx.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!||====================================================================
25!|| spmd_sync_mmx ../engine/source/mpi/interfaces/spmd_sync_mmx.F
26!||--- called by ------------------------------------------------------
27!|| imp_icomcrit ../engine/source/implicit/imp_int_k.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_sync_mmx(
33 1 ISENDTO,IRCVFROM,NEWFRONT,XSLV_L,XMSR_L,
34 2 VSLV_L ,VMSR_L ,INTLIST ,NINTC ,TZINF ,
35 3 SIZE_T ,IPARI ,DELTA_PMAX_GAP, MAXDGAP)
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39 USE spmd_comm_world_mod, ONLY : spmd_comm_world
40#include "implicit_f.inc"
41C-----------------------------------------------------------------
42C M e s s a g e P a s s i n g
43C-----------------------------------------------
44#include "spmd.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51#include "task_c.inc"
52C commun local a spmd_init et spmd_ring_mmx
53 COMMON /ring/irecvf,isendt,iring
54 INTEGER IRECVF,ISENDT,IRING
55C irecvf : proc precedent dans l'anneau si <> 0
56C isendt : proc suivant dans l'anneau si <> 0 et <> -1
57C isendt = -1 indique un broadcast a faire (dernier proc de l'anneau)
58C iring : no du proc effectuant le broadcast si besoin sur le proc
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*),
63 . NEWFRONT(*), NINTC, INTLIST(*), IPARI(NPARI,*)
64 my_real
65 . xslv_l(18,*), xmsr_l(12,*), vslv_l(6,*),
66 . vmsr_l(6,*), tzinf(*), size_t(*),delta_pmax_gap(*),maxdgap(ninter)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70#ifdef MPI
71 INTEGER MSGOFF,MSGTYP,P,SIZ,NIN,I,J,L,LOC_PROC,
72 . IERROR,I_LEN,NBIRECV,KK,
73 . IADS,INDEXI,MSGTYP2,
74 . irindexi(nspmd),iadr(nspmd),req_r(nspmd),
75 . status(mpi_status_size)
76 parameter(i_len = 46)
77 my_real
78 . sbuf(nspmd*nintc*i_len)
79 DATA msgoff/116/
80C-----------------------------------------------
81C S o u r c e L i n e s
82C-----------------------------------------------
83C
84C
85 IF(iring==0) RETURN
86C
87 loc_proc = ispmd+1
88C
89C Compactage min/max, newfront, tzinf
90C
91 IF(loc_proc/=iring) THEN
92C si proc participe aux interfaces
93 IF(ircvfrom(ninter+1,loc_proc)>0.OR.
94 + isendto(ninter+1,loc_proc)>0) THEN
95 l = 0
96 DO kk=1,nintc
97 nin = intlist(kk)
98 IF(ircvfrom(nin,loc_proc)/=0.OR.
99 + isendto(nin,loc_proc)/=0)THEN
100C X MIN/MAX
101 DO j=1,18
102 sbuf(l+j) = xslv_l(j,nin)
103 END DO
104 l = l + 18
105C
106 DO j=1,12
107 sbuf(l+j) = xmsr_l(j,nin)
108 END DO
109 l = l + 12
110C V MIN/MAX
111 DO j=1,6
112 sbuf(l+j) = vslv_l(j,nin)
113 END DO
114 l = l + 6
115C
116 DO j=1,6
117 sbuf(l+j) = vmsr_l(j,nin)
118 END DO
119 l = l + 6
120 IF(ipari(7,nin)/=17)THEN
121C NEWFRONT
122 sbuf(l+1) = newfront(nin)
123 ELSE ! interface 17 avec courbure
124C SIZE
125 sbuf(l+1) = size_t(nin)
126 END IF
127 l = l + 1
128C TZINF
129 sbuf(l+1) = tzinf(kk)
130 l = l + 1
131C DELTA_PMAX_GAP
132 sbuf(l+1) = delta_pmax_gap(nin)
133 l = l + 1
134C T25 main gap changes with thickness change
135 sbuf(l+1) = maxdgap(nin)
136 l = l + 1
137 END IF
138 END DO
139 msgtyp = msgoff
140 CALL mpi_send(
141 s sbuf,l,real,it_spmd(iring),msgtyp,
142 g spmd_comm_world,ierror)
143 msgtyp = msgoff
144 l = i_len*nintc
145 CALL mpi_recv(
146 s sbuf,l,real,it_spmd(iring),msgtyp,
147 g spmd_comm_world,status,ierror)
148 l = 0
149 DO kk=1,nintc
150 nin = intlist(kk)
151 IF(ircvfrom(nin,loc_proc)/=0.OR.
152 + isendto(nin,loc_proc)/=0)THEN
153 DO j=1,18
154 xslv_l(j,nin) = sbuf(l+j)
155 END DO
156 l = l + 18
157 DO j=1,12
158 xmsr_l(j,nin) = sbuf(l+j)
159 END DO
160 l = l + 12
161 DO j=1,6
162 vslv_l(j,nin) = sbuf(l+j)
163 END DO
164 l = l + 6
165 DO j=1,6
166 vmsr_l(j,nin) = sbuf(l+j)
167 END DO
168 l = l + 6
169 IF(ipari(7,nin)/=17)THEN
170 newfront(nin) = sbuf(l+1)
171 ELSE ! interface 17 avec courbure
172 size_t(nin) = sbuf(l+1)
173 END IF
174 l = l + 1
175 tzinf(kk) = sbuf(l+1)
176 l = l + 1
177C DELTA_PMAX_GAP
178 delta_pmax_gap(nin) = sbuf(l+1)
179 l = l + 1
180C T25 main gap changes with thickness change
181 maxdgap(nin) = sbuf(l+1)
182 l = l + 1
183 END IF
184 END DO
185 END IF
186 ELSE
187C Proc IRING
188 l = 1
189 nbirecv = 0
190 DO p = 1, nspmd
191 IF(p/=loc_proc) THEN
192 IF(ircvfrom(ninter+1,p)>0.OR.
193 + isendto(ninter+1,p)>0) THEN
194 nbirecv = nbirecv + 1
195 irindexi(nbirecv)=p
196 msgtyp = msgoff
197 siz = i_len*nintc
198 iadr(p)=l
199 CALL mpi_irecv(
200 s sbuf(l),siz,real,it_spmd(p),msgtyp,
201 g spmd_comm_world,req_r(nbirecv),ierror)
202 l = l + siz
203 END IF
204 END IF
205 ENDDO
206C
207C Attente reception
208C
209 DO i = 1, nbirecv
210 CALL mpi_waitany(nbirecv,req_r,indexi,status,ierror)
211 p=irindexi(indexi)
212 l = iadr(p)
213 DO kk=1,nintc
214 nin = intlist(kk)
215 IF(ircvfrom(nin,p)/=0.OR.
216 + isendto(nin,p)/=0)THEN
217C X MIN/MAX
218 xslv_l( 1,nin) = max(xslv_l( 1,nin),sbuf(l))
219 xslv_l( 2,nin) = max(xslv_l( 2,nin),sbuf(l+1))
220 xslv_l( 3,nin) = max(xslv_l( 3,nin),sbuf(l+2))
221 xslv_l( 4,nin) = min(xslv_l( 4,nin),sbuf(l+3))
222 xslv_l( 5,nin) = min(xslv_l( 5,nin),sbuf(l+4))
223 xslv_l( 6,nin) = min(xslv_l( 6,nin),sbuf(l+5))
224 xslv_l( 7,nin) = max(xslv_l( 7,nin),sbuf(l+6))
225 xslv_l( 8,nin) = max(xslv_l( 8,nin),sbuf(l+7))
226 xslv_l( 9,nin) = max(xslv_l( 9,nin),sbuf(l+8))
227 xslv_l(10,nin) = min(xslv_l(10,nin),sbuf(l+9))
228 xslv_l(11,nin) = min(xslv_l(11,nin),sbuf(l+10))
229 xslv_l(12,nin) = min(xslv_l(12,nin),sbuf(l+11))
230 xslv_l(13,nin) = max(xslv_l(13,nin),sbuf(l+12))
231 xslv_l(14,nin) = max(xslv_l(14,nin),sbuf(l+13))
232 xslv_l(15,nin) = max(xslv_l(15,nin),sbuf(l+14))
233 xslv_l(16,nin) = min(xslv_l(16,nin),sbuf(l+15))
234 xslv_l(17,nin) = min(xslv_l(17,nin),sbuf(l+16))
235 xslv_l(18,nin) = min(xslv_l(18,nin),sbuf(l+17))
236 l = l + 18
237C
238 xmsr_l(1,nin) = max(xmsr_l(1,nin),sbuf(l))
239 xmsr_l(2,nin) = max(xmsr_l(2,nin),sbuf(l+1))
240 xmsr_l(3,nin) = max(xmsr_l(3,nin),sbuf(l+2))
241 xmsr_l(4,nin) = min(xmsr_l(4,nin),sbuf(l+3))
242 xmsr_l(5,nin) = min(xmsr_l(5,nin),sbuf(l+4))
243 xmsr_l(6,nin) = min(xmsr_l(6,nin),sbuf(l+5))
244 xmsr_l(7,nin) = max(xmsr_l(7,nin),sbuf(l+6))
245 xmsr_l(8,nin) = max(xmsr_l(8,nin),sbuf(l+7))
246 xmsr_l(9,nin) = max(xmsr_l(9,nin),sbuf(l+8))
247 xmsr_l(10,nin) = min(xmsr_l(10,nin),sbuf(l+9))
248 xmsr_l(11,nin) = min(xmsr_l(11,nin),sbuf(l+10))
249 xmsr_l(12,nin) = min(xmsr_l(12,nin),sbuf(l+11))
250 l = l + 12
251C V MIN/MAX
252 vslv_l(1,nin) = max(vslv_l(1,nin),sbuf(l))
253 vslv_l(2,nin) = max(vslv_l(2,nin),sbuf(l+1))
254 vslv_l(3,nin) = max(vslv_l(3,nin),sbuf(l+2))
255 vslv_l(4,nin) = min(vslv_l(4,nin),sbuf(l+3))
256 vslv_l(5,nin) = min(vslv_l(5,nin),sbuf(l+4))
257 vslv_l(6,nin) = min(vslv_l(6,nin),sbuf(l+5))
258 l = l + 6
259C
260 vmsr_l(1,nin) = max(vmsr_l(1,nin),sbuf(l))
261 vmsr_l(2,nin) = max(vmsr_l(2,nin),sbuf(l+1))
262 vmsr_l(3,nin) = max(vmsr_l(3,nin),sbuf(l+2))
263 vmsr_l(4,nin) = min(vmsr_l(4,nin),sbuf(l+3))
264 vmsr_l(5,nin) = min(vmsr_l(5,nin),sbuf(l+4))
265 vmsr_l(6,nin) = min(vmsr_l(6,nin),sbuf(l+5))
266 l = l + 6
267 IF(ipari(7,nin)/=17)THEN
268C NEWFRONT
269 newfront(nin) = newfront(nin)+nint(sbuf(l))
270 ELSE ! interface 17 avec courbure
271C SIZE
272 size_t(nin) = size_t(nin)+sbuf(l)
273 END IF
274 l = l + 1
275C TZINF
276 tzinf(kk) = min(tzinf(kk),sbuf(l))
277 l = l + 1
278C DELTA_PMAX_GAP
279 delta_pmax_gap(nin)= max(delta_pmax_gap(nin),sbuf(l) )
280 l = l + 1
281C T25 main gap changes with thickness change
282 maxdgap(nin)= max(maxdgap(nin),sbuf(l) )
283 l = l + 1
284 END IF
285 END DO
286 END DO
287C
288 l = 0
289 DO i = 1, nbirecv
290 p=irindexi(i)
291C
292 iadr(p) = l+1
293 DO kk=1,nintc
294 nin = intlist(kk)
295 IF(ircvfrom(nin,p)/=0.OR.
296 + isendto(nin,p)/=0)THEN
297 DO j=1,18
298 sbuf(l+j) = xslv_l(j,nin)
299 END DO
300 l = l + 18
301 DO j=1,12
302 sbuf(l+j) = xmsr_l(j,nin)
303 END DO
304 l = l + 12
305 DO j=1,6
306 sbuf(l+j) = vslv_l(j,nin)
307 END DO
308 l = l + 6
309 DO j=1,6
310 sbuf(l+j) = vmsr_l(j,nin)
311 END DO
312 l = l + 6
313 IF(ipari(7,nin)/=17)THEN
314 sbuf(l+1) = newfront(nin)
315 ELSE ! interface 17 avec courbure
316 sbuf(l+1) = size_t(nin)
317 END IF
318 l = l + 1
319 sbuf(l+1) = tzinf(kk)
320 l = l + 1
321 sbuf(l+1) = delta_pmax_gap(nin)
322 l = l + 1
323C T25 main gap changes with thickness change
324 sbuf(l+1) = maxdgap(nin)
325 l = l + 1
326 END IF
327 END DO
328C
329 msgtyp = msgoff
330 CALL mpi_isend(
331 s sbuf(iadr(p)),l-iadr(p)+1,real,it_spmd(p),msgtyp,
332 g spmd_comm_world,req_r(i),ierror)
333 ENDDO
334C
335 DO i = 1, nbirecv
336 CALL mpi_waitany(nbirecv,req_r,indexi,status,ierror)
337C P=IRINDEXI(I)
338 END DO
339C
340 END IF
341C
342#endif
343 RETURN
344 END
min
#define min(a, b)
Definition macros.h:20
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_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
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_sync_mmx
subroutine spmd_sync_mmx(isendto, ircvfrom, newfront, xslv_l, xmsr_l, vslv_l, vmsr_l, intlist, nintc, tzinf, size_t, ipari, delta_pmax_gap, maxdgap)
Definition spmd_sync_mmx.F:36