OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_dparrby.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!|| spmd_dparrby ../engine/source/mpi/anim/spmd_dparrby.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
29!|| write_i_c ../common_source/tools/input_output/write_routines.c
30!||--- uses -----------------------------------------------------
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_dparrby(NPBY,LPBY,FR_RBY2,IAD_RBY2,
34 . SBUFSPM,SBUFRECVM,
35 . SBUFSPO,SPORBY,
36 . NODGLOB,WEIGHT,ITAB)
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(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64#ifdef MPI
65 INTEGER PMAIN,I,J,K,L,S,B,M,P,N,
66 . RECOISDE(NSPMD),
67 . II(2),PTRPO(NSPMD+1),PTRPOO(NSPMD+1)
68C
69 INTEGER BUFSEND(NSPMD+1),BUFRECP(NSPMD+1),
70 . NBNOD,SIZ,LPO,NSN,PTR,NN,NR,
71 . SRBY
72 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFSPM,BUFRECVM,PORBY,BUFSPO
73
74 INTEGER MAINND(NRBYKIN)
75
76C MPI variables
77 INTEGER LOC_PROC
78 INTEGER MSGOFF,MSGOFF2,MSGTYP
79 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,ISD(NSPMD)
80C-----------------------------------------------
81 DATA msgoff/7018/
82 DATA msgoff2/7019/
83C-----------------------------------------------
84 ALLOCATE(bufspm(sbufspm))
85 ALLOCATE(bufrecvm(sbufrecvm+nspmd+1))
86 ALLOCATE(porby(sporby))
87 ALLOCATE(bufspo(sbufspo))
88
89 loc_proc = ispmd + 1
90
91C SEND main NODES TO PROC 0
92 DO j=1,nrbykin
93 pmain = fr_rby2(3,j)
94 IF (loc_proc==abs(pmain))THEN
95 mainnd(j)=nodglob( npby(1,j) )-1
96 ELSE
97 mainnd(j)= 0
98 ENDIF
99 ENDDO
100
101 CALL spmd_glob_isum9(mainnd,nrbykin)
102 DO i=1,sbufrecvm
103 bufrecvm(i)=0
104 ENDDO
105
106 l = 1
107
108 DO i=1,nspmd
109
110 bufsend(i)=l
111 s = 1
112C
113 DO j=1,nrbykin
114
115 pmain = fr_rby2(3,j)
116 nbnod = fr_rby2(1,j)
117
118 IF ( nbnod/=0 .AND.
119 . abs(pmain)==i .AND. loc_proc/=i) THEN
120
121 bufspm(l) = j
122 bufspm(l+1) = nbnod
123 l = l + 2
124 nr = 1
125 DO k=1,npby(2,j)
126 IF (weight(lpby(k+s-1))==1) THEN
127 bufspm(l+nr-1) = nodglob(lpby(k+s-1))-1
128 nr = nr +1
129 ENDIF
130 ENDDO
131 l = l+nbnod
132 ENDIF
133 s = s + npby(2,j)
134 ENDDO
135 ENDDO
136 bufsend(nspmd+1)=l
137
138 DO i=1,nspmd
139
140 IF (iad_rby2(1,i)>0) THEN
141
142 msgtyp = msgoff
143 b = bufsend(i)
144 siz = bufsend(i+1)-bufsend(i)
145 CALL mpi_isend(bufspm(b),siz,mpi_integer,it_spmd(i),msgtyp,
146 . spmd_comm_world,isd(i),ierror)
147
148 ENDIF
149 ENDDO
150 l=1
151 DO i = 1, nspmd
152
153 bufrecp(i)=l
154 IF (iad_rby2(2,i)>0) THEN
155
156 msgtyp = msgoff
157 CALL mpi_probe(it_spmd(i),msgtyp,
158 . spmd_comm_world,status,ierror)
159 CALL mpi_get_count(status,mpi_integer,siz,ierror)
160
161 CALL mpi_recv(bufrecvm(l),siz,mpi_integer,it_spmd(i),msgtyp,
162 . spmd_comm_world,status,ierror)
163
164 l = l + siz
165 bufrecvm(l)=0
166 l=l+1
167 ENDIF
168 ENDDO
169 DO i=1,nspmd
170
171 IF (iad_rby2(1,i)>0) THEN
172 CALL mpi_wait(isd(i),status,ierror)
173 ENDIF
174 ENDDO
175 bufrecp(nspmd+1)=l
176 l = 0
177 k = 1
178 DO i=1,nrbykin
179 pmain = fr_rby2(3,i)
180 IF (abs(pmain)==loc_proc) THEN
181 nbnod = fr_rby2(1,i)
182 nn = l+1
183 l = l+2
184 nr = 1
185 DO j = 1,npby(2,i)
186 IF (pmain<=0) THEN
187 bufspo(l+nr)=nodglob(lpby(k+j-1))-1
188 nr = nr+1
189 ELSE
190 IF (weight(lpby(k+j-1)) ==1) THEN
191 bufspo(l+nr)=nodglob(lpby(k+j-1))-1
192 nr = nr+1
193 ENDIF
194 ENDIF
195 ENDDO
196 l=l+nr-1
197 srby = nr-1
198 IF (pmain>0) THEN
199 DO p=1,nspmd
200
201 IF (iad_rby2(2,p)>0) THEN
202 m = bufrecp(p)
203 IF (bufrecvm(m)==i) THEN
204
205 nbnod=bufrecvm(m+1)
206 bufrecp(p)=bufrecp(p)+2
207 nr = 1
208 DO j=bufrecp(p),bufrecp(p)+nbnod-1
209 bufspo(l+nr)=bufrecvm(j)
210 nr=nr+1
211 ENDDO
212 l = l+nr-1
213 srby = srby + nr-1
214 bufrecp(p)=bufrecp(p)+nbnod
215 ENDIF
216 ENDIF
217 ENDDO
218 ENDIF
219 bufspo(nn)=i
220 bufspo(nn+1)=srby
221 ENDIF
222 k =k+npby(2,i)
223
224 ENDDO
225 IF (ispmd/=0 .and .l>0) THEN
226 msgtyp = msgoff2
227 CALL mpi_send(bufspo,l,mpi_integer,it_spmd(1),msgtyp,
228 . spmd_comm_world,ierror)
229 ENDIF
230
231 IF (ispmd==0) THEN
232 DO i=1,nspmd
233 recoisde(i)=0
234 ENDDO
235 DO i=1,nrbykin
236 recoisde(abs(fr_rby2(3,i)))=1
237 ENDDO
238
239 lpo=1
240 ptrpo(1)=lpo
241 DO i=1,l
242 porby(i)=bufspo(i)
243 ENDDO
244 lpo = lpo+l
245
246 DO i=2,nspmd
247
248 IF (recoisde(i)==1) THEN
249 msgtyp = msgoff2
250 ptrpo(i) = lpo
251 CALL mpi_probe(it_spmd(i),msgtyp,
252 . spmd_comm_world,status,ierror)
253 CALL mpi_get_count(status,mpi_integer,siz,ierror)
254
255 CALL mpi_recv(porby(lpo),siz,mpi_integer,it_spmd(i),
256 . msgtyp, spmd_comm_world,status,ierror)
257 lpo=lpo+siz
258 ELSE
259 ptrpo(i) = lpo
260 ENDIF
261 ENDDO
262 ptrpo(nspmd+1)=lpo
263 ptrpoo=ptrpo
264 DO i=1,nrbykin
265 ii(1)=mainnd(i)
266
267 DO p=1,nspmd
268 ptr = ptrpo(p)
269 IF(ptr<ptrpoo(p+1))THEN
270 IF(porby(ptr)==i)THEN
271 nsn = porby(ptr+1)
272 ptr = ptr+2
273 DO n=1,nsn
274 ii(2)=porby(ptr+n-1)
275 CALL write_i_c(ii,2)
276 ENDDO
277 ptrpo(p)=ptrpo(p) + nsn +2
278 ENDIF
279 ENDIF
280 ENDDO
281 ENDDO
282 ENDIF
283
284 DEALLOCATE(bufspm)
285 DEALLOCATE(bufrecvm)
286 DEALLOCATE(porby)
287 DEALLOCATE(bufspo)
288#endif
289 RETURN
290 END
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_dparrby
subroutine spmd_dparrby(npby, lpby, fr_rby2, iad_rby2, sbufspm, sbufrecvm, sbufspo, sporby, nodglob, weight, itab)
Definition spmd_dparrby.F:37
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645