OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_mv_ca.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_mv_ca (fr_mv, iv, nav, rvolu, rvoluv, icbag, njet, ivoluv, rbagvjet, iflag, ityp, ngases)

Function/Subroutine Documentation

◆ spmd_mv_ca()

subroutine spmd_mv_ca ( integer, dimension(nspmd+2,nvolu) fr_mv,
integer iv,
integer nav,
rvolu,
rvoluv,
integer, dimension(nicbag,*) icbag,
integer njet,
integer, dimension(nimv,*) ivoluv,
rbagvjet,
integer iflag,
integer ityp,
integer ngases )

Definition at line 32 of file spmd_mv_ca.F.

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
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