OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_r2r_nl.F File Reference
#include "implicit_f.inc"
#include "r4r8_p.inc"
#include "spmd.inc"
#include "scr06_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "units_c.inc"
#include "rad2r_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ spmd_exch_r2r_nl()

subroutine spmd_exch_r2r_nl ( dimension(3,numnod), intent(inout) a,
dimension(3,numnod), intent(inout) ar,
dimension(3,numnod), intent(in) v,
dimension(3,numnod), intent(in) vr,
dimension(numnod), intent(inout) ms,
dimension(iroddl*numnod), intent(inout) in,
integer, dimension(2,nspmd+1), intent(in) iad_elem,
integer, dimension(sfr_elem), intent(in) fr_elem,
integer, intent(in) size,
integer, intent(in) sbuf_size,
integer, intent(in) rbuf_size,
intent(inout) wf,
intent(inout) wf2,
integer, dimension(nspmd+1,sdd_r2r), intent(in) dd_r2r,
integer, dimension(sdd_r2r_elem), intent(in) dd_r2r_elem,
integer, dimension(numnod), intent(in) weight,
integer, intent(in) flag,
type(nlocal_str_), intent(in), target nloc_dmg )

Definition at line 32 of file spmd_exch_r2r_nl.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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