OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_failwave.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_failwave_boundaries ../engine/source/mpi/output/spmd_exch_failwave.F
25!||--- called by ------------------------------------------------------
26!|| resol_init ../engine/source/engine/resol_init.F
27!||--- uses -----------------------------------------------------
28!|| failwave_mod ../common_source/modules/failwave_mod.F
29!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
30!||====================================================================
31 SUBROUTINE spmd_failwave_boundaries(FAILWAVE,IAD_ELEM,FR_ELEM)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE failwave_mod
36C USE DEBUG_MOD
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40 USE spmd_comm_world_mod, ONLY : spmd_comm_world
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER IAD_ELEM(2,*), FR_ELEM(*)
50 TYPE (failwave_str_) ,TARGET :: failwave
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER, DIMENSION(:), ALLOCATABLE :: COUNT
55 INTEGER P,J,TOTAL_NODES,NCOUNT,NOD
56C-----------------------------------------------
57
58 IF (ALLOCATED( failwave%FWAVE_IAD)) DEALLOCATE (failwave%FWAVE_IAD)
59 IF (ALLOCATED( failwave%FWAVE_FR )) DEALLOCATE (failwave%FWAVE_FR)
60
61C count the #boundaries failwave nodes
62 ALLOCATE(count(nspmd))
63 count(1:nspmd)=0
64 total_nodes=0
65 DO p=1,nspmd
66 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
67 nod = fr_elem(j)
68 IF (failwave%IDXI(nod) > 0)THEN
69 count(p)=count(p)+1
70 ENDIF
71 ENDDO
72 total_nodes = total_nodes + count(p)
73 ENDDO
74
75 ALLOCATE(failwave%FWAVE_IAD(nspmd+1))
76 ALLOCATE(failwave%FWAVE_FR(total_nodes))
77 failwave%FWAVE_IAD(1)=1
78 DO p=2,nspmd+1
79 failwave%FWAVE_IAD(p)=failwave%FWAVE_IAD(p-1)+count(p-1)
80 ENDDO
81
82 ncount=0
83 DO p=1,nspmd
84 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
85 nod = fr_elem(j)
86 IF (failwave%IDXI(nod) > 0)THEN
87 ncount = ncount+1
88 failwave%FWAVE_FR(ncount)=failwave%IDXI(nod)
89 ENDIF
90 ENDDO
91 ENDDO
92
93
94 DEALLOCATE(count)
95 END
96
97
98!||====================================================================
99!|| spmd_exch_failwave ../engine/source/mpi/output/spmd_exch_failwave.F
100!||--- called by ------------------------------------------------------
101!|| update_failwave ../engine/source/materials/fail/failwave/update_failwave.F
102!||--- calls -----------------------------------------------------
103!||--- uses -----------------------------------------------------
104!|| failwave_mod ../common_source/modules/failwave_mod.F
105!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
106!||====================================================================
107 SUBROUTINE spmd_exch_failwave(FAILWAVE)
108C-----------------------------------------------
109C M o d u l e s
110C-----------------------------------------------
111 USE failwave_mod
112C USE DEBUG_MOD
113C-----------------------------------------------
114C I m p l i c i t T y p e s
115C-----------------------------------------------
116 USE spmd_comm_world_mod, ONLY : spmd_comm_world
117#include "implicit_f.inc"
118C-----------------------------------------------------------------
119C M e s s a g e P a s s i n g
120C-----------------------------------------------
121#include "spmd.inc"
122C-----------------------------------------------
123C C o m m o n B l o c k s
124C-----------------------------------------------
125#include "com01_c.inc"
126#include "task_c.inc"
127C-----------------------------------------------
128C D u m m y A r g u m e n t s
129C-----------------------------------------------
130 TYPE (FAILWAVE_STR_) ,TARGET :: FAILWAVE
131C-----------------------------------------------
132C L o c a l V a r i a b l e s
133C-----------------------------------------------
134#ifdef MPI
135 INTEGER I,J,K,L,M,ND
136 INTEGER NDDIM
137
138C MPI VARIABLES
139
140 INTEGER MSGTYP,NOD,LOC_PROC, SIZ,NB_NOD,NB,MAXLEV,VALUE
141
142 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
143
144 INTEGER MSGOFF1,MSGOFF2
145 INTEGER IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1)
146 INTEGER SEND_SIZ(NSPMD),RECV_SIZ(NSPMD)
147 INTEGER SIZ_SEND,SIZ_RECV
148
149 INTEGER REQ_S1(NSPMD), REQ_S2(NSPMD)
150 INTEGER REQ_R1(NSPMD), REQ_R2(NSPMD)
151
152 INTEGER, DIMENSION(:), ALLOCATABLE :: SBUFI,RBUFI
153 INTEGER, DIMENSION(:), ALLOCATABLE :: SEND_BUF,RECV_BUF
154
155
156 DATA msgoff1/1280/
157 DATA msgoff2/1281/
158C=======================================================================
159 nddim=failwave%NDDL
160 loc_proc = ispmd + 1
161
162C--------------------------------------------------------------------
163C 1. SEND MAXLEV (Stacked information to the others)
164C--------------------------------------------------------------------
165 siz = failwave%FWAVE_IAD(nspmd+1)-failwave%FWAVE_IAD(1)
166 ALLOCATE(rbufi(siz))
167 ALLOCATE(sbufi(siz))
168
169c--------------------------------------------------------------------
170c MPI receive
171c--------------------------------------------------------------------
172 l = 1
173 iad_recv(1) = 1
174 DO i=1,nspmd
175 siz = failwave%FWAVE_IAD(i+1)-failwave%FWAVE_IAD(i)
176 IF (siz > 0)THEN
177 msgtyp = msgoff1
178 CALL mpi_irecv(
179 s rbufi(l),siz,mpi_integer,it_spmd(i),msgtyp,
180 g spmd_comm_world,req_r1(i),ierror)
181 l = l + siz
182 ENDIF
183 iad_recv(i+1) = l
184 END DO
185c--------------------------------------------------------------------
186c Send buffer & Compute size for next communication
187c--------------------------------------------------------------------
188 send_siz(1:nspmd)=0
189
190 l = 1
191 iad_send(1) = 1
192 recv_siz(1:nspmd)=0
193 DO i=1,nspmd
194 DO j=failwave%FWAVE_IAD(i),failwave%FWAVE_IAD(i+1)-1
195 nod = failwave%FWAVE_FR(j)
196 sbufi(l) = failwave%MAXLEV(nod)
197 send_siz(i) = send_siz(i)+failwave%MAXLEV(nod)*nddim
198 l = l + 1
199 END DO
200 iad_send(i+1) = l
201 ENDDO
202c--------------------------------------------------------------------
203c MPI send
204c--------------------------------------------------------------------
205 DO i=1,nspmd
206 IF(failwave%FWAVE_IAD(i+1)-failwave%FWAVE_IAD(i)>0)THEN
207 msgtyp = msgoff1
208 siz = iad_send(i+1)-iad_send(i)
209 l = iad_send(i)
210 CALL mpi_isend(
211 s sbufi(l),siz,mpi_integer,it_spmd(i),msgtyp,
212 g spmd_comm_world,req_s1(i),ierror)
213 ENDIF
214 ENDDO
215c--------------------------------------------------------------------
216c Receive buffer & compute receive_size
217c-------------------------------------------------------------------
218 recv_siz(1:nspmd)=0
219
220 DO i = 1, nspmd
221 nb_nod = failwave%FWAVE_IAD(i+1)-failwave%FWAVE_IAD(i)
222
223 IF (nb_nod > 0)THEN
224 CALL mpi_wait(req_r1(i),status,ierror)
225 l = iad_recv(i)
226
227 DO j=failwave%FWAVE_IAD(i),failwave%FWAVE_IAD(i+1)-1
228 recv_siz(i) = recv_siz(i) + rbufi(l)*nddim
229 l = l + 1
230 END DO
231 ENDIF
232 END DO
233
234
235c--------------------------------------------------------------------
236c Terminate first send
237c-------------------------------------------------------------------
238 DO i = 1, nspmd
239 IF (failwave%FWAVE_IAD(i+1)-failwave%FWAVE_IAD(i) > 0)THEN
240 CALL mpi_wait(req_s1(i),status,ierror)
241 ENDIF
242 ENDDO
243
244
245C---------------------------------------------------------------
246C Prepare & send Stacked information
247C ---------------------------------------------------------------
248 iad_send(1)=1
249 iad_recv(1)=1
250
251 DO i=1,nspmd
252 iad_send(i+1)=iad_send(i)+send_siz(i)
253 iad_recv(i+1)=iad_recv(i)+recv_siz(i)
254 ENDDO
255
256 siz_send = (iad_send(nspmd+1)-iad_send(1))
257 siz_recv = (iad_recv(nspmd+1)-iad_recv(1))
258
259 ALLOCATE(send_buf(siz_send))
260 ALLOCATE(recv_buf(siz_recv))
261
262c print*,ispmd,'send_buf', SIZ_SEND,' recv_buf:', SIZ_RECV
263c--------------------------------------------------------------------
264c MPI receive
265c--------------------------------------------------------------------
266 l = 1
267 DO i=1,nspmd
268 siz = iad_recv(i+1)-iad_recv(i)
269 IF (siz > 0)THEN
270 msgtyp = msgoff2
271 CALL mpi_irecv(
272 s recv_buf(l),siz,mpi_integer,it_spmd(i),msgtyp,
273 g spmd_comm_world,req_r2(i),ierror)
274 l = l + siz
275 ENDIF
276 END DO
277
278
279C --------------------------------------------------------------------
280C Prepare send buffers
281C --------------------------------------------------------------------
282 k=1
283 DO i=1,nspmd
284 DO j=failwave%FWAVE_IAD(i),failwave%FWAVE_IAD(i+1)-1
285 nd = failwave%FWAVE_FR(j)
286 DO l=1,failwave%MAXLEV(nd)
287 DO m=1,nddim
288 send_buf(k) = failwave%FWAVE_NOD(m,nd,l)
289 k = k +1
290 ENDDO
291 ENDDO
292 ENDDO
293 ENDDO
294
295c--------------------------------------------------------------------
296c MPI send
297c--------------------------------------------------------------------
298 DO i=1,nspmd
299 siz = iad_send(i+1)-iad_send(i)
300 IF (siz > 0)THEN
301 l = iad_send(i)
302C print*,'isend=',L
303 msgtyp = msgoff2
304 CALL mpi_isend(
305 s send_buf(l),siz,mpi_integer,it_spmd(i),msgtyp,
306 g spmd_comm_world,req_s2(i),ierror)
307 ENDIF
308 ENDDO
309
310C wait & unstack
311c--------------------------------------------------------------------
312c Receive buffer & compute receive_size
313c-------------------------------------------------------------------
314 recv_siz(1:nspmd)=0
315
316 DO i = 1, nspmd
317 siz = iad_recv(i+1)-iad_recv(i)
318 IF (siz > 0)THEN
319 CALL mpi_wait(req_r2(i),status,ierror)
320 l = iad_recv(i)
321
322 DO j=failwave%FWAVE_IAD(i),failwave%FWAVE_IAD(i+1)-1
323C Get the number of Stacked elements
324 nb=rbufi(j)
325 IF (nb > 0)THEN
326 nd = failwave%FWAVE_FR(j)
327 IF (failwave%WAVE_MOD == 1) THEN
328 DO m=1,nb
329 DO k=1,nddim
330 VALUE = recv_buf(l)
331 failwave%FWAVE_NOD(k,nd,1)=max(VALUE,failwave%FWAVE_NOD(k,nd,1))
332c print*,ispmd,'VALUE', VALUE,K,ND,MAXLEV
333 l=l+1
334 ENDDO
335 ENDDO
336 ELSE
337 DO m=1,nb
338 failwave%MAXLEV(nd)=failwave%MAXLEV(nd)+1
339 maxlev = failwave%MAXLEV(nd)
340 DO k=1,nddim
341 VALUE = recv_buf(l)
342 failwave%FWAVE_NOD(k,nd,maxlev)=VALUE
343c print*,ispmd,'VALUE', VALUE,K,ND,MAXLEV
344 l=l+1
345 ENDDO
346 ENDDO
347 ENDIF
348 ENDIF
349 END DO
350 ENDIF
351 END DO
352
353
354c--------------------------------------------------------------------
355c Terminate second send
356c-------------------------------------------------------------------
357 DO i = 1, nspmd
358 siz = iad_send(i+1)-iad_send(i)
359 IF (siz > 0)THEN
360 CALL mpi_wait(req_s2(i),status,ierror)
361 ENDIF
362 ENDDO
363 DEALLOCATE(send_buf)
364 DEALLOCATE(recv_buf)
365
366 DEALLOCATE(rbufi)
367 DEALLOCATE(sbufi)
368
369#endif
370
371 RETURN
372 END
373
max
#define max(a, b)
Definition macros.h:21
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_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
failwave_mod
Definition failwave_mod.F:61
spmd_exch_failwave
subroutine spmd_exch_failwave(failwave)
Definition spmd_exch_failwave.F:108
spmd_failwave_boundaries
subroutine spmd_failwave_boundaries(failwave, iad_elem, fr_elem)
Definition spmd_exch_failwave.F:32
failwave_mod::failwave_str_
Definition failwave_mod.F:68