OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_r2r_nl.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_r2r_nl ../engine/source/mpi/r2r/spmd_exch_r2r_nl.F
25!||--- called by ------------------------------------------------------
26!|| r2r_getdata ../engine/source/coupling/rad2rad/r2r_getdata.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_exch_r2r_nl(
33 1 A ,AR, V, VR ,MS ,
34 2 IN,IAD_ELEM ,FR_ELEM, SIZE,
35 3 SBUF_SIZE,RBUF_SIZE,WF,WF2,DD_R2R,
36 4 DD_R2R_ELEM,WEIGHT,FLAG,NLOC_DMG)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE nlocal_reg_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44 USE spmd_comm_world_mod, ONLY : spmd_comm_world
45#include "implicit_f.inc"
46#include "r4r8_p.inc"
47C-----------------------------------------------------------------
48C M e s s a g e P a s s i n g
49C-----------------------------------------------
50#include "spmd.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr06_c.inc"
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "task_c.inc"
58#include "units_c.inc"
59#include "rad2r_c.inc"
60#include "tabsiz_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER,INTENT(IN) :: IAD_ELEM(2,NSPMD+1),FR_ELEM(SFR_ELEM),
65 . SIZE,DD_R2R(NSPMD+1,SDD_R2R),DD_R2R_ELEM(SDD_R2R_ELEM),
66 . FLAG,WEIGHT(NUMNOD),SBUF_SIZE,RBUF_SIZE
67 my_real,INTENT(IN) :: V(3,NUMNOD),VR(3,NUMNOD)
68 my_real,INTENT(INOUT) :: wf,wf2,a(3,numnod),ar(3,numnod),
69 . ms(numnod),in(iroddl*numnod)
70 TYPE(nlocal_str_), TARGET, INTENT(IN) :: NLOC_DMG
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74#ifdef MPI
75 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,
76 . SIZ,J,K,L,NB_NOD,
77 . STATUS(MPI_STATUS_SIZE),
78 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
79 . req_r(nspmd),req_s(nspmd),offset,msgoff,nn,
80 . offset_s_nl,offset_r_nl
81 my_real
82 . rbuf(rbuf_size),sbuf(sbuf_size),
83 . df1,df2,df3,df4,df5,df6
84c
85 INTEGER, POINTER, DIMENSION(:) :: IDXI,POSI
86 my_real, POINTER, DIMENSION(:) :: FNL
87c
88 DATA MSGOFF/5015/
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92C
93C-----------------------------------------------
94 fnl => nloc_dmg%FNL(1:nloc_dmg%L_NLOC,1)
95 idxi => nloc_dmg%IDXI(1:numnod)
96 posi => nloc_dmg%POSI(1:nloc_dmg%NNOD+1)
97C-----------------------------------------------
98C
99 offset = dd_r2r(nspmd+1,1)-1
100 offset_s_nl = offset + dd_r2r(nspmd+1,2)-1
101 offset_r_nl = offset_s_nl + dd_r2r(nspmd+1,3)-1
102C
103 loc_proc = ispmd + 1
104 l = 1
105 iad_recv(1) = 1
106
107 DO i=1,nspmd
108 siz = size*(dd_r2r(i+1,2)-dd_r2r(i,2))+dd_r2r(i+1,4)-dd_r2r(i,4)
109 IF(siz/=0)THEN
110 msgtyp = msgoff
111 CALL mpi_irecv(
112 s rbuf(l),siz,real,it_spmd(i),msgtyp,
113 g spmd_comm_world,req_r(i),ierror)
114 l = l + siz
115 ENDIF
116 iad_recv(i+1) = l
117 END DO
118 l = 1
119 iad_send(1) = 1
120C
121 DO i=1,nspmd
122C preparation envoi partie fixe (elem) a proc I
123 IF(iroddl/=0) THEN
124#include "vectorize.inc"
125 DO j=dd_r2r(i,1),dd_r2r(i+1,1)-1
126 nod = dd_r2r_elem(j)
127 sbuf(l ) = a(1,nod)
128 sbuf(l+1) = a(2,nod)
129 sbuf(l+2) = a(3,nod)
130 sbuf(l+3) = ar(1,nod)
131 sbuf(l+4) = ar(2,nod)
132 sbuf(l+5) = ar(3,nod)
133 IF (flag==1) THEN
134 sbuf(l+6) = ms(nod)
135 sbuf(l+7) = in(nod)
136 ENDIF
137 l = l + SIZE
138 ENDDO
139
140 ELSE
141#include "vectorize.inc"
142 DO j=dd_r2r(i,1),dd_r2r(i+1,1)-1
143 nod = dd_r2r_elem(j)
144 sbuf(l ) = a(1,nod)
145 sbuf(l+1) = a(2,nod)
146 sbuf(l+2) = a(3,nod)
147 IF (flag==1) THEN
148 sbuf(l+3) = ms(nod)
149 ENDIF
150 l = l + SIZE
151 END DO
152 ENDIF
153C
154#include "vectorize.inc"
155 DO j=dd_r2r(i,3),dd_r2r(i+1,3)-1
156 nod = dd_r2r_elem(offset_s_nl + j)
157 k = posi(idxi(nod))
158 sbuf(l) = fnl(k)
159 l = l + 1
160 ENDDO
161C
162 iad_send(i+1) = l
163 ENDDO
164C
165C echange messages
166C
167 DO i=1,nspmd
168C--------------------------------------------------------------------
169C envoi a N+I mod P
170C test si msg necessaire a envoyer a completer par test interface
171 IF(dd_r2r(i+1,1)-dd_r2r(i,1)>0)THEN
172 msgtyp = msgoff
173 siz = iad_send(i+1)-iad_send(i)
174 l = iad_send(i)
175 CALL mpi_isend(
176 s sbuf(l),siz,real,it_spmd(i),msgtyp,
177 g spmd_comm_world,req_s(i),ierror)
178 ENDIF
179C--------------------------------------------------------------------
180 ENDDO
181C
182C decompactage
183C
184 DO i = 1, nspmd
185C test si msg necessaire a envoyer a completer par test interface
186 nb_nod = dd_r2r(i+1,2)-dd_r2r(i,2)
187 IF(nb_nod>0)THEN
188 CALL mpi_wait(req_r(i),status,ierror)
189 l = iad_recv(i)
190
191 IF(iroddl/=0) THEN
192#include "vectorize.inc"
193 DO j=dd_r2r(i,2),dd_r2r(i+1,2)-1
194 nod = dd_r2r_elem(offset+j)
195 IF(weight(nod)==1)THEN
196 df1 = rbuf(l)-a(1,nod)
197 df2 = rbuf(l+1)-a(2,nod)
198 df3 = rbuf(l+2)-a(3,nod)
199 df4 = rbuf(l+3)-ar(1,nod)
200 df5 = rbuf(l+4)-ar(2,nod)
201 df6 = rbuf(l+5)-ar(3,nod)
202 ENDIF
203 a(1,nod) = rbuf(l)
204 a(2,nod) = rbuf(l+1)
205 a(3,nod) = rbuf(l+2)
206 ar(1,nod)= rbuf(l+3)
207 ar(2,nod)= rbuf(l+4)
208 ar(3,nod)= rbuf(l+5)
209 IF (flag==1) THEN
210 ms(nod)= rbuf(l+6)
211 in(nod)= rbuf(l+7)
212 ENDIF
213 l = l + SIZE
214C calcul du travail localement
215 IF(weight(nod)==1)THEN
216 wf = wf + (df1*v(1,nod)+df2*v(2,nod)+
217 . df3*v(3,nod))/two
218 wf2= wf2+ (df1*a(1,nod)+df2*a(2,nod)+
219 . df3*a(3,nod))/(two*ms(nod))
220 wf = wf + (df4*vr(1,nod)+df5*vr(2,nod)+
221 . df6*vr(3,nod))/two
222 wf2= wf2+ (df4*ar(1,nod)+df5*ar(2,nod)+
223 . df6*ar(3,nod))/(two*in(nod))
224 ENDIF
225 END DO
226 ELSE
227#include "vectorize.inc"
228 DO j=dd_r2r(i,2),dd_r2r(i+1,2)-1
229 nod = dd_r2r_elem(offset+j)
230 IF(weight(nod)==1)THEN
231 df1 = rbuf(l)-a(1,nod)
232 df2 = rbuf(l+1)-a(2,nod)
233 df3 = rbuf(l+2)-a(3,nod)
234 ENDIF
235 a(1,nod) = rbuf(l)
236 a(2,nod) = rbuf(l+1)
237 a(3,nod) = rbuf(l+2)
238 IF (flag==1) THEN
239 ms(nod)= rbuf(l+3)
240 ENDIF
241 l = l + SIZE
242C calcul du travail localement
243 IF(weight(nod)==1)THEN
244 wf = wf + (df1*v(1,nod)+df2*v(2,nod)+
245 . df3*v(3,nod))/two
246 wf2= wf2+ (df1*a(1,nod)+df2*a(2,nod)+
247 . df3*a(3,nod))/(two*ms(nod))
248 ENDIF
249 END DO
250 ENDIF
251C
252#include "vectorize.inc"
253 DO j=dd_r2r(i,4),dd_r2r(i+1,4)-1
254 nod = dd_r2r_elem(offset_r_nl + j)
255 k = posi(idxi(nod))
256 fnl(k) = rbuf(l)
257 l = l + 1
258 ENDDO
259C ---
260 ENDIF
261C
262 END DO
263C
264C wait terminaison isend
265C
266 DO i = 1, nspmd
267 IF(dd_r2r(i+1,1)-dd_r2r(i,1)>0)THEN
268 CALL mpi_wait(req_s(i),status,ierror)
269 ENDIF
270 ENDDO
271C
272
273#endif
274 RETURN
275 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
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
spmd_exch_r2r_nl
subroutine spmd_exch_r2r_nl(a, ar, v, vr, ms, in, iad_elem, fr_elem, size, sbuf_size, rbuf_size, wf, wf2, dd_r2r, dd_r2r_elem, weight, flag, nloc_dmg)
Definition spmd_exch_r2r_nl.F:37
nlocal_reg_mod::nlocal_str_
Definition nlocal_reg_mod.F:124