OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_mv_ca.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_mv_ca ../engine/source/mpi/airbags/spmd_mv_ca.F
26!||--- called by ------------------------------------------------------
27!|| monvol0 ../engine/source/airbag/monvol0.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
31!||====================================================================
32 SUBROUTINE spmd_mv_ca(
33 1 FR_MV ,IV ,NAV ,RVOLU ,RVOLUV ,
34 2 ICBAG ,NJET ,IVOLUV ,RBAGVJET,IFLAG ,ITYP,NGASES)
35 USE spmd_mod
36C communication pression volume pour airbags communicants
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
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 "com04_c.inc"
50#include "task_c.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IFLAG, IV, NAV, NJET,
56 . FR_MV(NSPMD+2,NVOLU),
57 . icbag(nicbag,*),ivoluv(nimv,*),ityp,ngases
58 my_real
59 . rvolu(*), rvoluv(nrvolu,*),rbagvjet(*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63#ifdef MPI
64 INTEGER LOC_PROC,I,J,II,P,L,SIZ,NB,IJ,RADVOIS,
65 . MSGTYP,MSGOFF,MSGOFF2,IERROR, ICOMRC,
66 . icomsd(nspmd),req_s(nspmd),igas,
67 . status(mpi_status_size)
68 DATA msgoff/114/
69 DATA msgoff2/115/
70 my_real, DIMENSION(:),ALLOCATABLE :: bufs,bufr
71C-----------------------------------------------
72C S o u r c e L i n e s
73C-----------------------------------------------
74
75 loc_proc = ispmd+1
76 siz = 5*nvolu+2*njet*nvolu+1
77 IF(ityp == 9) siz = siz + ngases*2*njet*nvolu
78 ALLOCATE(bufs(siz),bufr(siz))
79
80
81 IF(iflag==1) THEN
82 l = 1
83 nb = 0
84 DO p = 1, nspmd
85 icomsd(p) = 0
86 END DO
87 DO i=1,nav
88 ii = icbag(1,i)
89C si pmain
90 IF(fr_mv(nspmd+2,ii)==loc_proc)THEN
91 nb = nb + 1
92 bufs(l+1)=ii
93 bufs(l+2)=rvoluv(12,ii)
94 bufs(l+3)=rvoluv(16,ii)
95 bufs(l+4)=rvoluv(22,ii)
96 bufs(l+5)=rvoluv(24,ii)
97 l = l + 5
98C
99 radvois= ivoluv(10,ii)
100 DO ij = 1, njet
101 bufs(l+1)=rbagvjet(radvois+nrbjet*(ij-1)+9)
102 bufs(l+2)=rbagvjet(radvois+nrbjet*(ij-1)+10)
103 l = l + 2
104 IF(ityp == 9) THEN
105 DO igas = 1,ngases
106 bufs(l+1)=rbagvjet(radvois+nrbjet*(ij-1)+23+(igas-1)*4)
107 bufs(l+2)=rbagvjet(radvois+nrbjet*(ij-1)+24+(igas-1)*4)
108 l = l + 2
109 ENDDO
110 ENDIF
111 END DO
112C
113 DO p = 1, nspmd
114 IF(fr_mv(p,ii)==0.AND.fr_mv(p,iv)/=0) THEN
115 icomsd(p) = 1
116 END IF
117 END DO
118 END IF
119 END DO
120C
121 IF (nb>0) THEN
122 bufs(1) = nb
123 DO p = 1, nspmd
124 IF(icomsd(p)==1) THEN
125 msgtyp = msgoff
126 CALL mpi_isend(
127 . bufs,l,real,it_spmd(p),msgtyp,
128 . spmd_comm_world,req_s(p),ierror)
129 END IF
130 END DO
131 END IF
132C
133 IF(fr_mv(loc_proc,iv)/=0) THEN
134 DO p = 1, nspmd
135 icomrc = 0
136 DO i=1,nav
137 ii = icbag(1,i)
138C si pmain
139 IF(fr_mv(nspmd+2,ii)==p.AND.
140 + fr_mv(loc_proc,ii)==0)THEN
141 icomrc = 1
142 END IF
143 END DO
144 IF(icomrc==1) THEN
145 siz = 5*nvolu+2*njet*nvolu+1
146 IF(ityp == 9) siz = siz + 2*njet*nvolu*ngases
147 msgtyp = msgoff
148 CALL mpi_recv(bufr ,siz ,real ,it_spmd(p),
149 . msgtyp,spmd_comm_world,status,ierror )
150 nb = bufr(1)
151 l = 1
152 DO i = 1, nb
153 ii = nint(bufr(l+1))
154 rvoluv(12,ii) = bufr(l+2)
155 rvoluv(16,ii) = bufr(l+3)
156 rvoluv(22,ii) = bufr(l+4)
157 rvoluv(24,ii) = bufr(l+5)
158 l = l + 5
159C
160 radvois= ivoluv(10,ii)
161 DO ij = 1, njet
162 rbagvjet(radvois+nrbjet*(ij-1)+9) =bufr(l+1)
163 rbagvjet(radvois+nrbjet*(ij-1)+10)=bufr(l+2)
164 l = l + 2
165 IF(ityp == 9) THEN
166 DO igas = 1,ngases
167 rbagvjet(radvois+nrbjet*(ij-1)+23+(igas-1)*4)=bufr(l+1)
168 rbagvjet(radvois+nrbjet*(ij-1)+24+(igas-1)*4)=bufr(l+2)
169 l = l + 2
170 END DO
171 END IF
172 END DO
173 END DO
174 END IF
175 END DO
176 END IF
177C
178 DO p = 1, nspmd
179 IF(icomsd(p)==1) CALL mpi_wait(req_s(p),status,ierror)
180 END DO
181 ELSE !IFLAG /= 1
182C cas renvoi des pressions du pmain du mv vers les processeurs traitant les mv voisins
183 IF(fr_mv(nspmd+2,iv)==loc_proc)THEN
184C
185 DO p = 1, nspmd
186 icomsd(p) = 0
187 END DO
188C si pmain
189 l = 0
190 DO i=1,nav
191 ii = icbag(1,i)
192 bufs(l+1)=rvoluv(22,ii)
193 bufs(l+2)=rvoluv(24,ii)
194 l = l + 2
195C
196 radvois= ivoluv(10,ii)
197 DO ij = 1, njet
198 bufs(l+1)=rbagvjet(radvois+nrbjet*(ij-1)+9)
199 bufs(l+2)=rbagvjet(radvois+nrbjet*(ij-1)+10)
200 l = l + 2
201 IF(ityp == 9) THEN
202 DO igas = 1,ngases
203 bufs(l+1)=rbagvjet(radvois+nrbjet*(ij-1)+23+(igas-1)*4)
204 bufs(l+2)=rbagvjet(radvois+nrbjet*(ij-1)+24+(igas-1)*4)
205 l = l + 2
206 ENDDO
207 ENDIF
208 END DO
209C
210 DO p = 1, nspmd
211 IF(fr_mv(p,ii)/=0.AND.fr_mv(p,iv)==0) THEN
212 icomsd(p) = 1
213 END IF
214 END DO
215 END DO
216 IF (l>0) THEN
217 DO p = 1, nspmd
218 IF(icomsd(p)==1) THEN
219 msgtyp = msgoff2
220 CALL mpi_isend(
221 . bufs,l,real,it_spmd(p),msgtyp,
222 . spmd_comm_world,req_s(p),ierror)
223 END IF
224 END DO
225 END IF
226C
227 DO p = 1, nspmd
228 IF(icomsd(p)==1) CALL mpi_wait(req_s(p),status,ierror)
229 END DO
230 ELSEIF(fr_mv(loc_proc,iv)==0) THEN
231 icomrc = 0
232 DO i=1,nav
233 ii = icbag(1,i)
234 IF(fr_mv(loc_proc,ii)/=0)THEN
235 icomrc = 1
236 END IF
237 END DO
238 IF(icomrc==1) THEN
239C pmain
240 p = fr_mv(nspmd+2,iv)
241 siz = 2*nav+2*njet*nav
242 IF(ityp == 9) siz = siz +2*njet*nav*ngases
243 msgtyp = msgoff2
244 CALL mpi_recv(bufr ,siz ,real ,it_spmd(p),
245 . msgtyp,spmd_comm_world,status,ierror )
246 l = 0
247 DO i = 1, nav
248 ii = icbag(1,i)
249 rvoluv(22,ii) = bufr(l+1)
250 rvoluv(24,ii) = bufr(l+2)
251 l = l + 2
252C
253 radvois= ivoluv(10,ii)
254 DO ij = 1, njet
255 rbagvjet(radvois+nrbjet*(ij-1)+9) =bufr(l+1)
256 rbagvjet(radvois+nrbjet*(ij-1)+10)=bufr(l+2)
257 l = l + 2
258 IF(ityp == 9) THEN
259 DO igas=1,ngases
260 rbagvjet(radvois+nrbjet*(ij-1)+23+(igas-1)*4)=bufr(l+1)
261 rbagvjet(radvois+nrbjet*(ij-1)+24+(igas-1)*4)=bufr(l+2)
262 l = l + 2
263 ENDDO
264 ENDIF
265 END DO
266 END DO
267 END IF
268 END IF
269 END IF
270C
271 DEALLOCATE(bufr,bufs)
272#endif
273 RETURN
274 END
my_real
#define my_real
Definition cppsort.cpp:32
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
spmd_mv_ca
subroutine spmd_mv_ca(fr_mv, iv, nav, rvolu, rvoluv, icbag, njet, ivoluv, rbagvjet, iflag, ityp, ngases)
Definition spmd_mv_ca.F:35