OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_rbe3.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_exch_rbe3 ../engine/source/mpi/kinematic_conditions/spmd_exch_rbe3.F
25!||--- called by ------------------------------------------------------
26!|| rbe3t1 ../engine/source/constraints/general/rbe3/rbe3f.f
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
30!||====================================================================
31 SUBROUTINE spmd_exch_rbe3(
32 1 A ,AR ,MS ,IN ,STIFN,
33 2 STIFR,FR_M ,IAD_M ,LCOMM ,ISIZE,
34 3 IROT )
35C realise le cumul des acc et masses aux noeuds main d'Rbe3
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39 USE spmd_comm_world_mod, ONLY : spmd_comm_world
40#include "implicit_f.inc"
41C-----------------------------------------------
42C M e s s a g e P a s s i n g
43C-----------------------------------------------
44#include "spmd.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "task_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER LCOMM, ISIZE, FR_M(*), IAD_M(*),IROT
54 my_real
55 . A(3,*), AR(3,*), MS(*), IN(*),
56 . stifn(*), stifr(*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60#ifdef MPI
61 INTEGER MSGTYP,LOC_PROC,NOD,I,J,L,IDEB,IAD,LEN,
62 . NBINDEX,INDEX,MSGOFF,SIZ,IERROR,
63 . STATUS(MPI_STATUS_SIZE),
64 . req_s(nspmd),req_r(nspmd),indexi(nspmd)
65 DATA msgoff/207/
66 my_real
67 . sbuf(lcomm*isize), rbuf(lcomm*isize)
68C-----------------------------------------------
69C S o u r c e L i n e s
70C-----------------------------------------------
71 loc_proc = ispmd + 1
72C
73 ideb = 1
74 l = 0
75 DO i = 1, nspmd
76 len = iad_m(i+1)-iad_m(i)
77 IF(len>0) THEN
78 siz = len*isize
79 l=l+1
80 indexi(l)=i
81 msgtyp = msgoff
82 CALL mpi_irecv(
83 s rbuf(ideb),siz,real,it_spmd(i),msgtyp,
84 g spmd_comm_world,req_r(l),ierror)
85 ideb = ideb + siz
86 ENDIF
87 ENDDO
88 nbindex = l
89C
90 ideb = 1
91 DO l = 1, nbindex
92 i = indexi(l)
93 len = iad_m(i+1) - iad_m(i)
94 iad = iad_m(i)-1
95 IF (irot==0) THEN
96#include "vectorize.inc"
97 DO j = 1, len
98 nod = fr_m(iad+j)
99 sbuf(ideb) = a(1,nod)
100 sbuf(ideb+1) = a(2,nod)
101 sbuf(ideb+2) = a(3,nod)
102 sbuf(ideb+3) = ms(nod)
103 sbuf(ideb+4) = stifn(nod)
104 ideb = ideb + isize
105 ENDDO
106 ELSE
107#include "vectorize.inc"
108 DO j = 1, len
109 nod = fr_m(iad+j)
110 sbuf(ideb) = a(1,nod)
111 sbuf(ideb+1) = a(2,nod)
112 sbuf(ideb+2) = a(3,nod)
113 sbuf(ideb+3) = ar(1,nod)
114 sbuf(ideb+4) = ar(2,nod)
115 sbuf(ideb+5) = ar(3,nod)
116 sbuf(ideb+6) = ms(nod)
117 sbuf(ideb+7) = in(nod)
118 sbuf(ideb+8) = stifn(nod)
119 sbuf(ideb+9) = stifr(nod)
120 ideb = ideb + isize
121 ENDDO
122 ENDIF
123 ENDDO
124C
125 ideb = 1
126 DO l=1,nbindex
127 i = indexi(l)
128 len = iad_m(i+1)-iad_m(i)
129 siz = len*isize
130 msgtyp = msgoff
131 CALL mpi_isend(
132 s sbuf(ideb),siz,real,it_spmd(i),msgtyp,
133 g spmd_comm_world,req_s(l),ierror)
134 ideb = ideb + siz
135 ENDDO
136C
137 DO l=1,nbindex
138 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
139 i = indexi(index)
140 ideb = 1+(iad_m(i)-1)*isize
141 len = iad_m(i+1)-iad_m(i)
142 iad = iad_m(i)-1
143 IF (irot==0) THEN
144#include "vectorize.inc"
145 DO j = 1, len
146 nod = fr_m(iad+j)
147 a(1,nod) = a(1,nod) + rbuf(ideb)
148 a(2,nod) = a(2,nod) + rbuf(ideb+1)
149 a(3,nod) = a(3,nod) + rbuf(ideb+2)
150 ms(nod) = ms(nod) + rbuf(ideb+3)
151 stifn(nod) = stifn(nod)+rbuf(ideb+4)
152 ideb = ideb + isize
153 ENDDO
154 ELSE
155#include "vectorize.inc"
156 DO j = 1, len
157 nod = fr_m(iad+j)
158 a(1,nod) = a(1,nod) + rbuf(ideb)
159 a(2,nod) = a(2,nod) + rbuf(ideb+1)
160 a(3,nod) = a(3,nod) + rbuf(ideb+2)
161 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
162 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
163 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
164 ms(nod) = ms(nod) + rbuf(ideb+6)
165 in(nod) = in(nod) + rbuf(ideb+7)
166 stifn(nod) = stifn(nod)+rbuf(ideb+8)
167 stifr(nod) = stifr(nod)+rbuf(ideb+9)
168 ideb = ideb + isize
169 END DO
170 END IF
171 ENDDO
172C
173 DO l=1,nbindex
174 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
175 ENDDO
176C
177#endif
178 RETURN
179 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
rbe3t1
subroutine rbe3t1(rbe3, nodes, skew, dmast, adm, dinert, adi, h3d_data, dt1, tt, impl_s)
Definition rbe3f.F:50
rbe3f
subroutine rbe3f(irbe3, lrbe3, x, a, ar, ms, in, frbe3, skew, weight, stifn, stifr, jt, jr, irotg, max_m, am, arm, msm, inm, stifnm, stifrm, nmt0, iadmp, pen, v, vr, nmt, dt1, iroddl)
Definition rbe3f.F:280
spmd_exch_rbe3
subroutine spmd_exch_rbe3(a, ar, ms, in, stifn, stifr, fr_m, iad_m, lcomm, isize, irot)
Definition spmd_exch_rbe3.F:35