OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_dparrbe2.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!||====================================================================
25!|| spmd_dparrbe2 ../engine/source/mpi/anim/spmd_dparrbe2.F
26!||--- called by ------------------------------------------------------
27!|| genani ../engine/source/output/anim/generate/genani.F
28!||--- calls -----------------------------------------------------
29!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
30!|| write_i_c ../common_source/tools/input_output/write_routtines.c
31!||--- uses -----------------------------------------------------
32!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
33!||====================================================================
34 SUBROUTINE spmd_dparrbe2(LRBE2, IRBE2,NODGLOB,WEIGHT,NERBE2Y,
35 * NERBE2T )
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39 USE spmd_comm_world_mod, ONLY : spmd_comm_world
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"
52#include "spmd_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IRBE2(NRBE2L,*),LRBE2(*),NODGLOB(*),WEIGHT(*),
57 * nerbe2y,nerbe2t(nrbe2g)
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61#ifdef MPI
62 INTEGER I,N,P
63 INTEGER SNRBE2,SIZRBE2,SBUFSIZ,PSNRBE2
64 INTEGER NSN,IADG,IAD,SN,MN,NGRBE
65
66 INTEGER, DIMENSION(:),ALLOCATABLE :: SZLOCRBE2,PGLOBRBE2,MAINNODS
67 INTEGER, DIMENSION(:),ALLOCATABLE :: SENDBUF,RECBUF,
68 * p0rbe2buf,iadrbe2
69 INTEGER, DIMENSION(:,:),ALLOCATABLE :: P0RECRBE2, IIN
70
71C MPI variables
72 INTEGER LOC_PROC
73 INTEGER MSGOFF,MSGOFF2,MSGTYP,INFO,ATID,ATAG,ALEN
74 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,ISD(NSPMD)
75
76 DATA msgoff/7020/
77 DATA msgoff2/7021/
78C-----------------------------------------------
79 ALLOCATE(szlocrbe2(nrbe2g))
80 ALLOCATE(pglobrbe2(nrbe2g))
81 ALLOCATE(mainnods(nrbe2g))
82C-----------------------------------------------
83C 1ere etape - envoyer au proc 0 un tableau avec nombre
84C noeuds secnds locaux par RBE2 a envoyer
85C et preparation du buffer d envoi
86C (taille)
87 nerbe2t = 0
88 snrbe2 = 0
89 sbufsiz = 0
90 szlocrbe2=0
91 pglobrbe2 = 0
92
93 DO i=1,nrbe2
94 ngrbe = irbe2(10,i)
95 szlocrbe2(ngrbe) = 0
96 nsn = irbe2(5,i)
97 DO n=1,nsn
98 IF (weight(lrbe2(irbe2(1,i)+n))==1)
99 . szlocrbe2(ngrbe) = szlocrbe2(ngrbe) + 1
100 ENDDO
101 sbufsiz = sbufsiz + szlocrbe2(ngrbe)
102
103 ENDDO
104
105C Envoi vers le proc 0 du tableau des tailles
106
107 IF (ispmd == 0) THEN
108C Proc zero reception des tailles
109 ALLOCATE(p0recrbe2(nrbe2g,nspmd))
110 DO i=1,nrbe2g
111 p0recrbe2(i,1) = szlocrbe2(i)
112 ENDDO
113
114 DO p=2,nspmd
115 msgtyp = msgoff
116 CALL mpi_recv(p0recrbe2(1,p),nrbe2g,mpi_integer,it_spmd(p),
117 * msgtyp,spmd_comm_world,status,ierror)
118 ENDDO
119
120 ELSE
121C Procs autres envoi
122 msgtyp = msgoff
123 CALL mpi_send(szlocrbe2,nrbe2g,mpi_integer,it_spmd(1),
124 . msgtyp,spmd_comm_world,ierror)
125
126 ENDIF
127
128C --------------------------------------------------------------
129C Envoi vers le proc 0 des noeuds des RBE2 & criture sur disque
130C --------------------------------------------------------------
131 IF (ispmd /= 0) THEN
132C ------------------------
133C Procs autres que proc 0
134C ------------------------
135 ALLOCATE(sendbuf(sbufsiz))
136 snrbe2 = 0
137 DO i=1,nrbe2
138 nsn = irbe2(5,i)
139 iad = irbe2(1,i)
140 DO n=1,nsn
141 sn = lrbe2(iad+n)
142 IF (weight(sn) == 1 )THEN
143 snrbe2 = snrbe2+1
144 sendbuf(snrbe2)=nodglob(sn)
145 ENDIF
146 ENDDO
147 ENDDO
148 IF (snrbe2 > 0)THEN
149 msgtyp = msgoff2
150 CALL mpi_send(sendbuf,snrbe2,mpi_integer,it_spmd(1),msgtyp,
151 * spmd_comm_world,ierror)
152 ENDIF
153 DEALLOCATE(sendbuf)
154
155C Envoi des noeuds secnds
156 mainnods = 0
157 DO i=1,nrbe2
158 mn = irbe2(3,i)
159 IF(mn/=0)THEN
160 IF (weight(mn)==1)THEN
161 ngrbe = irbe2(10,i)
162 mainnods(ngrbe)=nodglob(mn)
163 ENDIF
164 ENDIF
165 ENDDO
166 CALL spmd_glob_isum9(mainnods,nrbe2g)
167
168
169 ELSE
170C --------------------------------------------------------------------
171C PROC 0
172C --------------------------------------------------------------------
173C P0RBE2BUF tableau de reception (tableau de reception = LRBE2 Global)
174C IADRBE2 pointeurs vers P0RBE2BUF global
175 ALLOCATE(iadrbe2(nrbe2g+1))
176 ALLOCATE(p0rbe2buf(nerbe2y))
177
178C preparation IADRBE2
179 iadrbe2(1)=0
180 DO i=1,nrbe2g
181 snrbe2 = p0recrbe2(i,1)
182 DO n=2,nspmd
183 snrbe2 = snrbe2 + p0recrbe2(i,n)
184 ENDDO
185 iadrbe2(i+1)=iadrbe2(i)+snrbe2
186 ENDDO
187
188C preparation P0RECRBE2 pour le proc0
189 DO i=1,nrbe2g
190 pglobrbe2(i)=iadrbe2(i)
191 ENDDO
192
193 DO i=1,nrbe2
194 nsn = irbe2(5,i)
195 iad = irbe2(1,i)
196 ngrbe = irbe2(10,i)
197 iadg = iadrbe2(ngrbe)
198 snrbe2 = 0
199 DO n=1,nsn
200 sn = lrbe2( iad+n )
201 IF (weight(sn) == 1 )THEN
202 snrbe2 = snrbe2+1
203 p0rbe2buf(iadg + snrbe2) = nodglob(sn)
204 ENDIF
205 ENDDO
206 pglobrbe2(ngrbe)=pglobrbe2(ngrbe) + snrbe2
207 ENDDO
208
209C Reception des RBE2 des autres procs
210 DO p=2,nspmd
211C Taille du buffer de reception
212 sizrbe2 = 0
213 DO i=1,nrbe2g
214 sizrbe2 = sizrbe2 + p0recrbe2(i,p)
215 ENDDO
216
217 IF (sizrbe2 > 0) THEN
218 ALLOCATE(recbuf(sizrbe2))
219 msgtyp = msgoff2
220 CALL mpi_recv(recbuf,sizrbe2,mpi_integer,it_spmd(p),msgtyp,
221 * spmd_comm_world,status,ierror)
222
223 psnrbe2=0
224 DO i=1,nrbe2g
225 iadg = pglobrbe2(i)
226 DO n=1,p0recrbe2(i,p)
227 psnrbe2 = psnrbe2 + 1
228 p0rbe2buf(iadg + n) = recbuf(psnrbe2)
229 ENDDO
230 pglobrbe2(i) = pglobrbe2(i) + p0recrbe2(i,p)
231 ENDDO
232 DEALLOCATE(recbuf)
233 ENDIF
234 ENDDO
235C Reception des Noeuds mains
236 mainnods=0
237 DO i=1,nrbe2
238 mn = irbe2(3,i)
239 IF (weight(mn)==1) THEN
240 ngrbe = irbe2(10,i)
241 mainnods(ngrbe)=nodglob(mn)
242 ENDIF
243 ENDDO
244 CALL spmd_glob_isum9(mainnods,nrbe2g)
245
246C Ecriture sur disque
247 DO i=1,nrbe2g
248 nsn = iadrbe2(i+1) - iadrbe2(i)
249 iadg =iadrbe2(i)
250 mn = mainnods(i)
251 ALLOCATE(iin(2,nsn))
252 nerbe2t(i)=nsn
253 DO n=1,nsn
254 iin(1,n)=mn-1
255 iin(2,n)=p0rbe2buf(iadg + n)-1
256 ENDDO
257 CALL write_i_c(iin,2*nsn)
258 DEALLOCATE(iin)
259 ENDDO
260 DEALLOCATE(iadrbe2)
261 DEALLOCATE(p0rbe2buf)
262 DEALLOCATE(p0recrbe2)
263 ENDIF
264
265
266 DEALLOCATE(szlocrbe2)
267 DEALLOCATE(pglobrbe2)
268 DEALLOCATE(mainnods)
269
270#endif
271 RETURN
272 END
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
spmd_dparrbe2
subroutine spmd_dparrbe2(lrbe2, irbe2, nodglob, weight, nerbe2y, nerbe2t)
Definition spmd_dparrbe2.F:36
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