OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_rb6.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/.
23C
24!||====================================================================
25!|| spmd_exch_a_rb6 ../engine/source/mpi/kinematic_conditions/spmd_exch_a_rb6.F
26!||--- called by ------------------------------------------------------
27!|| rbyfor ../engine/source/constraints/general/rbody/rbyfor.F
28!|| sms_encin_2 ../engine/source/ams/sms_encin_2.F
29!|| sms_mass_scale_2 ../engine/source/ams/sms_mass_scale_2.F
30!|| sms_pcg ../engine/source/ams/sms_pcg.F
31!||--- calls -----------------------------------------------------
32!||--- uses -----------------------------------------------------
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
35!||====================================================================
36 SUBROUTINE spmd_exch_a_rb6(NRBDIM,IAD_RBY,FR_RBY6,ICSIZE,RBF6)
37C make summation of acc and stiffness for main nodes of rigid bodies
38C and make summation of other quantities for AMS
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46 USE spmd_comm_world_mod, ONLY : spmd_comm_world
47#include "implicit_f.inc"
48C-----------------------------------------------------------------
49C M e s s a g e P a s s i n g
50C-----------------------------------------------
51#include "spmd.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "task_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER NRBDIM,ICSIZE, IAD_RBY(*),FR_RBY6(*)
62 double precision
63 . rbf6(8,6,nrbykin)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67#ifdef MPI
68 INTEGER MSGTYP,LOC_PROC,A_AR,L,I,J,K,IAD,IRB,
69 . MSGOFF,SIZ,IDEB, LEN,INDEX,NBINDEX,
70 . INDEXI(NSPMD),REQ_R(NSPMD),REQ_S(NSPMD)
71 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
72 DATA msgoff/165/
73 double precision
74 . rbuf(icsize*6*nrbdim), sbuf(icsize*6*nrbdim)
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78 a_ar=6*nrbdim
79
80 loc_proc = ispmd + 1
81 ideb = 1
82 l = 0
83 DO i = 1, nspmd
84 len = iad_rby(i+1)-iad_rby(i)
85 IF(len>0) THEN
86 siz = len*a_ar
87 l=l+1
88 indexi(l)=i
89 msgtyp = msgoff
90 CALL mpi_irecv(
91 s rbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
92 g spmd_comm_world,req_r(l),ierror)
93 ideb = ideb + siz
94 ENDIF
95 ENDDO
96 nbindex = l
97C
98 ideb = 1
99 DO l = 1, nbindex
100 i = indexi(l)
101 len = iad_rby(i+1)-iad_rby(i)
102 iad = iad_rby(i)-1
103#include "vectorize.inc"
104 DO j = 1, len
105 irb = fr_rby6(iad+j)
106 DO k = 1, nrbdim
107 sbuf(ideb) = rbf6(k,1,irb)
108 sbuf(ideb+1) = rbf6(k,2,irb)
109 sbuf(ideb+2) = rbf6(k,3,irb)
110 sbuf(ideb+3) = rbf6(k,4,irb)
111 sbuf(ideb+4) = rbf6(k,5,irb)
112 sbuf(ideb+5) = rbf6(k,6,irb)
113 ideb=ideb+6
114 ENDDO
115 ENDDO
116 ENDDO
117C
118 ideb = 1
119 DO l=1,nbindex
120 i = indexi(l)
121 len = iad_rby(i+1)-iad_rby(i)
122 siz = len*a_ar
123 msgtyp = msgoff
124 CALL mpi_isend(
125 s sbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
126 g spmd_comm_world,req_s(l),ierror)
127 ideb = ideb + siz
128 ENDDO
129C
130 DO l=1,nbindex
131 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
132 i = indexi(index)
133 ideb = 1+(iad_rby(i)-1)*a_ar
134 len = iad_rby(i+1)-iad_rby(i)
135 iad = iad_rby(i)-1
136#include "vectorize.inc"
137 DO j = 1, len
138 irb = fr_rby6(iad+j)
139 DO k = 1, nrbdim
140 rbf6(k,1,irb)= rbf6(k,1,irb) + rbuf(ideb)
141 rbf6(k,2,irb)= rbf6(k,2,irb) + rbuf(ideb+1)
142 rbf6(k,3,irb)= rbf6(k,3,irb) + rbuf(ideb+2)
143 rbf6(k,4,irb)= rbf6(k,4,irb) + rbuf(ideb+3)
144 rbf6(k,5,irb)= rbf6(k,5,irb) + rbuf(ideb+4)
145 rbf6(k,6,irb)= rbf6(k,6,irb) + rbuf(ideb+5)
146 ideb = ideb + 6
147 ENDDO
148 ENDDO
149 ENDDO
150C
151 DO l=1,nbindex
152 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
153 ENDDO
154C
155#endif
156 RETURN
157 END
158C
159!||====================================================================
160!|| spmd_exch_a_rb6_vrel ../engine/source/mpi/kinematic_conditions/spmd_exch_a_rb6.F
161!||--- called by ------------------------------------------------------
162!|| rbyfor ../engine/source/constraints/general/rbody/rbyfor.F
163!||--- calls -----------------------------------------------------
164!||--- uses -----------------------------------------------------
165!|| message_mod ../engine/share/message_module/message_mod.F
166!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
167!||====================================================================
168 SUBROUTINE spmd_exch_a_rb6_vrel(NRBDIM,IAD_RBY,FR_RBY6,ICSIZE,RBY6,
169 . RBY6_C,SIZE_RBY6_C)
170C make summation of acc, stiffness for main nodes of rigid bodies
171C make summation of damping coefficient for /DAMP/VREL
172C-----------------------------------------------
173C M o d u l e s
174C-----------------------------------------------
175 USE message_mod
176C-----------------------------------------------
177C I m p l i c i t T y p e s
178C-----------------------------------------------
179 USE spmd_comm_world_mod, ONLY : spmd_comm_world
180#include "implicit_f.inc"
181C-----------------------------------------------------------------
182C M e s s a g e P a s s i n g
183C-----------------------------------------------
184#include "spmd.inc"
185C-----------------------------------------------
186C C o m m o n B l o c k s
187C-----------------------------------------------
188#include "com01_c.inc"
189#include "com04_c.inc"
190#include "task_c.inc"
191C-----------------------------------------------
192C D u m m y A r g u m e n t s
193C-----------------------------------------------
194 INTEGER NRBDIM,ICSIZE, IAD_RBY(*),FR_RBY6(*),SIZE_RBY6_C
195 double precision
196 . rby6(8,6,nrbykin),rby6_c(2,6,size_rby6_c)
197C-----------------------------------------------
198C L o c a l V a r i a b l e s
199C-----------------------------------------------
200#ifdef MPI
201 INTEGER MSGTYP,LOC_PROC,A_AR,L,I,J,K,IAD,IRB,
202 . msgoff,siz,ideb, len,index,nbindex,
203 . indexi(nspmd),req_r(nspmd),req_s(nspmd)
204 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
205 DATA msgoff/165/
206 double precision
207 . rbuf(icsize*6*nrbdim), sbuf(icsize*6*nrbdim)
208C-----------------------------------------------
209C S o u r c e L i n e s
210C-----------------------------------------------
211 a_ar=6*nrbdim
212
213 loc_proc = ispmd + 1
214 ideb = 1
215 l = 0
216 DO i = 1, nspmd
217 len = iad_rby(i+1)-iad_rby(i)
218 IF(len>0) THEN
219 siz = len*a_ar
220 l=l+1
221 indexi(l)=i
222 msgtyp = msgoff
223 CALL mpi_irecv(
224 s rbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
225 g spmd_comm_world,req_r(l),ierror)
226 ideb = ideb + siz
227 ENDIF
228 ENDDO
229 nbindex = l
230C
231 ideb = 1
232 DO l = 1, nbindex
233 i = indexi(l)
234 len = iad_rby(i+1)-iad_rby(i)
235 iad = iad_rby(i)-1
236#include "vectorize.inc"
237 DO j = 1, len
238 irb = fr_rby6(iad+j)
239 DO k = 1, nrbdim-2
240 sbuf(ideb) = rby6(k,1,irb)
241 sbuf(ideb+1) = rby6(k,2,irb)
242 sbuf(ideb+2) = rby6(k,3,irb)
243 sbuf(ideb+3) = rby6(k,4,irb)
244 sbuf(ideb+4) = rby6(k,5,irb)
245 sbuf(ideb+5) = rby6(k,6,irb)
246 ideb=ideb+6
247 ENDDO
248 DO k = 1, 2
249 sbuf(ideb) = rby6_c(k,1,irb)
250 sbuf(ideb+1) = rby6_c(k,2,irb)
251 sbuf(ideb+2) = rby6_c(k,3,irb)
252 sbuf(ideb+3) = rby6_c(k,4,irb)
253 sbuf(ideb+4) = rby6_c(k,5,irb)
254 sbuf(ideb+5) = rby6_c(k,6,irb)
255 ideb=ideb+6
256 ENDDO
257 ENDDO
258 ENDDO
259C
260 ideb = 1
261 DO l=1,nbindex
262 i = indexi(l)
263 len = iad_rby(i+1)-iad_rby(i)
264 siz = len*a_ar
265 msgtyp = msgoff
266 CALL mpi_isend(
267 s sbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
268 g spmd_comm_world,req_s(l),ierror)
269 ideb = ideb + siz
270 ENDDO
271C
272 DO l=1,nbindex
273 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
274 i = indexi(index)
275 ideb = 1+(iad_rby(i)-1)*a_ar
276 len = iad_rby(i+1)-iad_rby(i)
277 iad = iad_rby(i)-1
278#include "vectorize.inc"
279 DO j = 1, len
280 irb = fr_rby6(iad+j)
281 DO k = 1, nrbdim-2
282 rby6(k,1,irb)= rby6(k,1,irb) + rbuf(ideb)
283 rby6(k,2,irb)= rby6(k,2,irb) + rbuf(ideb+1)
284 rby6(k,3,irb)= rby6(k,3,irb) + rbuf(ideb+2)
285 rby6(k,4,irb)= rby6(k,4,irb) + rbuf(ideb+3)
286 rby6(k,5,irb)= rby6(k,5,irb) + rbuf(ideb+4)
287 rby6(k,6,irb)= rby6(k,6,irb) + rbuf(ideb+5)
288 ideb = ideb + 6
289 ENDDO
290 DO k = 1, 2
291 rby6_c(k,1,irb)= rby6_c(k,1,irb) + rbuf(ideb)
292 rby6_c(k,2,irb)= rby6_c(k,2,irb) + rbuf(ideb+1)
293 rby6_c(k,3,irb)= rby6_c(k,3,irb) + rbuf(ideb+2)
294 rby6_c(k,4,irb)= rby6_c(k,4,irb) + rbuf(ideb+3)
295 rby6_c(k,5,irb)= rby6_c(k,5,irb) + rbuf(ideb+4)
296 rby6_c(k,6,irb)= rby6_c(k,6,irb) + rbuf(ideb+5)
297 ideb = ideb + 6
298 ENDDO
299 ENDDO
300 ENDDO
301C
302 DO l=1,nbindex
303 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
304 ENDDO
305C
306#endif
307 RETURN
308 END
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
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
message_mod
Definition message_mod.F:1257
spmd_exch_a_rb6_vrel
subroutine spmd_exch_a_rb6_vrel(nrbdim, iad_rby, fr_rby6, icsize, rby6, rby6_c, size_rby6_c)
Definition spmd_exch_a_rb6.F:170
spmd_exch_a_rb6
subroutine spmd_exch_a_rb6(nrbdim, iad_rby, fr_rby6, icsize, rbf6)
Definition spmd_exch_a_rb6.F:37