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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exch_a_ams_poff (a, ar, stifn, stifr, ms, iad_elem, fr_elem, msnf, ifsubm, size, lenr, fthe, mcp, fr_loc, nb_fr, ms_2d, mcp_off, forneqs, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)

Function/Subroutine Documentation

◆ spmd_exch_a_ams_poff()

subroutine spmd_exch_a_ams_poff ( a,
ar,
stifn,
stifr,
ms,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
msnf,
integer ifsubm,
integer size,
integer lenr,
fthe,
mcp,
integer, dimension(*) fr_loc,
integer nb_fr,
ms_2d,
mcp_off,
forneqs,
integer nfacnit,
integer lenc,
dimension(3,numnod), intent(inout) fcont,
type(h3d_database) h3d_data,
dimension(3,numnod), intent(inout) fncont,
dimension(3,numnod), intent(inout) ftcont,
type(glob_therm_), intent(in) glob_therm )

Definition at line 33 of file spmd_exch_a_ams_poff.F.

40C--------------------------------------
41 USE h3d_mod
42 USE glob_therm_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46 USE spmd_comm_world_mod, ONLY : spmd_comm_world
47#include "implicit_f.inc"
48C-----------------------------------------------------------------
49C M e s s a g e P a s s i n g
50C-----------------------------------------------
51#include "spmd.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "task_c.inc"
58#include "scr14_c.inc"
59#include "intstamp_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IAD_ELEM(2,*),FR_ELEM(*), SIZE, LENR, IFSUBM,NB_FR,FR_LOC(*),
64 . NFACNIT,LENC
65 my_real
66 . a(3,*),ar(3,*),stifn(*),stifr(*),ms(*),msnf(*),
67 . fthe(*),mcp(*),mcp_off(*),ms_2d(*),forneqs(3,*)
68 my_real , INTENT(INOUT) :: fcont(3,numnod),fncont(3,numnod),
69 . ftcont(3,numnod)
70 TYPE(H3D_DATABASE) :: H3D_DATA
71 TYPE(GLOB_THERM_) ,INTENT(IN) :: GLOB_THERM
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75#ifdef MPI
76 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,MSGOFF,
77 . SIZ,J,K,L,NB_NOD,
78 . STATUS(MPI_STATUS_SIZE),
79 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
80 . REQ_R(NSPMD),REQ_S(NSPMD),
81 . SHIFT
82 DATA msgoff/121/
83
84 my_real
85 . rbuf(size*lenr + nfacnit*lenr + lenc*lenr),
86 . sbuf(size*lenr + nfacnit*lenr + lenc*lenr)
87 my_real,
88 . DIMENSION (:,:),ALLOCATABLE :: sav_a
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92 ALLOCATE(sav_a(size+nfacnit+lenc,nb_fr))
93 shift=0
94
95 loc_proc = ispmd + 1
96 l = 1
97 iad_recv(1) = 1
98 DO i=1,nspmd
99 siz = (SIZE + nfacnit + lenc)*(iad_elem(1,i+1)-iad_elem(1,i))
100 IF(siz/=0)THEN
101 msgtyp = msgoff
102 CALL mpi_irecv(
103 s rbuf(l),siz,real,it_spmd(i),msgtyp,
104 g spmd_comm_world,req_r(i),ierror)
105 l = l + siz
106 ENDIF
107 iad_recv(i+1) = l
108 END DO
109 l = 1
110 iad_send(1) = 1
111
112 DO i=1,nspmd
113
114 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
115 nod = fr_elem(j)
116 sbuf(l) = a(1,nod)
117 sbuf(l+1) = a(2,nod)
118 sbuf(l+2) = a(3,nod)
119 sbuf(l+3) = stifn(nod)
120
121 shift = l+3
122
123 IF(iroddl/=0) THEN
124 sbuf(shift+1) = ar(1,nod)
125 sbuf(shift+2) = ar(2,nod)
126 sbuf(shift+3) = ar(3,nod)
127
128 sbuf(shift+4) = stifr(nod)
129 shift = shift+4
130 ENDIF
131
132 IF(n2d /=0) THEN
133 sbuf(shift+1) = ms(nod)
134 shift = shift+1
135 ENDIF
136
137 IF(n2d /=0.AND.ifsubm ==1) THEN
138 sbuf(shift+1) = ms_2d(nod)
139 shift = shift+1
140 ENDIF
141
142 IF(ifsubm ==1)THEN
143 sbuf(shift+1) = msnf(nod)
144 shift = shift+1
145 ENDIF
146
147 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
148 sbuf(shift+1) = fthe(nod)
149 shift = shift+1
150 IF(glob_therm%ITHERM_FE /= 0) THEN
151 sbuf(shift+1) = mcp(nod)
152 shift = shift+1
153 sbuf(shift+1) = mcp_off(nod)
154 shift = shift+1
155 ENDIF
156 ENDIF
157
158 IF(nitsche/=0) THEN
159 sbuf(shift+1) = forneqs(1,nod)
160 sbuf(shift+2) = forneqs(2,nod)
161 sbuf(shift+3) = forneqs(3,nod)
162 shift = shift+nfacnit
163 ENDIF
164
165C --- /CONT/MAX output
166 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
167 sbuf(shift+1) = fcont(1,nod)
168 sbuf(shift+2) = fcont(2,nod)
169 sbuf(shift+3) = fcont(3,nod)
170 shift = shift+3
171 ENDIF
172
173C --- /PCONT/MAX output
174 IF(anim_v(26)+h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
175 sbuf(shift+1) = fncont(1,nod)
176 sbuf(shift+2) = fncont(2,nod)
177 sbuf(shift+3) = fncont(3,nod)
178 sbuf(shift+4) = ftcont(1,nod)
179 sbuf(shift+5) = ftcont(2,nod)
180 sbuf(shift+6) = ftcont(3,nod)
181 shift = shift+6
182 ENDIF
183
184 l = l + SIZE + nfacnit +lenc
185 ENDDO
186
187 iad_send(i+1) = l
188 ENDDO
189C
190C echange messages
191C
192 DO i=1,nspmd
193C--------------------------------------------------------------------
194C envoi a N+I mod P
195C test si msg necessaire a envoyer a completer par test interface
196 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
197 msgtyp = msgoff
198 siz = iad_send(i+1)-iad_send(i)
199 l = iad_send(i)
200 CALL mpi_isend(
201 s sbuf(l),siz,real,it_spmd(i),msgtyp,
202 g spmd_comm_world,req_s(i),ierror)
203 ENDIF
204C--------------------------------------------------------------------
205 ENDDO
206
207C SAUVEGARGE VALEURS ACCEL
208 DO j=1,nb_fr
209 nod=fr_loc(j)
210
211 sav_a(1,j) = a(1,nod)
212 sav_a(2,j) = a(2,nod)
213 sav_a(3,j) = a(3,nod)
214 sav_a(4,j) = stifn(nod)
215
216 a(1,nod) = zero
217 a(2,nod) = zero
218 a(3,nod) = zero
219 stifn(nod) = zero
220
221 shift = 4
222
223 IF(iroddl/=0) THEN
224 sav_a(shift+1,j) = ar(1,nod)
225 sav_a(shift+2,j) = ar(2,nod)
226 sav_a(shift+3,j) = ar(3,nod)
227 sav_a(shift+4,j) = stifr(nod)
228
229 ar(1,nod) = zero
230 ar(2,nod) = zero
231 ar(3,nod) = zero
232 stifr(nod) = zero
233 shift = shift+4
234 ENDIF
235
236 IF(n2d /=0) THEN
237 sav_a(shift+1,j) = ms(nod)
238 ms(nod) = zero
239 shift = shift+1
240 ENDIF
241
242 IF(n2d /=0.AND.ifsubm ==1) THEN
243 sav_a(shift+1,j) = ms_2d(nod)
244 ms_2d(nod) = zero
245 shift = shift+1
246 ENDIF
247
248 IF(ifsubm ==1)THEN
249 sav_a(shift+1,j) = msnf(nod)
250 msnf(nod) = zero
251 shift = shift+1
252 ENDIF
253
254 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
255 sav_a(shift+1,j) = fthe(nod)
256 fthe(nod) = zero
257 shift = shift+1
258 IF(glob_therm%ITHERM_FE /= 0 ) THEN
259 sav_a(shift+1,j) = mcp(nod)
260 mcp(nod) = zero
261 shift = shift+1
262 sav_a(shift+1,j) = mcp_off(nod)
263 mcp_off(nod) = zero
264 shift = shift+1
265 ENDIF
266 ENDIF
267
268 IF(nitsche/=0) THEN
269 sav_a(shift+1,j) = forneqs(1,nod)
270 sav_a(shift+2,j) = forneqs(2,nod)
271 sav_a(shift+3,j) = forneqs(3,nod)
272
273 forneqs(1,nod) = zero
274 forneqs(2,nod) = zero
275 forneqs(3,nod) = zero
276
277 shift = shift+nfacnit
278 ENDIF
279
280 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
281 sav_a(shift+1,j) = fcont(1,nod)
282 sav_a(shift+2,j) = fcont(2,nod)
283 sav_a(shift+3,j) = fcont(3,nod)
284
285 fcont(1,nod) = zero
286 fcont(2,nod) = zero
287 fcont(3,nod) = zero
288
289 shift = shift+3
290 ENDIF
291
292 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
293 sav_a(shift+1,j) = fncont(1,nod)
294 sav_a(shift+2,j) = fncont(2,nod)
295 sav_a(shift+3,j) = fncont(3,nod)
296 sav_a(shift+4,j) = ftcont(1,nod)
297 sav_a(shift+5,j) = ftcont(2,nod)
298 sav_a(shift+6,j) = ftcont(3,nod)
299
300 fncont(1,nod) = zero
301 fncont(2,nod) = zero
302 fncont(3,nod) = zero
303
304 shift = shift+6
305 ENDIF
306
307 ENDDO
308
309
310
311C
312C decompactage
313C
314 DO i = 1, nspmd
315 IF(i/=loc_proc)THEN
316C test si msg necessaire a envoyer a completer par test interface
317 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
318 IF(nb_nod>0)THEN
319 CALL mpi_wait(req_r(i),status,ierror)
320
321 l = iad_recv(i)
322 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
323 nod = fr_elem(j)
324 a(1,nod) = a(1,nod) + rbuf(l)
325 a(2,nod) = a(2,nod) + rbuf(l+1)
326 a(3,nod) = a(3,nod) + rbuf(l+2)
327 stifn(nod)= stifn(nod)+ rbuf(l+3)
328
329 shift = l+3
330
331 IF(iroddl/=0) THEN
332 ar(1,nod)= ar(1,nod)+ rbuf(shift+1)
333 ar(2,nod)= ar(2,nod)+ rbuf(shift+2)
334 ar(3,nod)= ar(3,nod)+ rbuf(shift+3)
335 stifr(nod)= stifr(nod)+ rbuf(shift+4)
336 shift = shift+4
337 ENDIF
338
339 IF(n2d /=0) THEN
340 ms(nod) = ms(nod)+ rbuf(shift+1)
341 shift = shift+1
342 ENDIF
343
344 IF(n2d /=0.AND.ifsubm ==1) THEN
345 ms_2d(nod) = ms_2d(nod)+ rbuf(shift+1)
346 shift = shift+1
347 ENDIF
348
349 IF(ifsubm ==1)THEN
350 msnf(nod) = msnf(nod) + rbuf(shift+1)
351 shift = shift+1
352 ENDIF
353
354 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
355 fthe(nod) = fthe(nod) + rbuf(shift+1)
356 shift = shift+1
357 IF(glob_therm%ITHERM_FE /= 0) THEN
358 mcp(nod) = mcp(nod) + rbuf(shift+1)
359 shift = shift+1
360 mcp_off(nod) =max(mcp_off(nod),rbuf(shift+1))
361 shift = shift+1
362 ENDIF
363 ENDIF
364
365 IF(nitsche/=0) THEN
366 forneqs(1,nod)= forneqs(1,nod)+ rbuf(shift+1)
367 forneqs(2,nod)= forneqs(2,nod)+ rbuf(shift+2)
368 forneqs(3,nod)= forneqs(3,nod)+ rbuf(shift+3)
369 shift = shift+nfacnit
370 ENDIF
371
372 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
373 fcont(1,nod)= fcont(1,nod)+ rbuf(shift+1)
374 fcont(2,nod)= fcont(2,nod)+ rbuf(shift+2)
375 fcont(3,nod)= fcont(3,nod)+ rbuf(shift+3)
376 shift = shift+3
377 ENDIF
378
379 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
380 fncont(1,nod)= fncont(1,nod)+ rbuf(shift+1)
381 fncont(2,nod)= fncont(2,nod)+ rbuf(shift+2)
382 fncont(3,nod)= fncont(3,nod)+ rbuf(shift+3)
383 ftcont(1,nod)= ftcont(1,nod)+ rbuf(shift+4)
384 ftcont(2,nod)= ftcont(2,nod)+ rbuf(shift+5)
385 ftcont(3,nod)= ftcont(3,nod)+ rbuf(shift+6)
386 shift = shift+6
387 ENDIF
388
389 l = l + SIZE +nfacnit +lenc
390 END DO
391 ENDIF
392 ELSE
393
394 DO j=1,nb_fr
395 nod=fr_loc(j)
396 a(1,nod) = a(1,nod) + sav_a(1,j)
397 a(2,nod) = a(2,nod) + sav_a(2,j)
398 a(3,nod) = a(3,nod) + sav_a(3,j)
399 stifn(nod)= stifn(nod)+ sav_a(4,j)
400 shift = 4
401
402 IF(iroddl/=0) THEN
403 ar(1,nod) = ar(1,nod) + sav_a(shift+1,j)
404 ar(2,nod) = ar(2,nod) + sav_a(shift+2,j)
405 ar(3,nod) = ar(3,nod) + sav_a(shift+3,j)
406 stifr(nod)= stifr(nod)+ sav_a(shift+4,j)
407 shift = shift+4
408 ENDIF
409
410 IF(n2d /=0) THEN
411 ms(nod) = ms(nod) + sav_a(shift+1,j)
412 shift = shift+1
413 ENDIF
414
415 IF(n2d /=0.AND.ifsubm ==1) THEN
416 ms_2d(nod) = ms_2d(nod) + sav_a(shift+1,j)
417 shift = shift+1
418 ENDIF
419
420 IF(ifsubm ==1)THEN
421 msnf(nod) = msnf(nod) + sav_a(shift+1,j)
422 shift = shift+1
423 ENDIF
424
425 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
426 fthe(nod) = fthe(nod) + sav_a(shift+1,j)
427 shift = shift+1
428 IF(glob_therm%ITHERM_FE /= 0) THEN
429 mcp(nod) = mcp(nod) + sav_a(shift+1,j)
430 shift = shift+1
431 mcp_off(nod) = max(mcp_off(nod),sav_a(shift+1,j))
432 shift = shift+1
433 ENDIF
434 ENDIF
435
436 IF(nitsche/=0) THEN
437 forneqs(1,nod) = forneqs(1,nod) + sav_a(shift+1,j)
438 forneqs(2,nod) = forneqs(2,nod) + sav_a(shift+2,j)
439 forneqs(3,nod) = forneqs(3,nod) + sav_a(shift+3,j)
440 shift = shift+nfacnit
441 ENDIF
442
443C --- /CONT/MAX output
444 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
445 fcont(1,nod) = fcont(1,nod) + sav_a(shift+1,j)
446 fcont(2,nod) = fcont(2,nod) + sav_a(shift+2,j)
447 fcont(3,nod) = fcont(3,nod) + sav_a(shift+3,j)
448 shift = shift+3
449 ENDIF
450
451 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
452 fncont(1,nod)= fncont(1,nod)+ sav_a(shift+1,j)
453 fncont(2,nod)= fncont(2,nod)+ sav_a(shift+2,j)
454 fncont(3,nod)= fncont(3,nod)+ sav_a(shift+3,j)
455 ftcont(1,nod)= ftcont(1,nod)+ sav_a(shift+4,j)
456 ftcont(2,nod)= ftcont(2,nod)+ sav_a(shift+5,j)
457 ftcont(3,nod)= ftcont(3,nod)+ sav_a(shift+6,j)
458 shift = shift+6
459 ENDIF
460
461 END DO
462 ENDIF
463 END DO
464C
465C wait terminaison isend
466C
467 DO i = 1, nspmd
468 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
469 CALL mpi_wait(req_s(i),status,ierror)
470 ENDIF
471 ENDDO
472 DEALLOCATE(sav_a)
473C
474#endif
475 RETURN
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
h3d_mod
Definition h3d_mod.F:308