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_routtines.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,JENVOIE,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,NOD,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,INFO,ATID,ATAG,ALEN
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
genani
subroutine genani(x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, igrsurf, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connectivity, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, h3d_data, subset, multi_fvm, knotlocpc, knotlocel, fcont_max, fncontp2, ftcontp2, glob_therm, drape_sh4n, drape_sh3n, drapeg, output)
Definition genani.F:239
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:523
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645