OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fvb.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_fvb_gath_begin ../engine/source/mpi/airbags/spmd_fvb.F
25!||--- called by ------------------------------------------------------
26!|| fvupd0 ../engine/source/airbag/fvupd.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
30!||====================================================================
31 SUBROUTINE spmd_fvb_gath_begin(IFV, X, XXX, XXXA,
32 . V, VVV, VVVA)
33C Gather local X into XXX,XXXA,on the PMAIN of the FVM
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE fvbag_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------------------------
43C M e s s a g e P a s s i n g
44C-----------------------------------------------
45#include "spmd.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "task_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IFV
56 my_real
57 . x(3,*), xxx(3,*), xxxa(3,*),
58 . v(3,*), vvv(3,*), vvva(3,*)
59
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63#ifdef MPI
64 INTEGER II, I, ITAG, LEN, ITAB(3,NSPMD-1),
65 . stat(mpi_status_size,2*(nspmd-1)), ierr, leni, lenr,
66 . iad, i1, i2, iad1, iad2,
67 . j, j1, itabl(3), pmain, msgoff
68
69 DATA msgoff/205/
70C
71 ALLOCATE(fvspmd(ifv)%REQ(2*(nspmd-1)))
72 ALLOCATE(fvspmd(ifv)%IADI(nspmd-1))
73 ALLOCATE(fvspmd(ifv)%IADR(nspmd-1))
74
75
76
77 IF (fvspmd(ifv)%RANK == 0) THEN
78 DO i=1,fvspmd(ifv)%NSPMD-1
79 itab(1,i) = fvspmd(ifv)%ITAB(1,i)
80 itab(1,i) = itab(1,i)+fvspmd(ifv)%ITAB(4,i)
81 itab(2,i) = fvspmd(ifv)%ITAB(2,i)
82 itab(3,i) = fvspmd(ifv)%ITAB(3,i)
83 ENDDO
84
85 leni=0
86 lenr=0
87 ii=0
88 DO i=1,fvspmd(ifv)%NSPMD-1
89 ii=ii+1
90 fvspmd(ifv)%IADI(ii)=leni+1
91 fvspmd(ifv)%IADR(ii)=lenr+1
92 leni=leni+(itab(1,ii)+itab(2,ii)+itab(3,ii))
93 lenr=lenr+6*(itab(1,ii)+itab(2,ii)+itab(3,ii))
94 ENDDO
95 ALLOCATE(fvspmd(ifv)%IBUF(leni), fvspmd(ifv)%RBUF(lenr))
96C Reception des entiers
97 ii=0
98 DO i=1,fvspmd(ifv)%NSPMD-1
99 ii=ii+1
100 itag=msgoff
101 iad=fvspmd(ifv)%IADI(ii)
102 len=(itab(1,ii)+itab(2,ii)+itab(3,ii))
103 CALL mpi_irecv(fvspmd(ifv)%IBUF(iad), len, mpi_integer, i,
104 . itag, fvspmd(ifv)%MPI_COMM, fvspmd(ifv)%REQ(ii), ierr)
105 ENDDO
106C Reception des reels
107 ii=0
108 DO i=1,fvspmd(ifv)%NSPMD-1
109 ii=ii+1
110 itag=msgoff
111 iad=fvspmd(ifv)%IADR(ii)
112 len=6*(itab(1,ii)+itab(2,ii)+itab(3,ii))
113 CALL mpi_irecv(fvspmd(ifv)%RBUF(iad), len, real, i, itag,
114 . fvspmd(ifv)%MPI_COMM, fvspmd(ifv)%REQ(fvspmd(ifv)%NSPMD-1+ii), ierr)
115 ENDDO
116C Remplissage des tableaux de sortie XXX, XXXA,
117 len = fvspmd(ifv)%NN_L
118C ajout noeuds internes
119 len = len + fvspmd(ifv)%NNI_L
120 DO i=1,len
121 i1=fvspmd(ifv)%IBUF_L(1,i)
122 i2=fvspmd(ifv)%IBUF_L(2,i)
123 xxx(1,i1)=x(1,i2)
124 xxx(2,i1)=x(2,i2)
125 xxx(3,i1)=x(3,i2)
126 vvv(1,i1)=v(1,i2)
127 vvv(2,i1)=v(2,i2)
128 vvv(3,i1)=v(3,i2)
129
130 ENDDO
131 DO i=1,fvspmd(ifv)%NNA_L
132 i1=fvspmd(ifv)%IBUFA_L(1,i)
133 i2=fvspmd(ifv)%IBUFA_L(2,i)
134 IF(i2<=numnod) THEN
135 xxxa(1,i1)=x(1,i2)
136 xxxa(2,i1)=x(2,i2)
137 xxxa(3,i1)=x(3,i2)
138 vvva(1,i1)=v(1,i2)
139 vvva(2,i1)=v(2,i2)
140 vvva(3,i1)=v(3,i2)
141 ENDIF
142 ENDDO
143 ELSE IF(fvspmd(ifv)%RANK > 0) THEN
144 itabl(1)=fvspmd(ifv)%NN_L
145C ajout noeuds internes
146 itabl(1)=itabl(1)+fvspmd(ifv)%NNI_L
147 itabl(2)=fvspmd(ifv)%NNA_L
148 itabl(3)= 0
149 pmain=fvspmd(ifv)%PMAIN
150C
151 len=itabl(1)+itabl(2)+itabl(3)
152 ALLOCATE(fvspmd(ifv)%IBUF(len), fvspmd(ifv)%RBUF(6*len))
153 iad1=1
154 iad2=1
155 len = fvspmd(ifv)%NN_L
156 len = len + fvspmd(ifv)%NNI_L
157 DO i=1,len
158 i1=fvspmd(ifv)%IBUF_L(1,i)
159 i2=fvspmd(ifv)%IBUF_L(2,i)
160 fvspmd(ifv)%IBUF(iad1-1+i)=i1
161 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+1)=x(1,i2)
162 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+2)=x(2,i2)
163 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+3)=x(3,i2)
164 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+4)=v(1,i2)
165 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+5)=v(2,i2)
166 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+6)=v(3,i2)
167 ENDDO
168 iad1=iad1+len
169 iad2=iad2+6*len
170 DO i=1,fvspmd(ifv)%NNA_L
171 i1=fvspmd(ifv)%IBUFA_L(1,i)
172 i2=fvspmd(ifv)%IBUFA_L(2,i)
173 IF (i2 <= numnod) THEN
174 ! IF MESHGEMS IS USED, EXTRA NODES ARE NOT INCLUDED WITHIN THE NUMNOD NODES
175 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+1)=x(1,i2)
176 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+2)=x(2,i2)
177 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+3)=x(3,i2)
178 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+4)=v(1,i2)
179 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+5)=v(2,i2)
180 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+6)=v(3,i2)
181 fvspmd(ifv)%IBUF(iad1-1+i)=i1
182 ELSE
183 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+1)=zero
184 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+2)=zero
185 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+3)=zero
186 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+4)=zero
187 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+5)=zero
188 fvspmd(ifv)%RBUF(iad2-1+6*(i-1)+6)=zero
189 fvspmd(ifv)%IBUF(iad1-1+i)=-i1
190 ENDIF
191
192 ENDDO
193 iad1=iad1+fvspmd(ifv)%NNA_L
194 iad2=iad2+3*fvspmd(ifv)%NNA_L
195C
196
197 itag=msgoff
198 len=itabl(1)+itabl(2)+itabl(3)
199 CALL mpi_isend(fvspmd(ifv)%IBUF, len, mpi_integer, 0,
200 . itag, fvspmd(ifv)%MPI_COMM, fvspmd(ifv)%REQ(1), ierr)
201C
202 itag=msgoff
203 len=6*(itabl(1)+itabl(2)+itabl(3))
204 CALL mpi_isend(fvspmd(ifv)%RBUF, len, real, 0,
205 . itag, fvspmd(ifv)%MPI_COMM, fvspmd(ifv)%REQ(2), ierr)
206C
207 ENDIF
208C
209
210#endif
211 RETURN
212 END
213!||====================================================================
214!|| spmd_fvb_gath_end ../engine/source/mpi/airbags/spmd_fvb.F
215!||--- called by ------------------------------------------------------
216!|| fvupd1 ../engine/source/airbag/fvupd.F
217!||--- calls -----------------------------------------------------
218!||--- uses -----------------------------------------------------
219!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
220!||====================================================================
221 SUBROUTINE spmd_fvb_gath_end(IFV, X, XXX, XXXA,
222 . V, VVV, VVVA)
223
224C WAIT messages
225C Pmain fills XXXA,VVVA
226C-----------------------------------------------
227C M o d u l e s
228C-----------------------------------------------
229 USE fvbag_mod
230C-----------------------------------------------
231C I m p l i c i t T y p e s
232C-----------------------------------------------
233#include "implicit_f.inc"
234C-----------------------------------------------------------------
235C M e s s a g e P a s s i n g
236C-----------------------------------------------
237#include "spmd.inc"
238C-----------------------------------------------
239C C o m m o n B l o c k s
240C-----------------------------------------------
241#include "com01_c.inc"
242C-----------------------------------------------
243C D u m m y A r g u m e n t s
244C-----------------------------------------------
245 INTEGER IFV
246 my_real
247 . x(3,*), xxx(3,*), xxxa(3,*),
248 . v(3,*), vvv(3,*), vvva(3,*)
249
250C-----------------------------------------------
251C L o c a l V a r i a b l e s
252C-----------------------------------------------
253#ifdef MPI
254 INTEGER II, I, ITAG, LEN, ITAB(3,NSPMD-1),
255 . STAT(MPI_STATUS_SIZE,2*(NSPMD-1)), IERR, LENI, LENR,
256 . iad, i1, i2, iad1, iad2,
257 . j, j1, itabl(3), pmain, msgoff
258 DATA msgoff/205/
259C
260
261
262 IF (fvspmd(ifv)%RANK == 0) THEN
263 DO i=1,fvspmd(ifv)%NSPMD-1
264 itab(1,i) = fvspmd(ifv)%ITAB(1,i)
265 itab(1,i) = itab(1,i)+fvspmd(ifv)%ITAB(4,i)
266 itab(2,i) = fvspmd(ifv)%ITAB(2,i)
267 itab(3,i) = fvspmd(ifv)%ITAB(3,i)
268 ENDDO
269 ii = 0
270 DO i=1,fvspmd(ifv)%NSPMD-1
271 CALL mpi_wait(fvspmd(ifv)%REQ(i), stat, ierr)
272 CALL mpi_wait(fvspmd(ifv)%REQ(fvspmd(ifv)%NSPMD-1+i), stat, ierr)
273 ii=ii+1
274 iad1=fvspmd(ifv)%IADI(ii)
275 iad2=fvspmd(ifv)%IADR(ii)
276 DO j=1,itab(1,ii)
277 j1=fvspmd(ifv)%IBUF(iad1-1+j)
278 xxx(1,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+1)
279 xxx(2,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+2)
280 xxx(3,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+3)
281 vvv(1,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+4)
282 vvv(2,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+5)
283 vvv(3,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+6)
284 ENDDO
285 iad1=iad1+itab(1,ii)
286 iad2=iad2+6*itab(1,ii)
287 DO j=1,itab(2,ii)
288 j1=fvspmd(ifv)%IBUF(iad1-1+j)
289 IF(j1 > 0 ) THEN
290 xxxa(1,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+1)
291 xxxa(2,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+2)
292 xxxa(3,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+3)
293 vvva(1,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+4)
294 vvva(2,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+5)
295 vvva(3,j1)=fvspmd(ifv)%RBUF(iad2-1+6*(j-1)+6)
296 ENDIF
297 ENDDO
298 iad1=iad1+itab(2,ii)
299 iad2=iad2+6*itab(2,ii)
300 ENDDO
301 DEALLOCATE(fvspmd(ifv)%IBUF, fvspmd(ifv)%RBUF)
302 ELSE IF(fvspmd(ifv)%RANK > 0) THEN
303 CALL mpi_waitall(2, fvspmd(ifv)%REQ, stat, ierr)
304 DEALLOCATE(fvspmd(ifv)%IBUF, fvspmd(ifv)%RBUF)
305 ENDIF
306C
307 DEALLOCATE(fvspmd(ifv)%REQ)
308 DEALLOCATE(fvspmd(ifv)%IADR)
309 DEALLOCATE(fvspmd(ifv)%IADI)
310
311#endif
312 RETURN
313 END
314
my_real
#define my_real
Definition cppsort.cpp:32
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_waitall
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
Definition mpi.f:536
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvspmd
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
spmd_fvb_gath_end
subroutine spmd_fvb_gath_end(ifv, x, xxx, xxxa, v, vvv, vvva)
Definition spmd_fvb.F:223
spmd_fvb_gath_begin
subroutine spmd_fvb_gath_begin(ifv, x, xxx, xxxa, v, vvv, vvva)
Definition spmd_fvb.F:33