OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_sphgetv.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_sphgetv ../engine/source/mpi/sph/spmd_sphgetv.F
25!||--- called by ------------------------------------------------------
26!|| sphprep ../engine/source/elements/sph/sphprep.F
27!||--- calls -----------------------------------------------------
28!|| spmd_ialltoallv ../engine/source/mpi/generic/spmd_ialltoallv.F
29!|| spmd_ialltoallv_int ../engine/source/mpi/generic/spmd_ialltoallv_int.F
30!||--- uses -----------------------------------------------------
31!|| sphbox ../engine/share/modules/sphbox.F
32!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
33!||====================================================================
34 SUBROUTINE spmd_sphgetv(KXSP ,SPBUF, V, MS, ISORTSP, IPARTSP)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE sphbox
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42 USE spmd_comm_world_mod, ONLY : spmd_comm_world
43#include "implicit_f.inc"
44C-----------------------------------------------
45C M e s s a g e P a s s i n g
46C-----------------------------------------------
47#include "spmd.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52ctmp+1
53#include "task_c.inc"
54#include "sphcom.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER KXSP(NISP,*), ISORTSP, IPARTSP(*)
59 my_real
60 . spbuf(nspbuf,*), v(3,*), ms(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64#ifdef MPI
65 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
66 . IERROR, ICELL, INOD,
67 . REQ_SD(NSPMD), REQ_SD2(NSPMD),
68 . STATUS(MPI_STATUS_SIZE),MSGOFF,MSGOFF2
69 my_real, DIMENSION(:,:), ALLOCATABLE :: bufs, bufr
70
71 INTEGER, DIMENSION(NSPMD) :: DISPLS_ISPHR,DISPLS_ISPHS
72 INTEGER, DIMENSION(NSPMD) :: SEND_SIZE_ISPHR,RCV_SIZE_ISPHS
73 INTEGER :: TOTAL_SEND_SIZE_ISPHR,TOTAL_RCV_SIZE_ISPHS
74 INTEGER :: REQUEST_ISPHR
75
76 INTEGER, DIMENSION(NSPMD) :: DISPLS_BUFS,DISPLS_BUFR
77 INTEGER, DIMENSION(NSPMD) :: SEND_SIZE_BUFS,RCV_SIZE_BUFR
78 INTEGER :: TOTAL_SEND_SIZE_BUFS,TOTAL_RCV_SIZE_BUFR
79 INTEGER :: REQUEST_BUFS
80 DATA msgoff/2008/
81 DATA msgoff2/2009/
82C-----------------------------------------------
83C S o u r c e L i n e s
84C-----------------------------------------------
85 loc_proc = ispmd+1
86C
87C Envoi flag cellules actives
88C
89! -------------------------
90! compute the displacement, number of element
91! and total number of element (send and rcv)
92 displs_isphr(1:nspmd) = 0
93 displs_isphs(1:nspmd) = 0
94 send_size_isphr(1:nspmd) = 0
95 rcv_size_isphs(1:nspmd) = 0
96 total_send_size_isphr = 0
97 total_rcv_size_isphs = 0
98
99
100 displs_isphr(1) = 0
101 displs_isphs(1) = 0
102 DO p=1,nspmd
103 send_size_isphr(p) = psphr(p)
104 rcv_size_isphs(p) = psphs(p)
105 total_send_size_isphr = total_send_size_isphr + send_size_isphr(p)
106 total_rcv_size_isphs = total_rcv_size_isphs + rcv_size_isphs(p)
107 ENDDO
108 DO p=2,nspmd
109 displs_isphr(p) = displs_isphr(p-1) + send_size_isphr(p-1)
110 displs_isphs(p) = displs_isphs(p-1) + rcv_size_isphs(p-1)
111 ENDDO
112! -------------------------
113
114! -------------------------
115! alltoall communication with non-uniform size
116! for integer array : send : ISPHR --> rcv : ISPHS
117 CALL spmd_ialltoallv_int(isphr,isphs,
118 . send_size_isphr,total_send_size_isphr,displs_isphr,
119 . total_rcv_size_isphs,rcv_size_isphs,displs_isphs,
120 . request_isphr,spmd_comm_world,nspmd)
121! -------------------------
122
123C Envoi V, M, RHO sur cellules actives
124C
125
126! -------------------------
127! compute the displacement, number of element
128! and total number of element (send and rcv)
129 displs_bufs(1:nspmd) = 0
130 displs_bufr(1:nspmd) = 0
131 send_size_bufs(1:nspmd) = 0
132 rcv_size_bufr(1:nspmd) = 0
133 total_send_size_bufs = 0
134 total_rcv_size_bufr = 0
135
136
137 displs_bufs(1) = 0
138 displs_bufr(1) = 0
139
140 DO p=1,nspmd
141 send_size_bufs(p) = psphs(p)
142 rcv_size_bufr(p) = psphr(p)
143 total_send_size_bufs = total_send_size_bufs + send_size_bufs(p)
144 total_rcv_size_bufr = total_rcv_size_bufr + rcv_size_bufr(p)
145 ENDDO
146
147 DO p=2,nspmd
148 displs_bufs(p) = displs_bufs(p-1) + 7*send_size_bufs(p-1)
149 displs_bufr(p) = displs_bufr(p-1) + 7*rcv_size_bufr(p-1)
150 ENDDO
151
152 ALLOCATE( bufs(7,total_send_size_bufs) )
153 ALLOCATE( bufr(7,total_rcv_size_bufr) )
154
155 total_send_size_bufs = 7*total_send_size_bufs
156 total_rcv_size_bufr = 7*total_rcv_size_bufr
157 send_size_bufs(1:nspmd) = 7*send_size_bufs(1:nspmd)
158 rcv_size_bufr(1:nspmd) = 7*rcv_size_bufr(1:nspmd)
159! -------------------------
160
161#if _PLMPI
162! -------------------------
163! PLMPI uses MPI-2.x version without non blocking alltoallv comm
164! -------------------------
165#else
166! -------------------------
167! wait the previous comm : ISPHR --> ISPHS
168 CALL mpi_wait(request_isphr,status,ierror)
169! -------------------------
170#endif
171
172! -------------------------
173! fill the buffer
174 ideb = 0
175 nn = 0
176 DO p = 1, nspmd
177ctmp+1
178 nn = 0
179 IF(psphs(p)/=0)THEN
180 DO n = 1, psphs(p)
181 IF(isortsp == 1)THEN
182 nn = nn + 1
183 icell = lsphs(ideb+n)
184 inod = kxsp(3,icell)
185 bufs(1,ideb+nn) = spbuf(2,icell)
186 bufs(2,ideb+nn) = spbuf(12,icell)
187 bufs(3,ideb+nn) = v(1,inod)
188 bufs(4,ideb+nn) = v(2,inod)
189 bufs(5,ideb+nn) = v(3,inod)
190 bufs(6,ideb+nn) = kxsp(2,icell)
191 bufs(7,ideb+nn) = ipartsp(icell)
192 ELSEIF(isphs(ideb+n)==1) THEN
193 nn = nn + 1
194 icell = lsphs(ideb+n)
195 inod = kxsp(3,icell)
196 bufs(1,ideb+nn) = spbuf(2,icell)
197 bufs(2,ideb+nn) = spbuf(12,icell)
198 bufs(3,ideb+nn) = v(1,inod)
199 bufs(4,ideb+nn) = v(2,inod)
200 bufs(5,ideb+nn) = v(3,inod)
201 bufs(6,ideb+nn) = kxsp(2,icell)
202 bufs(7,ideb+nn) = ipartsp(icell)
203 END IF
204 END DO
205 ideb = ideb + psphs(p)
206ctmp+1
207 END IF
208 END DO
209! -------------------------
210
211! -------------------------
212! alltoall communication with non-uniform size
213! for real array : send : BUFS --> rcv : BUFR
214 CALL spmd_ialltoallv(bufs,bufr,
215 . send_size_bufs,total_send_size_bufs,displs_bufs,
216 . total_rcv_size_bufr,rcv_size_bufr,displs_bufr,
217 . request_bufs,spmd_comm_world,nspmd)
218! -------------------------
219C
220C Reception V, M, RHO
221
222#if _PLMPI
223! -------------------------
224! PLMPI uses MPI-2.x version without non blocking alltoallv comm
225! -------------------------
226#else
227! -------------------------
228! wait the previous comm : BUFS --> BUFR
229 CALL mpi_wait(request_bufs,status,ierror)
230! -------------------------
231#endif
232
233C
234 ideb = 0
235 nn = 0
236 DO p = 1, nspmd
237
238 IF(psphr(p)/=0)THEN
239 nn = 0
240 DO n = 1, psphr(p)
241 IF(isortsp == 1)THEN
242 nn = nn + 1
243 xsphr(7,ideb+n) = bufr(1,ideb+nn)
244 xsphr(8,ideb+n) = bufr(2,ideb+nn)
245 xsphr(9,ideb+n) = bufr(3,ideb+nn)
246 xsphr(10,ideb+n)= bufr(4,ideb+nn)
247 xsphr(11,ideb+n)= bufr(5,ideb+nn)
248 xsphr(13,ideb+n)= bufr(6,ideb+nn)
249 xsphr(14,ideb+n)= bufr(7,ideb+nn)
250 ELSEIF(isphr(ideb+n)==1) THEN
251 nn = nn + 1
252 xsphr(7,ideb+n) = bufr(1,ideb+nn)
253 xsphr(8,ideb+n) = bufr(2,ideb+nn)
254 xsphr(9,ideb+n) = bufr(3,ideb+nn)
255 xsphr(10,ideb+n)= bufr(4,ideb+nn)
256 xsphr(11,ideb+n)= bufr(5,ideb+nn)
257 xsphr(13,ideb+n)= bufr(6,ideb+nn)
258 xsphr(14,ideb+n)= bufr(7,ideb+nn)
259 END IF
260 END DO
261 ideb = ideb + psphr(p)
262 END IF
263 END DO
264
265 DEALLOCATE( bufs )
266 DEALLOCATE( bufr )
267
268#endif
269 RETURN
270 END
my_real
#define my_real
Definition cppsort.cpp:32
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
sphbox::isphs
integer, dimension(:), allocatable isphs
Definition sphbox.F:87
sphbox::lsphs
integer, dimension(:), allocatable lsphs
Definition sphbox.F:91
sphbox::isphr
integer, dimension(:), allocatable isphr
Definition sphbox.F:87
sphbox::psphr
integer, dimension(:), allocatable psphr
Definition sphbox.F:89
sphbox::psphs
integer, dimension(:), allocatable psphs
Definition sphbox.F:89
spmd_ialltoallv
subroutine spmd_ialltoallv(sendbuf, recvbuf, send_size, total_send_size, sdispls, total_rcv_size, rcv_size, rdispls, request, comm, nb_proc)
Definition spmd_ialltoallv.F:34
spmd_ialltoallv_int
subroutine spmd_ialltoallv_int(sendbuf, recvbuf, send_size, total_send_size, sdispls, total_rcv_size, rcv_size, rdispls, request, comm, nb_proc)
Definition spmd_ialltoallv_int.F:35
spmd_sphgetv
subroutine spmd_sphgetv(kxsp, spbuf, v, ms, isortsp, ipartsp)
Definition spmd_sphgetv.F:35