OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_rb6g.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_exch_a_rb6g ../engine/source/mpi/kinematic_conditions/spmd_exch_a_rb6g.F
26!||--- called by ------------------------------------------------------
27!|| rbyfor ../engine/source/constraints/general/rbody/rbyfor.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| message_mod ../engine/share/message_module/message_mod.f
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_exch_a_rb6g(NPBY,RBF6)
34C realise le cumul des acc et stiffness des noeuds main de rigid bodies
35C dans le cas ou tous les procs sont concernes gather/scatter proc0
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43 USE spmd_comm_world_mod, ONLY : spmd_comm_world
44#include "implicit_f.inc"
45C-----------------------------------------------------------------
46C M e s s a g e P a s s i n g
47C-----------------------------------------------
48#include "spmd.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "task_c.inc"
55#include "param_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NPBY(NNPBY,*)
60 double precision
61 . rbf6(8,6,nrbykin)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65#ifdef MPI
66 INTEGER MSGTYP,LOC_PROC,A_AR,I,J,M,P,IRB,NN,
67 . MSGOFF,SIZ,IDEB,LEN
68 INTEGER STATUS(MPI_STATUS_SIZE), REQ(NSPMD), IERROR, PMAIN
69 DATA msgoff/166/
70 parameter(a_ar = 48) ! 6*8
71 double precision
72 . buf(nrbykin*(a_ar+1)*(nspmd-1))
73C-----------------------------------------------
74C S o u r c e L i n e s
75C-----------------------------------------------
76 pmain=1
77 loc_proc = ispmd + 1
78 len=nrbykin*(a_ar+1)
79 ideb=1
80 IF(loc_proc==pmain) THEN
81 DO p = 2, nspmd
82 msgtyp = msgoff
83 CALL mpi_irecv(
84 . buf(ideb),len,mpi_double_precision,it_spmd(p),
85 . msgtyp,spmd_comm_world,req(p-1),ierror )
86 ideb = ideb+len
87 END DO
88 DO irb = 1, nrbykin
89 m = npby(1,irb)
90 IF(m <= 0) THEN
91 rbf6(1,1,irb)= zero
92 rbf6(1,2,irb)= zero
93 rbf6(1,3,irb)= zero
94 rbf6(1,4,irb)= zero
95 rbf6(1,5,irb)= zero
96 rbf6(1,6,irb)= zero
97 rbf6(2,1,irb)= zero
98 rbf6(2,2,irb)= zero
99 rbf6(2,3,irb)= zero
100 rbf6(2,4,irb)= zero
101 rbf6(2,5,irb)= zero
102 rbf6(2,6,irb)= zero
103 rbf6(3,1,irb)= zero
104 rbf6(3,2,irb)= zero
105 rbf6(3,3,irb)= zero
106 rbf6(3,4,irb)= zero
107 rbf6(3,5,irb)= zero
108 rbf6(3,6,irb)= zero
109 rbf6(4,1,irb)= zero
110 rbf6(4,2,irb)= zero
111 rbf6(4,3,irb)= zero
112 rbf6(4,4,irb)= zero
113 rbf6(4,5,irb)= zero
114 rbf6(4,6,irb)= zero
115 rbf6(5,1,irb)= zero
116 rbf6(5,2,irb)= zero
117 rbf6(5,3,irb)= zero
118 rbf6(5,4,irb)= zero
119 rbf6(5,5,irb)= zero
120 rbf6(5,6,irb)= zero
121 rbf6(6,1,irb)= zero
122 rbf6(6,2,irb)= zero
123 rbf6(6,3,irb)= zero
124 rbf6(6,4,irb)= zero
125 rbf6(6,5,irb)= zero
126 rbf6(6,6,irb)= zero
127 rbf6(7,1,irb)= zero
128 rbf6(7,2,irb)= zero
129 rbf6(7,3,irb)= zero
130 rbf6(7,4,irb)= zero
131 rbf6(7,5,irb)= zero
132 rbf6(7,6,irb)= zero
133 rbf6(8,1,irb)= zero
134 rbf6(8,2,irb)= zero
135 rbf6(8,3,irb)= zero
136 rbf6(8,4,irb)= zero
137 rbf6(8,5,irb)= zero
138 rbf6(8,6,irb)= zero
139 END IF
140 END DO
141 DO i=1,nspmd-1
142 CALL mpi_waitany(nspmd-1,req,p,status,ierror)
143 CALL mpi_get_count(status,mpi_double_precision,siz,ierror)
144 nn = siz/(a_ar+1)
145 ideb = 1+(p-1)*(a_ar+1)*nrbykin
146 DO j = 1, nn
147 irb = nint(buf(ideb))
148 ideb=ideb+1
149 rbf6(1,1,irb)= rbf6(1,1,irb) + buf(ideb)
150 rbf6(1,2,irb)= rbf6(1,2,irb) + buf(ideb+1)
151 rbf6(1,3,irb)= rbf6(1,3,irb) + buf(ideb+2)
152 rbf6(1,4,irb)= rbf6(1,4,irb) + buf(ideb+3)
153 rbf6(1,5,irb)= rbf6(1,5,irb) + buf(ideb+4)
154 rbf6(1,6,irb)= rbf6(1,6,irb) + buf(ideb+5)
155 rbf6(2,1,irb)= rbf6(2,1,irb) + buf(ideb+6)
156 rbf6(2,2,irb)= rbf6(2,2,irb) + buf(ideb+7)
157 rbf6(2,3,irb)= rbf6(2,3,irb) + buf(ideb+8)
158 rbf6(2,4,irb)= rbf6(2,4,irb) + buf(ideb+9)
159 rbf6(2,5,irb)= rbf6(2,5,irb) + buf(ideb+10)
160 rbf6(2,6,irb)= rbf6(2,6,irb) + buf(ideb+11)
161 rbf6(3,1,irb)= rbf6(3,1,irb) + buf(ideb+12)
162 rbf6(3,2,irb)= rbf6(3,2,irb) + buf(ideb+13)
163 rbf6(3,3,irb)= rbf6(3,3,irb) + buf(ideb+14)
164 rbf6(3,4,irb)= rbf6(3,4,irb) + buf(ideb+15)
165 rbf6(3,5,irb)= rbf6(3,5,irb) + buf(ideb+16)
166 rbf6(3,6,irb)= rbf6(3,6,irb) + buf(ideb+17)
167 rbf6(4,1,irb)= rbf6(4,1,irb) + buf(ideb+18)
168 rbf6(4,2,irb)= rbf6(4,2,irb) + buf(ideb+19)
169 rbf6(4,3,irb)= rbf6(4,3,irb) + buf(ideb+20)
170 rbf6(4,4,irb)= rbf6(4,4,irb) + buf(ideb+21)
171 rbf6(4,5,irb)= rbf6(4,5,irb) + buf(ideb+22)
172 rbf6(4,6,irb)= rbf6(4,6,irb) + buf(ideb+23)
173 rbf6(5,1,irb)= rbf6(5,1,irb) + buf(ideb+24)
174 rbf6(5,2,irb)= rbf6(5,2,irb) + buf(ideb+25)
175 rbf6(5,3,irb)= rbf6(5,3,irb) + buf(ideb+26)
176 rbf6(5,4,irb)= rbf6(5,4,irb) + buf(ideb+27)
177 rbf6(5,5,irb)= rbf6(5,5,irb) + buf(ideb+28)
178 rbf6(5,6,irb)= rbf6(5,6,irb) + buf(ideb+29)
179 rbf6(6,1,irb)= rbf6(6,1,irb) + buf(ideb+30)
180 rbf6(6,2,irb)= rbf6(6,2,irb) + buf(ideb+31)
181 rbf6(6,3,irb)= rbf6(6,3,irb) + buf(ideb+32)
182 rbf6(6,4,irb)= rbf6(6,4,irb) + buf(ideb+33)
183 rbf6(6,5,irb)= rbf6(6,5,irb) + buf(ideb+34)
184 rbf6(6,6,irb)= rbf6(6,6,irb) + buf(ideb+35)
185 rbf6(7,1,irb)= rbf6(7,1,irb) + buf(ideb+36)
186 rbf6(7,2,irb)= rbf6(7,2,irb) + buf(ideb+37)
187 rbf6(7,3,irb)= rbf6(7,3,irb) + buf(ideb+38)
188 rbf6(7,4,irb)= rbf6(7,4,irb) + buf(ideb+39)
189 rbf6(7,5,irb)= rbf6(7,5,irb) + buf(ideb+40)
190 rbf6(7,6,irb)= rbf6(7,6,irb) + buf(ideb+41)
191 rbf6(8,1,irb)= rbf6(8,1,irb) + buf(ideb+42)
192 rbf6(8,2,irb)= rbf6(8,2,irb) + buf(ideb+43)
193 rbf6(8,3,irb)= rbf6(8,3,irb) + buf(ideb+44)
194 rbf6(8,4,irb)= rbf6(8,4,irb) + buf(ideb+45)
195 rbf6(8,5,irb)= rbf6(8,5,irb) + buf(ideb+46)
196 rbf6(8,6,irb)= rbf6(8,6,irb) + buf(ideb+47)
197 ideb = ideb+a_ar
198 ENDDO
199 ENDDO
200 len=nrbykin*a_ar
201 CALL mpi_bcast(rbf6,len,mpi_double_precision,it_spmd(pmain),
202 . spmd_comm_world,ierror)
203C
204 ELSE
205 ideb = 1
206 DO irb = 1, nrbykin
207 m = npby(1,irb)
208 IF(m > 0) THEN
209 buf(ideb) = irb
210 ideb = ideb + 1
211 buf(ideb) = rbf6(1,1,irb)
212 buf(ideb+1) = rbf6(1,2,irb)
213 buf(ideb+2) = rbf6(1,3,irb)
214 buf(ideb+3) = rbf6(1,4,irb)
215 buf(ideb+4) = rbf6(1,5,irb)
216 buf(ideb+5) = rbf6(1,6,irb)
217 buf(ideb+6) = rbf6(2,1,irb)
218 buf(ideb+7) = rbf6(2,2,irb)
219 buf(ideb+8) = rbf6(2,3,irb)
220 buf(ideb+9) = rbf6(2,4,irb)
221 buf(ideb+10)= rbf6(2,5,irb)
222 buf(ideb+11)= rbf6(2,6,irb)
223 buf(ideb+12)= rbf6(3,1,irb)
224 buf(ideb+13)= rbf6(3,2,irb)
225 buf(ideb+14)= rbf6(3,3,irb)
226 buf(ideb+15)= rbf6(3,4,irb)
227 buf(ideb+16)= rbf6(3,5,irb)
228 buf(ideb+17)= rbf6(3,6,irb)
229 buf(ideb+18)= rbf6(4,1,irb)
230 buf(ideb+19)= rbf6(4,2,irb)
231 buf(ideb+20)= rbf6(4,3,irb)
232 buf(ideb+21)= rbf6(4,4,irb)
233 buf(ideb+22)= rbf6(4,5,irb)
234 buf(ideb+23)= rbf6(4,6,irb)
235 buf(ideb+24)= rbf6(5,1,irb)
236 buf(ideb+25)= rbf6(5,2,irb)
237 buf(ideb+26)= rbf6(5,3,irb)
238 buf(ideb+27)= rbf6(5,4,irb)
239 buf(ideb+28)= rbf6(5,5,irb)
240 buf(ideb+29)= rbf6(5,6,irb)
241 buf(ideb+30)= rbf6(6,1,irb)
242 buf(ideb+31)= rbf6(6,2,irb)
243 buf(ideb+32)= rbf6(6,3,irb)
244 buf(ideb+33)= rbf6(6,4,irb)
245 buf(ideb+34)= rbf6(6,5,irb)
246 buf(ideb+35)= rbf6(6,6,irb)
247 buf(ideb+36)= rbf6(7,1,irb)
248 buf(ideb+37)= rbf6(7,2,irb)
249 buf(ideb+38)= rbf6(7,3,irb)
250 buf(ideb+39)= rbf6(7,4,irb)
251 buf(ideb+40)= rbf6(7,5,irb)
252 buf(ideb+41)= rbf6(7,6,irb)
253 buf(ideb+42)= rbf6(8,1,irb)
254 buf(ideb+43)= rbf6(8,2,irb)
255 buf(ideb+44)= rbf6(8,3,irb)
256 buf(ideb+45)= rbf6(8,4,irb)
257 buf(ideb+46)= rbf6(8,5,irb)
258 buf(ideb+47)= rbf6(8,6,irb)
259 ideb = ideb + a_ar
260 ENDIF
261 ENDDO
262 msgtyp = msgoff
263 len=ideb-1
264 CALL mpi_send(buf,len,mpi_double_precision,it_spmd(pmain),
265 . msgtyp,spmd_comm_world,ierror)
266 len=nrbykin*a_ar
267 CALL mpi_bcast(rbf6,len,mpi_double_precision,it_spmd(pmain),
268 . spmd_comm_world,ierror)
269C
270 END IF
271C
272#endif
273 RETURN
274 END
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
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_bcast
subroutine mpi_bcast(buffer, cnt, datatype, root, comm, ierr)
Definition mpi.f:205
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
message_mod
Definition message_mod.F:1249
spmd_exch_a_rb6g
subroutine spmd_exch_a_rb6g(npby, rbf6)
Definition spmd_exch_a_rb6g.F:34