OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_sd_skw.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_sd_skw ../engine/source/mpi/output/spmd_sd_skw.F
25!||--- called by ------------------------------------------------------
26!|| newskw ../engine/source/tools/skew/newskw.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
30!||====================================================================
31 SUBROUTINE spmd_sd_skw(SKEW,ISKWP_L_SEND,NUMSKW_L_SEND,RECVCOUNT)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35 USE spmd_comm_world_mod, ONLY : spmd_comm_world
36#include "implicit_f.inc"
37C-----------------------------------------------------------------
38C M e s s a g e P a s s i n g
39C-----------------------------------------------
40#include "spmd.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com01_c.inc"
45#include "com04_c.inc"
46#include "task_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER :: NUMSKW_L_SEND
52 INTEGER, DIMENSION(NUMSKW_L_SEND), INTENT(IN) :: ISKWP_L_SEND
53 my_real, DIMENSION(LSKEW,*), INTENT(INOUT) :: skew
54 INTEGER, DIMENSION(NSPMD), INTENT(IN) :: RECVCOUNT
55! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
56! NUMSKW_L_SEND : integer
57! number of sent SKEW
58! ISKWP_L_SEND : integer ; dimension=NUMSKW_L_SEND
59! index of sent SKEW
60! SKEW : integer ; dimension=LSKEW*number of SKEW
61! SKEW array
62! RECVCOUNT : integer ; dimension=NSPMD
63! number of received SKEW
64! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68#ifdef MPI
69 INTEGER :: I,K,N,LOC_PROC,NN
70 INTEGER :: IERROR
71 INTEGER :: SENDCOUNT,TOTAL_RECV
72 INTEGER, DIMENSION(NSPMD) :: DIPSPL
73 my_real, DIMENSION(10*NUMSKW) :: sbuf,rbuf
74
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78!$COMMENT
79! SPMD_SD_SKW description
80! communication of SKEW array with a ALLGATHERV comm
81!
82! SPMD_SD_SKW organization :
83! - initialize the SBUF buffer with the local SKEW value
84! - initialize the displacement and the total number of
85! received SKEW
86! - Allgatherv com
87! - fill the SKEW array with the received RBUFF buffer
88!
89! proc 1 :
90! SBUF : 1 | 4 | 100 (--> 3 values)
91! proc 2 :
92! SBUF : 2 | 3 (--> 2 values)
93! proc 3 :
94! SBUF : 5 | 99 | 102 | 1000 (--> 4 values)
95! displacement :
96! DIPSPL(1) = 0
97! DIPSPL(2) = 3
98! DIPSPL(3) = 5
99!
100! RBUF :
101! 1 | 4 | 100 | 2 | 3 | 5 | 99 | 102 | 1000
102!
103!$ENDCOMMENT
104
105 loc_proc = ispmd + 1
106 dipspl(1:nspmd) = 0
107 k = 0
108! initialization of SBUF
109 DO nn = 1, numskw_l_send
110 n = iskwp_l_send(nn)
111 k = k + 1
112 sbuf(1+(k-1)*10) = skew(1,n+1)
113 sbuf(2+(k-1)*10) = skew(2,n+1)
114 sbuf(3+(k-1)*10) = skew(3,n+1)
115 sbuf(4+(k-1)*10) = skew(4,n+1)
116 sbuf(5+(k-1)*10) = skew(5,n+1)
117 sbuf(6+(k-1)*10) = skew(6,n+1)
118 sbuf(7+(k-1)*10) = skew(7,n+1)
119 sbuf(8+(k-1)*10) = skew(8,n+1)
120 sbuf(9+(k-1)*10) = skew(9,n+1)
121 sbuf(10+(k-1)*10) = n+1
122 END DO
123
124! displacement, number of sent value and total number of received values
125 sendcount = k*10
126 dipspl(1)=0
127 total_recv = recvcount(1)
128 DO i=2,nspmd
129 dipspl(i)=recvcount(i-1)+dipspl(i-1)
130 total_recv = total_recv + recvcount(i)
131 ENDDO
132 total_recv = total_recv / 10
133
134! comm
135 CALL mpi_allgatherv(sbuf,sendcount,real,rbuf,recvcount,dipspl,real,spmd_comm_world,ierror)
136
137! fill the SKEW array
138 DO i=1,total_recv
139 k = nint(rbuf(10+(i-1)*10))
140 skew(1,k) = rbuf(1+(i-1)*10)
141 skew(2,k) = rbuf(2+(i-1)*10)
142 skew(3,k) = rbuf(3+(i-1)*10)
143 skew(4,k) = rbuf(4+(i-1)*10)
144 skew(5,k) = rbuf(5+(i-1)*10)
145 skew(6,k) = rbuf(6+(i-1)*10)
146 skew(7,k) = rbuf(7+(i-1)*10)
147 skew(8,k) = rbuf(8+(i-1)*10)
148 skew(9,k) = rbuf(9+(i-1)*10)
149 ENDDO
150C
151#endif
152 RETURN
153 END SUBROUTINE spmd_sd_skw
154C
155!||====================================================================
156!|| spmd_sd_skw_anim ../engine/source/mpi/output/spmd_sd_skw.F
157!||--- called by ------------------------------------------------------
158!|| sortie_main ../engine/source/output/sortie_main.F
159!||--- calls -----------------------------------------------------
160!||--- uses -----------------------------------------------------
161!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
162!||====================================================================
163 SUBROUTINE spmd_sd_skw_anim(SKEW,ISKWP)
164C-----------------------------------------------
165C I m p l i c i t T y p e s
166C-----------------------------------------------
167 USE spmd_comm_world_mod, ONLY : spmd_comm_world
168#include "implicit_f.inc"
169C-----------------------------------------------------------------
170C M e s s a g e P a s s i n g
171C-----------------------------------------------
172#include "spmd.inc"
173C-----------------------------------------------
174C C o m m o n B l o c k s
175C-----------------------------------------------
176#include "com01_c.inc"
177#include "com04_c.inc"
178#include "task_c.inc"
179#include "param_c.inc"
180C-----------------------------------------------
181C D u m m y A r g u m e n t s
182C-----------------------------------------------
183 INTEGER, DIMENSION(*), INTENT(IN) :: ISKWP
184 my_real, DIMENSION(LSKEW,*), INTENT(INOUT) :: skew
185! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
186! ISKWP : integer ; dimension=NUMSKW+1
187! give the location of the SKEW
188! a SKEW can be on several processor
189! SKEW : integer ; dimension=LSKEW*number of SKEW
190! SKEW array
191! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
192C-----------------------------------------------
193C L o c a l V a r i a b l e s
194C-----------------------------------------------
195#ifdef MPI
196 INTEGER :: I,K,N,LOC_PROC
197 INTEGER :: IERROR
198 INTEGER :: SENDCOUNT,TOTAL_RECV
199 INTEGER, DIMENSION(NSPMD) :: RECVCOUNT,DIPSPL
200 my_real, DIMENSION(10*NUMSKW) :: sbuf,rbuf
201C-----------------------------------------------
202C S o u r c e L i n e s
203C-----------------------------------------------
204!$COMMENT
205! spmd_sd_skw_anim description
206! communication of SKEW array with a ALLGATHERV comm
207! on main processor (proc 0) before the animation
208!
209! SPMD_SD_SKW_ANIM organization :
210! - initialize the SBUF buffer with the local SKEW value
211! - initialize the displacement and the total number of
212! received SKEW
213! - ALLGATHER comm on 0 proc
214! - fill the SKEW array with the received RBUFF buffer
215!
216! proc 1 :
217! SBUF : 1 | 4 | 100 (--> 3 values)
218! proc 2 :
219! sbuf : 2 | 3 (--> 2 values)
220! proc 3 :
221! SBUF : 5 | 99 | 102 | 1000 (--> 4 values)
222! displacement :
223! DIPSPL(1) = 0
224! DIPSPL(2) = 3
225! DIPSPL(3) = 5
226!
227! RBUF (on main proc):
228! 1 | 4 | 100 | 2 | 3 | 5 | 99 | 102 | 1000
229!
230!$ENDCOMMENT
231 loc_proc = ispmd + 1
232 recvcount(1:nspmd) = 0
233 dipspl(1:nspmd) = 0
234 k = 0
235! initialization of SBUF
236 DO n = 1, numskw
237 IF(abs(iskwp(n+1))==loc_proc)THEN
238 k = k + 1
239 sbuf(1+(k-1)*10) = skew(1,n+1)
240 sbuf(2+(k-1)*10) = skew(2,n+1)
241 sbuf(3+(k-1)*10) = skew(3,n+1)
242 sbuf(4+(k-1)*10) = skew(4,n+1)
243 sbuf(5+(k-1)*10) = skew(5,n+1)
244 sbuf(6+(k-1)*10) = skew(6,n+1)
245 sbuf(7+(k-1)*10) = skew(7,n+1)
246 sbuf(8+(k-1)*10) = skew(8,n+1)
247 sbuf(9+(k-1)*10) = skew(9,n+1)
248 sbuf(10+(k-1)*10) = n+1
249 END IF
250 IF(iskwp(n+1)/=0) recvcount(abs(iskwp(n+1))) = recvcount(abs(iskwp(n+1))) + 10
251 END DO
252
253! displacement, number of sent value and total number of received values
254 sendcount = k*10
255 dipspl(1)=0
256 total_recv = recvcount(1)
257 DO i=2,nspmd
258 dipspl(i)=recvcount(i-1)+dipspl(i-1)
259 total_recv = total_recv + recvcount(i)
260 ENDDO
261 total_recv = total_recv / 10
262
263! comm on proc 0 (main)
264 CALL mpi_gatherv(sbuf,sendcount,real,rbuf,recvcount,dipspl,real,0,spmd_comm_world,ierror)
265
266! fill the RBUF array (only main proc)
267 IF(ispmd==0) THEN
268 DO i=1,total_recv
269 k = nint(rbuf(10+(i-1)*10))
270 skew(1,k) = rbuf(1+(i-1)*10)
271 skew(2,k) = rbuf(2+(i-1)*10)
272 skew(3,k) = rbuf(3+(i-1)*10)
273 skew(4,k) = rbuf(4+(i-1)*10)
274 skew(5,k) = rbuf(5+(i-1)*10)
275 skew(6,k) = rbuf(6+(i-1)*10)
276 skew(7,k) = rbuf(7+(i-1)*10)
277 skew(8,k) = rbuf(8+(i-1)*10)
278 skew(9,k) = rbuf(9+(i-1)*10)
279 ENDDO
280 ENDIF
281C
282#endif
283 RETURN
284 END SUBROUTINE spmd_sd_skw_anim
my_real
#define my_real
Definition cppsort.cpp:32
mpi_gatherv
subroutine mpi_gatherv(sendbuf, cnt, datatype, recvbuf, reccnt, displs, rectype, root, comm, ierr)
Definition mpi.f:76
spmd_sd_skw
subroutine spmd_sd_skw(skew, iskwp_l_send, numskw_l_send, recvcount)
Definition spmd_sd_skw.F:32
spmd_sd_skw_anim
subroutine spmd_sd_skw_anim(skew, iskwp)
Definition spmd_sd_skw.F:164