OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_dttsh.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_exch_tag_tsh ../engine/source/mpi/elements/spmd_exch_dttsh.F
25!||--- called by ------------------------------------------------------
26!|| tshcdcom_dim ../engine/source/elements/thickshell/solidec/tshcdcom_dim.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| message_mod ../engine/share/message_module/message_mod.F
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_exch_tag_tsh(IAD_ELEM ,FR_ELEM ,ISEND,IRECV ,LEN)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE message_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 M e s s a g e P a s s i n g
44C-----------------------------------------------
45#include "spmd.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "task_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER LEN
55 INTEGER, INTENT(IN) :: IAD_ELEM(2,*),FR_ELEM(*),ISEND(LEN)
56 INTEGER, INTENT(INOUT) :: IRECV(LEN)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60#ifdef MPI
61 INTEGER LENCOM,MSGOFF ,MSGTYP
62 INTEGER STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),REQ_S(NSPMD)
63 INTEGER IERROR
64 INTEGER I,P,J,NOD,SIZ,L,IAD
65C-----------------------------------------------
66 DATA msgoff/430/
67
68 DO i=1,nspmd
69 siz = iad_elem(1,i+1)-iad_elem(1,i)
70 IF(siz>0)THEN
71 msgtyp = msgoff
72 l = iad_elem(1,i)
73 CALL mpi_irecv(
74 + irecv(l),siz,mpi_integer,it_spmd(i),msgtyp,
75 + spmd_comm_world,req_r(i),ierror)
76 ENDIF
77 END DO
78C
79C echange messages
80C
81 DO i=1,nspmd
82 siz = iad_elem(1,i+1)-iad_elem(1,i)
83 IF(siz>0)THEN
84 msgtyp = msgoff
85 l = iad_elem(1,i)
86 CALL mpi_isend(
87 + isend(l),siz,mpi_integer,it_spmd(i),msgtyp,
88 + spmd_comm_world,req_s(i),ierror)
89 ENDIF
90 ENDDO
91C
92 DO i = 1, nspmd
93 siz = iad_elem(1,i+1)-iad_elem(1,i)
94 IF(siz>0)THEN
95 CALL mpi_wait(req_r(i),status,ierror)
96 ENDIF
97 ENDDO
98 DO i = 1, nspmd
99 siz = iad_elem(1,i+1)-iad_elem(1,i)
100 IF(siz>0)THEN
101 CALL mpi_wait(req_s(i),status,ierror)
102 ENDIF
103 ENDDO
104#endif
105
106 END SUBROUTINE spmd_exch_tag_tsh
107!||====================================================================
108!|| spmd_exch_vmax ../engine/source/mpi/elements/spmd_exch_dttsh.F
109!||--- called by ------------------------------------------------------
110!|| resol ../engine/source/engine/resol.F
111!||--- calls -----------------------------------------------------
112!|| ancmsg ../engine/source/output/message/message.F
113!|| arret ../engine/source/system/arret.F
114!||--- uses -----------------------------------------------------
115!|| message_mod ../engine/share/message_module/message_mod.F
116!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
117!||====================================================================
118 SUBROUTINE spmd_exch_vmax(IAD_STSH ,FR_STSH ,IAD_RTSH ,FR_RTSH ,V_MAX )
119C-----------------------------------------------
120C M o d u l e s
121C-----------------------------------------------
122 USE message_mod
123C-----------------------------------------------
124C I m p l i c i t T y p e s
125C-----------------------------------------------
126 USE spmd_comm_world_mod, ONLY : spmd_comm_world
127#include "implicit_f.inc"
128C-----------------------------------------------
129C M e s s a g e P a s s i n g
130C-----------------------------------------------
131#include "spmd.inc"
132C-----------------------------------------------
133C C o m m o n B l o c k s
134C-----------------------------------------------
135#include "com01_c.inc"
136#include "com04_c.inc"
137#include "task_c.inc"
138C-----------------------------------------------
139C D u m m y A r g u m e n t s
140C-----------------------------------------------
141 INTEGER, INTENT(IN) :: IAD_STSH(*),FR_STSH(*),IAD_RTSH(*),FR_RTSH(*)
142 my_real , INTENT(INOUT) :: v_max(numnod)
143C-----------------------------------------------
144C L o c a l V a r i a b l e s
145C-----------------------------------------------
146#ifdef MPI
147 INTEGER LENCOM,MSGOFF ,MSGTYP
148 my_real, dimension(:), ALLOCATABLE :: send_buf,rec_buf
149 INTEGER STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),REQ_S(NSPMD)
150 INTEGER IERROR
151 INTEGER P,J,NOD,SIZ,L,IAD
152C-----------------------------------------------
153 DATA msgoff/410/
154 msgtyp=msgoff
155
156 lencom = iad_stsh(nspmd+1) - iad_stsh(1)
157
158C Allocation des Buffers
159 ALLOCATE(send_buf(lencom),stat=ierror)
160 IF(ierror/=0) THEN
161 CALL ancmsg(msgid=20,anmode=aninfo)
162 CALL arret(2)
163 ENDIF
164
165 lencom = iad_rtsh(nspmd+1) - iad_rtsh(1)
166
167 ALLOCATE(rec_buf(lencom),stat=ierror)
168 IF(ierror/=0) THEN
169 CALL ancmsg(msgid=20,anmode=aninfo)
170 CALL arret(2)
171 ENDIF
172C
173C ----------
174C Set IRECV
175C ----------
176 l=1
177 DO p=1,nspmd
178 siz = iad_rtsh(p+1)-iad_rtsh(p)
179 IF(siz > 0) THEN
180 CALL mpi_irecv(
181 s rec_buf(l),siz,real,it_spmd(p),msgtyp,
182 g spmd_comm_world,req_r(p),ierror)
183 l=l+siz
184 ENDIF
185 ENDDO
186
187C -----------------
188C PREPARE SEND_BUF
189C -----------------
190 l=1
191 DO p=1,nspmd
192 siz = iad_stsh(p+1)-iad_stsh(p)
193 IF(siz > 0)THEN
194 iad = l
195 DO j=iad_stsh(p),iad_stsh(p+1)-1
196 nod = fr_stsh(j)
197 send_buf(l)=v_max(nod)
198 l=l+1
199 ENDDO
200
201 CALL mpi_isend(
202 s send_buf(iad),siz,real,it_spmd(p),msgtyp,
203 g spmd_comm_world,req_s(p),ierror)
204
205 ENDIF
206 ENDDO
207
208C ------------
209C END RECEIVE
210C ------------
211 l=1
212 DO p=1,nspmd
213 siz = iad_rtsh(p+1)-iad_rtsh(p)
214 IF(siz > 0)THEN
215 CALL mpi_wait(req_r(p),status,ierror)
216
217 DO j=iad_rtsh(p),iad_rtsh(p+1)-1
218 nod = fr_rtsh(j)
219 v_max(nod) = max(v_max(nod), rec_buf(l))
220 l = l+1
221 ENDDO
222 ENDIF
223 ENDDO
224
225C ------------
226C END SEND
227C ------------
228 DO p = 1, nspmd
229 IF(iad_stsh(p+1)-iad_stsh(p)>0)THEN
230 CALL mpi_wait(req_s(p),status,ierror)
231 ENDIF
232 ENDDO
233 IF (ALLOCATED(send_buf)) DEALLOCATE(send_buf)
234 IF (ALLOCATED(rec_buf)) DEALLOCATE(rec_buf)
235
236#endif
237
238 END SUBROUTINE spmd_exch_vmax
239!||====================================================================
240!|| spmd_exch_fa ../engine/source/mpi/elements/spmd_exch_dttsh.F
241!||--- called by ------------------------------------------------------
242!|| resol ../engine/source/engine/resol.F
243!||--- calls -----------------------------------------------------
244!|| ancmsg ../engine/source/output/message/message.F
245!|| arret ../engine/source/system/arret.F
246!||--- uses -----------------------------------------------------
247!|| message_mod ../engine/share/message_module/message_mod.F
248!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
249!||====================================================================
250 SUBROUTINE spmd_exch_fa(IAD_STSH ,FR_STSH ,IAD_RTSH ,FR_RTSH ,A )
251C-----------------------------------------------
252C M o d u l e s
253C-----------------------------------------------
254 USE message_mod
255C-----------------------------------------------
256C I m p l i c i t T y p e s
257C-----------------------------------------------
258 USE spmd_comm_world_mod, ONLY : spmd_comm_world
259#include "implicit_f.inc"
260C-----------------------------------------------
261C M e s s a g e P a s s i n g
262C-----------------------------------------------
263#include "spmd.inc"
264C-----------------------------------------------
265C C o m m o n B l o c k s
266C-----------------------------------------------
267#include "com01_c.inc"
268#include "com04_c.inc"
269#include "task_c.inc"
270C-----------------------------------------------
271C D u m m y A r g u m e n t s
272C-----------------------------------------------
273 INTEGER, INTENT(IN) :: IAD_STSH(*),FR_STSH(*),IAD_RTSH(*),FR_RTSH(*)
274 my_real , INTENT(INOUT) :: a(3,numnod)
275C-----------------------------------------------
276C L o c a l V a r i a b l e s
277C-----------------------------------------------
278#ifdef MPI
279 INTEGER LENCOM,MSGOFF ,MSGTYP
280 my_real, dimension(:), ALLOCATABLE :: send_buf,rec_buf
281 INTEGER STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),REQ_S(NSPMD)
282 INTEGER IERROR
283 INTEGER P,J,NOD,SIZ,L,IAD
284C-----------------------------------------------
285 DATA msgoff/420/
286 msgtyp=msgoff
287
288 lencom = iad_stsh(nspmd+1) - iad_stsh(1)
289
290C Allocation des Buffers
291 ALLOCATE(send_buf(3*lencom),stat=ierror)
292 IF(ierror/=0) THEN
293 CALL ancmsg(msgid=20,anmode=aninfo)
294 CALL arret(2)
295 ENDIF
296 lencom = iad_rtsh(nspmd+1) - iad_rtsh(1)
297
298 ALLOCATE(rec_buf(3*lencom),stat=ierror)
299 IF(ierror/=0) THEN
300 CALL ancmsg(msgid=20,anmode=aninfo)
301 CALL arret(2)
302 ENDIF
303C
304C ----------
305C Set IRECV
306C ----------
307 l=1
308 DO p=1,nspmd
309 siz = 3*(iad_rtsh(p+1)-iad_rtsh(p))
310 IF(siz > 0) THEN
311 CALL mpi_irecv(
312 s rec_buf(l),siz,real,it_spmd(p),msgtyp,
313 g spmd_comm_world,req_r(p),ierror)
314 l=l+siz
315 ENDIF
316 ENDDO
317
318C -----------------
319C PREPARE SEND_BUF
320C -----------------
321 l=1
322 DO p=1,nspmd
323 siz = 3*(iad_stsh(p+1)-iad_stsh(p))
324 IF(siz > 0)THEN
325 iad = l
326 DO j=iad_stsh(p),iad_stsh(p+1)-1
327 nod = fr_stsh(j)
328 send_buf(l) =a(1,nod)
329 send_buf(l+1)=a(2,nod)
330 send_buf(l+2)=a(3,nod)
331 l=l+3
332 ENDDO
333
334 CALL mpi_isend(
335 s send_buf(iad),siz,real,it_spmd(p),msgtyp,
336 g spmd_comm_world,req_s(p),ierror)
337
338 ENDIF
339 ENDDO
340
341C ------------
342C END RECEIVE
343C ------------
344 l=1
345 DO p=1,nspmd
346 siz = 3*(iad_rtsh(p+1)-iad_rtsh(p))
347 IF(siz > 0)THEN
348 CALL mpi_wait(req_r(p),status,ierror)
349
350 DO j=iad_rtsh(p),iad_rtsh(p+1)-1
351 nod = fr_rtsh(j)
352 a(1,nod) = rec_buf(l)
353 a(2,nod) = rec_buf(l+1)
354 a(3,nod) = rec_buf(l+2)
355 l = l+3
356 ENDDO
357 ENDIF
358 ENDDO
359
360C ------------
361C END SEND
362C ------------
363 DO p = 1, nspmd
364 IF(iad_stsh(p+1)-iad_stsh(p)>0)THEN
365 CALL mpi_wait(req_s(p),status,ierror)
366 ENDIF
367 ENDDO
368 IF (ALLOCATED(send_buf)) DEALLOCATE(send_buf)
369 IF (ALLOCATED(rec_buf)) DEALLOCATE(rec_buf)
370
371#endif
372
373 END SUBROUTINE spmd_exch_fa
374
my_real
#define my_real
Definition cppsort.cpp:32
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
message_mod
Definition message_mod.F:1249
spmd_exch_vmax
subroutine spmd_exch_vmax(iad_stsh, fr_stsh, iad_rtsh, fr_rtsh, v_max)
Definition spmd_exch_dttsh.F:119
spmd_exch_fa
subroutine spmd_exch_fa(iad_stsh, fr_stsh, iad_rtsh, fr_rtsh, a)
Definition spmd_exch_dttsh.F:251
spmd_exch_tag_tsh
subroutine spmd_exch_tag_tsh(iad_elem, fr_elem, isend, irecv, len)
Definition spmd_exch_dttsh.F:33
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87