OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_rm6.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_rm6 ../engine/source/mpi/kinematic_conditions/spmd_exch_a_rm6.F
26!||--- called by ------------------------------------------------------
27!|| rmatforp ../engine/source/materials/mat/mat013/rmatforp.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_exch_a_rm6(
33 1 IAD_RBY,FR_RBY6,ICSIZE,RBF6)
34C realise le cumul des acc et stifness des noeuds main de rigid bodies
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38 USE spmd_comm_world_mod, ONLY : spmd_comm_world
39#include "implicit_f.inc"
40C-----------------------------------------------------------------
41C M e s s a g e P a s s i n g
42C-----------------------------------------------
43#include "spmd.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "com04_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 ICSIZE, IAD_RBY(*),FR_RBY6(*)
54 double precision
55 . rbf6(6,6,nrbym)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59#ifdef MPI
60 INTEGER MSGTYP,LOC_PROC,A_AR,NOD,L,I,J,IAD,IRB,
61 . msgoff,siz,ideb, len,index,nbindex,
62 . indexi(nspmd),req_r(nspmd),req_s(nspmd)
63 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
64 DATA msgoff/167/
65 parameter(a_ar = 36) ! 6*6
66 double precision
67 . rbuf(icsize*a_ar), sbuf(icsize*a_ar)
68C-----------------------------------------------
69C S o u r c e L i n e s
70C-----------------------------------------------
71 loc_proc = ispmd + 1
72 ideb = 1
73 l = 0
74 DO i = 1, nspmd
75 len = iad_rby(i+1)-iad_rby(i)
76 IF(len>0) THEN
77 siz = len*a_ar
78 l=l+1
79 indexi(l)=i
80 msgtyp = msgoff
81 CALL mpi_irecv(
82 s rbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
83 g spmd_comm_world,req_r(l),ierror)
84 ideb = ideb + siz
85 ENDIF
86 ENDDO
87 nbindex = l
88C
89 ideb = 1
90 DO l = 1, nbindex
91 i = indexi(l)
92 len = iad_rby(i+1)-iad_rby(i)
93 iad = iad_rby(i)-1
94#include "vectorize.inc"
95 DO j = 1, len
96 irb = fr_rby6(iad+j)
97 sbuf(ideb) = rbf6(1,1,irb)
98 sbuf(ideb+1) = rbf6(1,2,irb)
99 sbuf(ideb+2) = rbf6(1,3,irb)
100 sbuf(ideb+3) = rbf6(1,4,irb)
101 sbuf(ideb+4) = rbf6(1,5,irb)
102 sbuf(ideb+5) = rbf6(1,6,irb)
103 sbuf(ideb+6) = rbf6(2,1,irb)
104 sbuf(ideb+7) = rbf6(2,2,irb)
105 sbuf(ideb+8) = rbf6(2,3,irb)
106 sbuf(ideb+9) = rbf6(2,4,irb)
107 sbuf(ideb+10)= rbf6(2,5,irb)
108 sbuf(ideb+11)= rbf6(2,6,irb)
109 sbuf(ideb+12)= rbf6(3,1,irb)
110 sbuf(ideb+13)= rbf6(3,2,irb)
111 sbuf(ideb+14)= rbf6(3,3,irb)
112 sbuf(ideb+15)= rbf6(3,4,irb)
113 sbuf(ideb+16)= rbf6(3,5,irb)
114 sbuf(ideb+17)= rbf6(3,6,irb)
115 sbuf(ideb+18)= rbf6(4,1,irb)
116 sbuf(ideb+19)= rbf6(4,2,irb)
117 sbuf(ideb+20)= rbf6(4,3,irb)
118 sbuf(ideb+21)= rbf6(4,4,irb)
119 sbuf(ideb+22)= rbf6(4,5,irb)
120 sbuf(ideb+23)= rbf6(4,6,irb)
121 sbuf(ideb+24)= rbf6(5,1,irb)
122 sbuf(ideb+25)= rbf6(5,2,irb)
123 sbuf(ideb+26)= rbf6(5,3,irb)
124 sbuf(ideb+27)= rbf6(5,4,irb)
125 sbuf(ideb+28)= rbf6(5,5,irb)
126 sbuf(ideb+29)= rbf6(5,6,irb)
127 sbuf(ideb+30)= rbf6(6,1,irb)
128 sbuf(ideb+31)= rbf6(6,2,irb)
129 sbuf(ideb+32)= rbf6(6,3,irb)
130 sbuf(ideb+33)= rbf6(6,4,irb)
131 sbuf(ideb+34)= rbf6(6,5,irb)
132 sbuf(ideb+35)= rbf6(6,6,irb)
133 ideb = ideb + a_ar
134 ENDDO
135 ENDDO
136C
137 ideb = 1
138 DO l=1,nbindex
139 i = indexi(l)
140 len = iad_rby(i+1)-iad_rby(i)
141 siz = len*a_ar
142 msgtyp = msgoff
143 CALL mpi_isend(
144 s sbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
145 g spmd_comm_world,req_s(l),ierror)
146 ideb = ideb + siz
147 ENDDO
148C
149 DO l=1,nbindex
150 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
151 i = indexi(index)
152 ideb = 1+(iad_rby(i)-1)*a_ar
153 len = iad_rby(i+1)-iad_rby(i)
154 iad = iad_rby(i)-1
155#include "vectorize.inc"
156 DO j = 1, len
157 irb = fr_rby6(iad+j)
158 rbf6(1,1,irb)= rbf6(1,1,irb) + rbuf(ideb)
159 rbf6(1,2,irb)= rbf6(1,2,irb) + rbuf(ideb+1)
160 rbf6(1,3,irb)= rbf6(1,3,irb) + rbuf(ideb+2)
161 rbf6(1,4,irb)= rbf6(1,4,irb) + rbuf(ideb+3)
162 rbf6(1,5,irb)= rbf6(1,5,irb) + rbuf(ideb+4)
163 rbf6(1,6,irb)= rbf6(1,6,irb) + rbuf(ideb+5)
164 rbf6(2,1,irb)= rbf6(2,1,irb) + rbuf(ideb+6)
165 rbf6(2,2,irb)= rbf6(2,2,irb) + rbuf(ideb+7)
166 rbf6(2,3,irb)= rbf6(2,3,irb) + rbuf(ideb+8)
167 rbf6(2,4,irb)= rbf6(2,4,irb) + rbuf(ideb+9)
168 rbf6(2,5,irb)= rbf6(2,5,irb) + rbuf(ideb+10)
169 rbf6(2,6,irb)= rbf6(2,6,irb) + rbuf(ideb+11)
170 rbf6(3,1,irb)= rbf6(3,1,irb) + rbuf(ideb+12)
171 rbf6(3,2,irb)= rbf6(3,2,irb) + rbuf(ideb+13)
172 rbf6(3,3,irb)= rbf6(3,3,irb) + rbuf(ideb+14)
173 rbf6(3,4,irb)= rbf6(3,4,irb) + rbuf(ideb+15)
174 rbf6(3,5,irb)= rbf6(3,5,irb) + rbuf(ideb+16)
175 rbf6(3,6,irb)= rbf6(3,6,irb) + rbuf(ideb+17)
176 rbf6(4,1,irb)= rbf6(4,1,irb) + rbuf(ideb+18)
177 rbf6(4,2,irb)= rbf6(4,2,irb) + rbuf(ideb+19)
178 rbf6(4,3,irb)= rbf6(4,3,irb) + rbuf(ideb+20)
179 rbf6(4,4,irb)= rbf6(4,4,irb) + rbuf(ideb+21)
180 rbf6(4,5,irb)= rbf6(4,5,irb) + rbuf(ideb+22)
181 rbf6(4,6,irb)= rbf6(4,6,irb) + rbuf(ideb+23)
182 rbf6(5,1,irb)= rbf6(5,1,irb) + rbuf(ideb+24)
183 rbf6(5,2,irb)= rbf6(5,2,irb) + rbuf(ideb+25)
184 rbf6(5,3,irb)= rbf6(5,3,irb) + rbuf(ideb+26)
185 rbf6(5,4,irb)= rbf6(5,4,irb) + rbuf(ideb+27)
186 rbf6(5,5,irb)= rbf6(5,5,irb) + rbuf(ideb+28)
187 rbf6(5,6,irb)= rbf6(5,6,irb) + rbuf(ideb+29)
188 rbf6(6,1,irb)= rbf6(6,1,irb) + rbuf(ideb+30)
189 rbf6(6,2,irb)= rbf6(6,2,irb) + rbuf(ideb+31)
190 rbf6(6,3,irb)= rbf6(6,3,irb) + rbuf(ideb+32)
191 rbf6(6,4,irb)= rbf6(6,4,irb) + rbuf(ideb+33)
192 rbf6(6,5,irb)= rbf6(6,5,irb) + rbuf(ideb+34)
193 rbf6(6,6,irb)= rbf6(6,6,irb) + rbuf(ideb+35)
194 ideb = ideb + a_ar
195 ENDDO
196 ENDDO
197C
198 DO l=1,nbindex
199 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
200 ENDDO
201C
202#endif
203 RETURN
204 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
spmd_exch_a_rm6
subroutine spmd_exch_a_rm6(iad_rby, fr_rby6, icsize, rbf6)
Definition spmd_exch_a_rm6.F:34