OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_vol.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/.
23C
24!||====================================================================
25!|| spmd_exch_vol ../engine/source/mpi/nodes/spmd_exch_vol.F
26!||--- called by ------------------------------------------------------
27!|| s4alesfem ../engine/source/elements/solid/solide4_sfem/s4alesfem.F
28!|| s4lagsfem ../engine/source/elements/solid/solide4_sfem/s4lagsfem.F
29!||--- calls -----------------------------------------------------
30!||--- uses -----------------------------------------------------
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_exch_vol(VOLNOD6,VARNOD6,IAD_ELEM,
34 . FR_ELEM,LENR )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38 USE spmd_comm_world_mod, ONLY : spmd_comm_world
39#include "implicit_f.inc"
40C-----------------------------------------------
41C M e s s a g e P a s s i n g
42C-----------------------------------------------
43#include "spmd.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "task_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IAD_ELEM(2,*),FR_ELEM(*),LENR
53 double precision
54 . volnod6(6,*), varnod6(6,*)
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58#ifdef MPI
59 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,MSGOFF,
60 . siz,j,l,nb_nod,siz6,len,
61 . status(mpi_status_size),
62 . iad_send(nspmd+1),
63 . iad_recv(nspmd+1),
64 . req_r(nspmd),req_s(nspmd)
65 DATA msgoff/231/
66
67 DOUBLE PRECISION,
68 . DIMENSION(:,:),ALLOCATABLE :: rbuf, sbuf
69C-----------------------------------------------
70C S o u r c e L i n e s
71C-----------------------------------------------
72 ALLOCATE(rbuf(6,lenr))
73 ALLOCATE(sbuf(6,lenr))
74
75 loc_proc = ispmd + 1
76 siz6 = 6
77
78 l = 1
79 iad_recv(1) = 1
80
81 DO i=1,nspmd
82 len = iad_elem(1,i+1)-iad_elem(1,i)
83 siz = siz6 * 2 * len
84 IF(siz/=0)THEN
85 msgtyp = msgoff
86 CALL mpi_irecv(
87 s rbuf(1,l),siz,mpi_double_precision,
88 g it_spmd(i),msgtyp,spmd_comm_world,
89 h req_r(i),ierror)
90 l = l + 2*len
91 ENDIF
92 iad_recv(i+1) = l
93 END DO
94
95 l = 1
96 iad_send(1) = l
97
98 DO i=1,nspmd
99 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
100#include "vectorize.inc"
101 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
102 nod = fr_elem(j)
103c
104 sbuf(1, l) = volnod6(1,nod)
105 sbuf(2, l) = volnod6(2,nod)
106 sbuf(3, l) = volnod6(3,nod)
107 sbuf(4, l) = volnod6(4,nod)
108 sbuf(5, l) = volnod6(5,nod)
109 sbuf(6, l) = volnod6(6,nod)
110c
111 sbuf(1, l+ nb_nod) = varnod6(1,nod)
112 sbuf(2, l+ nb_nod) = varnod6(2,nod)
113 sbuf(3, l+ nb_nod) = varnod6(3,nod)
114 sbuf(4, l+ nb_nod) = varnod6(4,nod)
115 sbuf(5, l+ nb_nod) = varnod6(5,nod)
116 sbuf(6, l+ nb_nod) = varnod6(6,nod)
117c
118 l = l + 1
119 END DO
120
121 l = l + nb_nod
122 iad_send(i+1) = l
123 ENDDO
124C
125C echange messages
126C
127 DO i=1,nspmd
128C--------------------------------------------------------------------
129C envoi a N+I mod P
130 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
131 IF(nb_nod>0)THEN
132 msgtyp = msgoff
133 len = iad_elem(1,i+1)-iad_elem(1,i)
134
135 siz = len * 2 * siz6
136 l = iad_send(i)
137 CALL mpi_isend(
138 s sbuf(1,l),siz,mpi_double_precision,
139 g it_spmd(i),msgtyp,spmd_comm_world,
140 h req_s(i),ierror)
141 ENDIF
142C--------------------------------------------------------------------
143 ENDDO
144C
145C decompactage
146C
147 DO i = 1, nspmd
148 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
149 IF(nb_nod>0)THEN
150 CALL mpi_wait(req_r(i),status,ierror)
151 l = iad_recv(i)
152
153#include "vectorize.inc"
154 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
155 nod = fr_elem(j)
156 volnod6(1,nod) = volnod6(1,nod) + rbuf(1,l)
157 volnod6(2,nod) = volnod6(2,nod) + rbuf(2,l)
158 volnod6(3,nod) = volnod6(3,nod) + rbuf(3,l)
159 volnod6(4,nod) = volnod6(4,nod) + rbuf(4,l)
160 volnod6(5,nod) = volnod6(5,nod) + rbuf(5,l)
161 volnod6(6,nod) = volnod6(6,nod) + rbuf(6,l)
162c
163 varnod6(1,nod) = varnod6(1,nod) + rbuf(1,l+ nb_nod)
164 varnod6(2,nod) = varnod6(2,nod) + rbuf(2,l+ nb_nod)
165 varnod6(3,nod) = varnod6(3,nod) + rbuf(3,l+ nb_nod)
166 varnod6(4,nod) = varnod6(4,nod) + rbuf(4,l+ nb_nod)
167 varnod6(5,nod) = varnod6(5,nod) + rbuf(5,l+ nb_nod)
168 varnod6(6,nod) = varnod6(6,nod) + rbuf(6,l+ nb_nod)
169c
170 l = l + 1
171 END DO
172 ENDIF
173 END DO
174C
175C wait terminaison isend
176C
177 DO i = 1, nspmd
178 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
179 CALL mpi_wait(req_s(i),status,ierror)
180 ENDIF
181 ENDDO
182C
183#endif
184 RETURN
185 END
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
spmd_exch_vol
subroutine spmd_exch_vol(volnod6, varnod6, iad_elem, fr_elem, lenr)
Definition spmd_exch_vol.F:35