OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_create_rbodies_impi.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!|| h3d_create_rbodies_impi ../engine/source/output/h3d/h3d_build_fortran/h3d_create_rbodies_impi.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| c_h3d_create_rbodies_impi ../engine/source/output/h3d/h3d_build_cpp/c_h3d_create_rbodies.cpp
29!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.f
30!||--- uses -----------------------------------------------------
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE h3d_create_rbodies_impi(NPBY,LPBY,FR_RBY2,IAD_RBY2,
34 . SBUFSPM,SBUFRECVM,
35 . SBUFSPO,SPORBY,
36 . NODGLOB,WEIGHT,ITAB,COMPID_RBODIES)
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
286 END
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
h3d_create_rbodies_impi
subroutine h3d_create_rbodies_impi(npby, lpby, fr_rby2, iad_rby2, sbufspm, sbufrecvm, sbufspo, sporby, nodglob, weight, itab, compid_rbodies)
Definition h3d_create_rbodies_impi.F:37
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