OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_int2_pon.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exch_a_int2_pon (fr_i2m, iad_i2m, addcni2, procni2, fr_nbcci2, i2size, lenr, lens, fskyi2, intth2, ftheskyi2, condnskyi2, i2sizemec, lcomi2m, fncont, fncontp, ftcontp, h3d_data, idt_therm)

Function/Subroutine Documentation

◆ spmd_exch_a_int2_pon()

subroutine spmd_exch_a_int2_pon ( integer, dimension(*) fr_i2m,
integer, dimension(*) iad_i2m,
integer, dimension(*) addcni2,
integer, dimension(*) procni2,
integer, dimension(2,*) fr_nbcci2,
integer i2size,
integer lenr,
integer lens,
fskyi2,
integer intth2,
ftheskyi2,
condnskyi2,
integer i2sizemec,
integer, intent(in) lcomi2m,
dimension(3,numnod), intent(inout) fncont,
dimension(3,numnod), intent(inout) fncontp,
dimension(3,numnod), intent(inout) ftcontp,
type(h3d_database) h3d_data,
integer, intent(in) idt_therm )

Definition at line 33 of file spmd_exch_a_int2_pon.F.

38C-----------------------------------------------
39 USE h3d_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43 USE spmd_comm_world_mod, ONLY : spmd_comm_world
44#include "implicit_f.inc"
45C-----------------------------------------------------------------
46C M e s s a g e P a s s i n g
47C-----------------------------------------------
48#include "spmd.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "task_c.inc"
55#include "scr18_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IAD_I2M(*),FR_I2M(*),FR_NBCCI2(2,*),
60 . ADDCNI2(*), PROCNI2(*),
61 . I2SIZE ,LENR ,LENS,INTTH2,I2SIZEMEC
62 INTEGER , INTENT(IN) :: LCOMI2M
63 INTEGER ,INTENT(IN) :: IDT_THERM
64 my_real
65 . fskyi2(i2sizemec,*),ftheskyi2(*),condnskyi2(*)
66 my_real , INTENT(INOUT) :: fncont(3,numnod),
67 . fncontp(3,numnod),ftcontp(3,numnod)
68 TYPE(H3D_DATABASE) :: H3D_DATA
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72#ifdef MPI
73 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR, INDEXI, NISKYF, N, IDEB,
74 . SIZ, J, L, CC, NBIRECV, NBISEND, II, MSGOFF,ISIZOUT,LEN,
75 . LENSAV,
76 . IAD_RECV(NSPMD+1), INDEXR(NSPMD),INDEXS(NSPMD),
77 . REQ_R(NSPMD),REQ_S(NSPMD),
78 . STATUS(MPI_STATUS_SIZE)
79 my_real,
80 . DIMENSION (:),ALLOCATABLE :: sbuf,rbuf
81 DATA msgoff/171/
82C-----------------------------------------------
83C S o u r c e L i n e s
84C-----------------------------------------------
85 loc_proc = ispmd + 1
86C
87 isizout=0
88 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
89 isizout = 3
90 ENDIF
91 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
92 isizout = isizout + 6
93 ENDIF
94 ALLOCATE(sbuf(lens*i2size+isizout*lcomi2m))
95 ALLOCATE(rbuf(lenr*i2size+isizout*lcomi2m))
96
97C
98 nbirecv = 0
99 nbisend = 0
100 l = 1
101 iad_recv(1) = 1
102 DO i = 1, nspmd
103 len = iad_i2m(i+1)-iad_i2m(i)
104 IF(fr_nbcci2(2,i)>0.OR.len*isizout>0) THEN
105 siz = (i2size)*fr_nbcci2(2,i)+isizout*len
106 msgtyp = msgoff
107 nbirecv = nbirecv + 1
108 indexr(nbirecv) = i
109 CALL mpi_irecv(
110 s rbuf(l),siz,real,it_spmd(i),msgtyp,
111 g spmd_comm_world,req_r(nbirecv),ierror)
112 l = l + siz
113 ENDIF
114 iad_recv(i+1) = l
115 IF(fr_nbcci2(1,i)>0.OR.len*isizout>0) THEN
116 nbisend = nbisend + 1
117 indexs(nbisend) = i
118 ENDIF
119 ENDDO
120C
121C preparation envoi
122C
123 l = 1
124 DO ii=1, nbisend
125 i = indexs(ii)
126 IF (intth2 == 1) THEN
127 IF(idt_therm == 1) THEN
128 IF(iroddl/=0) THEN
129 DO j=iad_i2m(i),iad_i2m(i+1)-1
130 nod = fr_i2m(j)
131 DO cc = addcni2(nod),addcni2(nod+1)-1
132 IF(procni2(cc)==loc_proc) THEN
133 sbuf(l) = fskyi2(1,cc)
134 sbuf(l+1) = fskyi2(2,cc)
135 sbuf(l+2) = fskyi2(3,cc)
136 sbuf(l+3) = fskyi2(4,cc)
137 sbuf(l+4) = fskyi2(5,cc)
138 sbuf(l+5) = fskyi2(6,cc)
139 sbuf(l+6) = fskyi2(7,cc)
140 sbuf(l+7) = fskyi2(8,cc)
141 sbuf(l+8) = fskyi2(9,cc)
142 sbuf(l+9) = fskyi2(10,cc)
143 sbuf(l+10)= ftheskyi2(cc)
144 sbuf(l+11)= condnskyi2(cc)
145 l = l + i2size
146 ENDIF
147 ENDDO
148 END DO
149 ELSE
150 DO j=iad_i2m(i),iad_i2m(i+1)-1
151 nod = fr_i2m(j)
152 DO cc = addcni2(nod),addcni2(nod+1)-1
153 IF(procni2(cc)==loc_proc) THEN
154 sbuf(l) = fskyi2(1,cc)
155 sbuf(l+1) = fskyi2(2,cc)
156 sbuf(l+2) = fskyi2(3,cc)
157 sbuf(l+3) = fskyi2(4,cc)
158 sbuf(l+4) = fskyi2(5,cc)
159 sbuf(l+5) = ftheskyi2(cc)
160 sbuf(l+6) = condnskyi2(cc)
161 l = l + i2size
162 ENDIF
163 ENDDO
164 END DO
165 ENDIF
166 ELSE
167 IF(iroddl/=0) THEN
168 DO j=iad_i2m(i),iad_i2m(i+1)-1
169 nod = fr_i2m(j)
170 DO cc = addcni2(nod),addcni2(nod+1)-1
171 IF(procni2(cc)==loc_proc) THEN
172 sbuf(l) = fskyi2(1,cc)
173 sbuf(l+1) = fskyi2(2,cc)
174 sbuf(l+2) = fskyi2(3,cc)
175 sbuf(l+3) = fskyi2(4,cc)
176 sbuf(l+4) = fskyi2(5,cc)
177 sbuf(l+5) = fskyi2(6,cc)
178 sbuf(l+6) = fskyi2(7,cc)
179 sbuf(l+7) = fskyi2(8,cc)
180 sbuf(l+8) = fskyi2(9,cc)
181 sbuf(l+9) = fskyi2(10,cc)
182 sbuf(l+10)= ftheskyi2(cc)
183 l = l + i2size
184 ENDIF
185 ENDDO
186 END DO
187 ELSE
188 DO j=iad_i2m(i),iad_i2m(i+1)-1
189 nod = fr_i2m(j)
190 DO cc = addcni2(nod),addcni2(nod+1)-1
191 IF(procni2(cc)==loc_proc) THEN
192 sbuf(l) = fskyi2(1,cc)
193 sbuf(l+1) = fskyi2(2,cc)
194 sbuf(l+2) = fskyi2(3,cc)
195 sbuf(l+3) = fskyi2(4,cc)
196 sbuf(l+4) = fskyi2(5,cc)
197 sbuf(l+5) = ftheskyi2(cc)
198 l = l + i2size
199 ENDIF
200 ENDDO
201 END DO
202 ENDIF
203 ENDIF
204 ELSE
205 IF(iroddl/=0) THEN
206 DO j=iad_i2m(i),iad_i2m(i+1)-1
207 nod = fr_i2m(j)
208 DO cc = addcni2(nod),addcni2(nod+1)-1
209 IF(procni2(cc)==loc_proc) THEN
210 sbuf(l) = fskyi2(1,cc)
211 sbuf(l+1) = fskyi2(2,cc)
212 sbuf(l+2) = fskyi2(3,cc)
213 sbuf(l+3) = fskyi2(4,cc)
214 sbuf(l+4) = fskyi2(5,cc)
215 sbuf(l+5) = fskyi2(6,cc)
216 sbuf(l+6) = fskyi2(7,cc)
217 sbuf(l+7) = fskyi2(8,cc)
218 sbuf(l+8) = fskyi2(9,cc)
219 sbuf(l+9) = fskyi2(10,cc)
220 l = l + i2size
221 ENDIF
222 ENDDO
223 END DO
224 ELSE
225 DO j=iad_i2m(i),iad_i2m(i+1)-1
226 nod = fr_i2m(j)
227 DO cc = addcni2(nod),addcni2(nod+1)-1
228 IF(procni2(cc)==loc_proc) THEN
229 sbuf(l) = fskyi2(1,cc)
230 sbuf(l+1) = fskyi2(2,cc)
231 sbuf(l+2) = fskyi2(3,cc)
232 sbuf(l+3) = fskyi2(4,cc)
233 sbuf(l+4) = fskyi2(5,cc)
234 l = l + i2size
235 ENDIF
236 ENDDO
237 END DO
238 ENDIF
239 ENDIF
240C
241 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
242#include "vectorize.inc"
243 DO j=iad_i2m(i),iad_i2m(i+1)-1
244 nod = fr_i2m(j)
245 sbuf(l) = fncont(1,nod)
246 sbuf(l+1) = fncont(2,nod)
247 sbuf(l+2) = fncont(3,nod)
248 l = l + 3
249 ENDDO
250 ENDIF
251 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
252#include "vectorize.inc"
253 DO j=iad_i2m(i),iad_i2m(i+1)-1
254 nod = fr_i2m(j)
255 sbuf(l) = fncontp(1,nod)
256 sbuf(l+1) = fncontp(2,nod)
257 sbuf(l+2) = fncontp(3,nod)
258 sbuf(l+3) = ftcontp(1,nod)
259 sbuf(l+4) = ftcontp(2,nod)
260 sbuf(l+5) = ftcontp(3,nod)
261 l = l + 6
262 ENDDO
263 ENDIF
264C
265 ENDDO
266C
267C echange messages
268C
269 l = 1
270 DO ii=1,nbisend
271 i = indexs(ii)
272 len = iad_i2m(i+1)-iad_i2m(i)
273 siz = i2size*fr_nbcci2(1,i) +isizout*len
274 msgtyp = msgoff
275 CALL mpi_isend(
276 s sbuf(l),siz,real,it_spmd(i),msgtyp,
277 g spmd_comm_world,req_s(ii),ierror)
278 l = l + siz
279 ENDDO
280C
281C decompactage
282C
283 DO ii=1,nbirecv
284 CALL mpi_waitany(nbirecv,req_r,indexi,status,ierror)
285 i = indexr(indexi)
286 l = iad_recv(i)
287 IF (intth2 == 1) THEN
288 IF(idt_therm == 1) THEN
289 IF(iroddl/=0) THEN
290 DO j=iad_i2m(i),iad_i2m(i+1)-1
291 nod = fr_i2m(j)
292 DO cc = addcni2(nod), addcni2(nod+1)-1
293 IF(procni2(cc)==i) THEN
294 fskyi2(1,cc) = rbuf(l)
295 fskyi2(2,cc) = rbuf(l+1)
296 fskyi2(3,cc) = rbuf(l+2)
297 fskyi2(4,cc) = rbuf(l+3)
298 fskyi2(5,cc) = rbuf(l+4)
299 fskyi2(6,cc) = rbuf(l+5)
300 fskyi2(7,cc) = rbuf(l+6)
301 fskyi2(8,cc) = rbuf(l+7)
302 fskyi2(9,cc) = rbuf(l+8)
303 fskyi2(10,cc)= rbuf(l+9)
304 ftheskyi2(cc)= rbuf(l+10)
305 condnskyi2(cc)= rbuf(l+11)
306 l = l + i2size
307 ENDIF
308 ENDDO
309 END DO
310 ELSE
311 DO j=iad_i2m(i),iad_i2m(i+1)-1
312 nod = fr_i2m(j)
313 DO cc = addcni2(nod), addcni2(nod+1)-1
314 IF(procni2(cc)==i) THEN
315 fskyi2(1,cc) = rbuf(l)
316 fskyi2(2,cc) = rbuf(l+1)
317 fskyi2(3,cc) = rbuf(l+2)
318 fskyi2(4,cc) = rbuf(l+3)
319 fskyi2(5,cc) = rbuf(l+4)
320 ftheskyi2(cc)= rbuf(l+5)
321 condnskyi2(cc)= rbuf(l+6)
322 l = l + i2size
323 END IF
324 END DO
325 END DO
326 END IF
327 ELSE
328 IF(iroddl/=0) THEN
329 DO j=iad_i2m(i),iad_i2m(i+1)-1
330 nod = fr_i2m(j)
331 DO cc = addcni2(nod), addcni2(nod+1)-1
332 IF(procni2(cc)==i) THEN
333 fskyi2(1,cc) = rbuf(l)
334 fskyi2(2,cc) = rbuf(l+1)
335 fskyi2(3,cc) = rbuf(l+2)
336 fskyi2(4,cc) = rbuf(l+3)
337 fskyi2(5,cc) = rbuf(l+4)
338 fskyi2(6,cc) = rbuf(l+5)
339 fskyi2(7,cc) = rbuf(l+6)
340 fskyi2(8,cc) = rbuf(l+7)
341 fskyi2(9,cc) = rbuf(l+8)
342 fskyi2(10,cc)= rbuf(l+9)
343 ftheskyi2(cc)= rbuf(l+10)
344 l = l + i2size
345 ENDIF
346 ENDDO
347 END DO
348 ELSE
349 DO j=iad_i2m(i),iad_i2m(i+1)-1
350 nod = fr_i2m(j)
351 DO cc = addcni2(nod), addcni2(nod+1)-1
352 IF(procni2(cc)==i) THEN
353 fskyi2(1,cc) = rbuf(l)
354 fskyi2(2,cc) = rbuf(l+1)
355 fskyi2(3,cc) = rbuf(l+2)
356 fskyi2(4,cc) = rbuf(l+3)
357 fskyi2(5,cc) = rbuf(l+4)
358 ftheskyi2(cc)= rbuf(l+5)
359 l = l + i2size
360 END IF
361 END DO
362 END DO
363 END IF
364 ENDIF
365 ELSE
366 IF(iroddl/=0) THEN
367 DO j=iad_i2m(i),iad_i2m(i+1)-1
368 nod = fr_i2m(j)
369 DO cc = addcni2(nod), addcni2(nod+1)-1
370 IF(procni2(cc)==i) THEN
371 fskyi2(1,cc) = rbuf(l)
372 fskyi2(2,cc) = rbuf(l+1)
373 fskyi2(3,cc) = rbuf(l+2)
374 fskyi2(4,cc) = rbuf(l+3)
375 fskyi2(5,cc) = rbuf(l+4)
376 fskyi2(6,cc) = rbuf(l+5)
377 fskyi2(7,cc) = rbuf(l+6)
378 fskyi2(8,cc) = rbuf(l+7)
379 fskyi2(9,cc) = rbuf(l+8)
380 fskyi2(10,cc)= rbuf(l+9)
381 l = l + i2size
382 ENDIF
383 ENDDO
384 END DO
385 ELSE
386 DO j=iad_i2m(i),iad_i2m(i+1)-1
387 nod = fr_i2m(j)
388 DO cc = addcni2(nod), addcni2(nod+1)-1
389 IF(procni2(cc)==i) THEN
390 fskyi2(1,cc) = rbuf(l)
391 fskyi2(2,cc) = rbuf(l+1)
392 fskyi2(3,cc) = rbuf(l+2)
393 fskyi2(4,cc) = rbuf(l+3)
394 fskyi2(5,cc) = rbuf(l+4)
395 l = l + i2size
396 END IF
397 END DO
398 END DO
399 END IF
400 ENDIF
401C
402 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
403#include "vectorize.inc"
404 DO j=iad_i2m(i),iad_i2m(i+1)-1
405 nod = fr_i2m(j)
406 fncont(1,nod) = fncont(1,nod) + rbuf(l)
407 fncont(2,nod) = fncont(2,nod) + rbuf(l+1)
408 fncont(3,nod) = fncont(3,nod) + rbuf(l+2)
409 l = l + 3
410 ENDDO
411 ENDIF
412 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
413#include "vectorize.inc"
414 DO j=iad_i2m(i),iad_i2m(i+1)-1
415 nod = fr_i2m(j)
416 fncontp(1,nod) = fncontp(1,nod) + rbuf(l)
417 fncontp(2,nod) = fncontp(2,nod) + rbuf(l+1)
418 fncontp(3,nod) = fncontp(3,nod) + rbuf(l+2)
419 ftcontp(1,nod) = ftcontp(1,nod) + rbuf(l+3)
420 ftcontp(2,nod) = ftcontp(2,nod) + rbuf(l+4)
421 ftcontp(3,nod) = ftcontp(3,nod) + rbuf(l+5)
422 l = l + 6
423 ENDDO
424 ENDIF
425C
426
427 END DO
428C
429C wait terminaison isend
430C
431 DO l=1,nbisend
432 CALL mpi_waitany(nbisend,req_s,indexi,status,ierror)
433 ENDDO
434C
435 DEALLOCATE(rbuf)
436 DEALLOCATE(sbuf)
437
438C
439#endif
440 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_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
h3d_mod
Definition h3d_mod.F:308