OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_create_rbodies_impi.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 h3d_create_rbodies_impi (npby, lpby, fr_rby2, iad_rby2, sbufspm, sbufrecvm, sbufspo, sporby, nodglob, weight, itab, compid_rbodies)

Function/Subroutine Documentation

◆ h3d_create_rbodies_impi()

subroutine h3d_create_rbodies_impi ( integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(3,*) fr_rby2,
integer, dimension(4,*) iad_rby2,
integer sbufspm,
integer sbufrecvm,
integer sbufspo,
integer sporby,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer, dimension(*) itab,
integer compid_rbodies )

Definition at line 33 of file h3d_create_rbodies_impi.F.

37
38
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42 USE spmd_comm_world_mod, ONLY : spmd_comm_world
43#include "implicit_f.inc"
44C-----------------------------------------------------------------
45C M e s s a g e P a s s i n g
46C-----------------------------------------------
47#include "spmd.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "task_c.inc"
54#include "param_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NPBY(NNPBY,*),LPBY(*),FR_RBY2(3,*),IAD_RBY2(4,*)
59 INTEGER SBUFSPM,SBUFRECVM,SBUFSPO,NODGLOB(*),SPORBY,WEIGHT(*),
60 . ITAB(*),COMPID_RBODIES
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64#ifdef MPI
65 INTEGER PMAIN,JENVOIE,I,J,K,L,S,B,M,P,N,
66 . RECOISDE(NSPMD),
67 . PORBY(SPORBY),II(2),PTRPO(NSPMD+1),PTRPOO(NSPMD+1)
68C
69 INTEGER BUFSPM(SBUFSPM),BUFRECVM(SBUFRECVM+NSPMD+1),
70 . BUFSEND(NSPMD+1),BUFRECP(NSPMD+1),
71
72 . BUFSPO(SBUFSPO),NBNOD,SIZ,LPO,NSN,PTR,NOD,NN,NR,
73 . SRBY
74 INTEGER MAINND(NRBYKIN)
75 INTEGER ID_RBY(NRBYKIN)
76
77C MPI variables
78 INTEGER LOC_PROC
79 INTEGER MSGOFF,MSGOFF2,MSGTYP,INFO,ATID,ATAG,ALEN
80 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,ISD(NSPMD)
81
82 DATA msgoff/7018/
83 DATA msgoff2/7019/
84
85 loc_proc = ispmd + 1
86
87C SEND main NODES TO PROC 0
88 DO j=1,nrbykin
89 pmain = fr_rby2(3,j)
90 IF (loc_proc==abs(pmain))THEN
91 mainnd(j)=itab( npby(1,j) )-1
92 ELSE
93 mainnd(j)= 0
94 ENDIF
95 id_rby(j)= npby(6,j)
96 ENDDO
97
98 CALL spmd_glob_isum9(mainnd,nrbykin)
99 DO i=1,sbufrecvm
100 bufrecvm(i)=0
101 ENDDO
102C Fill send buffer: second -> main
103
104 l = 1
105
106 DO i=1,nspmd
107
108 bufsend(i)=l
109 s = 1
110C
111 DO j=1,nrbykin
112
113 pmain = fr_rby2(3,j)
114 nbnod = fr_rby2(1,j)
115
116 IF ( nbnod/=0 .AND.
117 . abs(pmain)==i .AND. loc_proc/=i) THEN
118
119 bufspm(l) = j
120 bufspm(l+1) = nbnod
121 l = l + 2
122 nr = 1
123 DO k=1,npby(2,j)
124 IF (weight(lpby(k+s-1))==1) THEN
125 bufspm(l+nr-1) = itab(lpby(k+s-1))-1
126 nr = nr +1
127 ENDIF
128 ENDDO
129 l = l+nbnod
130 ENDIF
131 s = s + npby(2,j)
132 ENDDO
133 ENDDO
134 bufsend(nspmd+1)=l
135
136C Send buffer
137 DO i=1,nspmd
138
139 IF (iad_rby2(1,i)>0) THEN
140
141 msgtyp = msgoff
142 b = bufsend(i)
143 siz = bufsend(i+1)-bufsend(i)
144 CALL mpi_isend(bufspm(b),siz,mpi_integer,it_spmd(i),msgtyp,
145 . spmd_comm_world,isd(i),ierror)
146
147 ENDIF
148 ENDDO
149
150C Processor that owns main node: receive secondary nodes
151 l=1
152 DO i = 1, nspmd
153
154 bufrecp(i)=l
155 IF (iad_rby2(2,i)>0) THEN
156
157 msgtyp = msgoff
158 CALL mpi_probe(it_spmd(i),msgtyp,
159 . spmd_comm_world,status,ierror)
160 CALL mpi_get_count(status,mpi_integer,siz,ierror)
161
162 CALL mpi_recv(bufrecvm(l),siz,mpi_integer,it_spmd(i),msgtyp,
163 . spmd_comm_world,status,ierror)
164
165 l = l + siz
166 bufrecvm(l)=0
167 l=l+1
168 ENDIF
169 ENDDO
170 DO i=1,nspmd
171
172 IF (iad_rby2(1,i)>0) THEN
173 CALL mpi_wait(isd(i),status,ierror)
174 ENDIF
175 ENDDO
176 bufrecp(nspmd+1)=l
177C Packing
178 l = 0
179 k = 1
180
181 DO i=1,nrbykin
182 pmain = fr_rby2(3,i)
183
184 IF (abs(pmain)==loc_proc) THEN
185
186 nbnod = fr_rby2(1,i)
187 nn = l+1
188 l = l+2
189 nr = 1
190
191 DO j = 1,npby(2,i)
192 IF (pmain<=0) THEN
193 bufspo(l+nr)=itab(lpby(k+j-1))-1
194 nr = nr+1
195 ELSE
196 IF (weight(lpby(k+j-1)) ==1) THEN
197 bufspo(l+nr)=itab(lpby(k+j-1))-1
198 nr = nr+1
199 ENDIF
200 ENDIF
201 ENDDO
202
203 l=l+nr-1
204
205 srby = nr-1
206
207 IF (pmain>0) THEN
208 DO p=1,nspmd
209
210 IF (iad_rby2(2,p)>0) THEN
211 m = bufrecp(p)
212 IF (bufrecvm(m)==i) THEN
213
214 nbnod=bufrecvm(m+1)
215 bufrecp(p)=bufrecp(p)+2
216 nr = 1
217 DO j=bufrecp(p),bufrecp(p)+nbnod-1
218 bufspo(l+nr)=bufrecvm(j)
219 nr=nr+1
220 ENDDO
221 l = l+nr-1
222 srby = srby + nr-1
223 bufrecp(p)=bufrecp(p)+nbnod
224 ENDIF
225 ENDIF
226 ENDDO
227 ENDIF
228 bufspo(nn)=i
229 bufspo(nn+1)=srby
230 ENDIF
231 k =k+npby(2,i)
232
233 ENDDO
234 IF (ispmd/=0 .and .l>0) THEN
235
236 msgtyp = msgoff2
237 CALL mpi_send(bufspo,l,mpi_integer,it_spmd(1),msgtyp,
238 . spmd_comm_world,ierror)
239 ENDIF
240
241
242C Receive from processors that have one main node of RB
243 IF (ispmd==0) THEN
244 DO i=1,nspmd
245 recoisde(i)=0
246 ENDDO
247 DO i=1,nrbykin
248 recoisde(abs(fr_rby2(3,i)))=1
249 ENDDO
250
251 lpo=1
252 ptrpo(1)=lpo
253 DO i=1,l
254 porby(i)=bufspo(i)
255 ENDDO
256 lpo = lpo+l
257
258 DO i=2,nspmd
259
260 IF (recoisde(i)==1) THEN
261 msgtyp = msgoff2
262 ptrpo(i) = lpo
263 CALL mpi_probe(it_spmd(i),msgtyp,
264 . spmd_comm_world,status,ierror)
265 CALL mpi_get_count(status,mpi_integer,siz,ierror)
266
267 CALL mpi_recv(porby(lpo),siz,mpi_integer,it_spmd(i),
268 . msgtyp, spmd_comm_world,status,ierror)
269 lpo=lpo+siz
270 ELSE
271 ptrpo(i) = lpo
272 ENDIF
273 ENDDO
274 ptrpo(nspmd+1)=lpo
275
276 ptrpoo=ptrpo
277 CALL c_h3d_create_rbodies_impi(itab,nrbykin,mainnd,id_rby,ptrpo,ptrpoo,porby,nspmd,
278 . compid_rbodies)
279
280
281
282
283 ENDIF
284#endif
285 RETURN
c_h3d_create_rbodies_impi
void c_h3d_create_rbodies_impi(int *ITAB, int *NRBYKIN, int *MASTERND, int *ID_RBY, int *PTRPO, int *PTRPOO, int *PORBY, int *NSPMD, int *COMPID_RBODIES)
Definition c_h3d_create_rbodies.cpp:395
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
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
mpi_probe
subroutine mpi_probe(source, tag, comm, status, ierr)
Definition mpi.f:449
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523