OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a.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_a ../engine/source/mpi/forces/spmd_exch_a.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
30!|| h3d_mod ../engine/share/modules/h3d_mod.F
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_exch_a(
34 1 A, ADP ,AR ,STIFN,STIFR ,MS ,
35 2 IAD_ELEM ,FR_ELEM,MSNF ,IFSUBM,SIZE,
36 3 LENR ,FTHE ,MCP ,DMSPH ,CONDN,
37 4 MS_2D,MCP_OFF,
38 5 FORNEQS ,NFACNIT,LENC ,FCONT ,H3D_DATA ,
39 6 FNCONT ,FTCONT, GLOB_THERM)
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 "sphcom.inc"
58#include "task_c.inc"
59#include "scr18_c.inc"
60#include "scr05_c.inc"
61#include "scr14_c.inc"
62#include "intstamp_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER IAD_ELEM(2,*),FR_ELEM(*), SIZE, LENR, IFSUBM,
67 . NFACNIT,LENC
68 my_real
69 . AR(3,*),STIFN(*),STIFR(*),MS(*),MSNF(*),
70 . FTHE(*),MCP(*), DMSPH(*),CONDN(*)
71 my_real, DIMENSION(3,*), INTENT(inout), TARGET :: A
72 REAL(kind=8), dimension(3,*), INTENT(inout), TARGET :: adp
73
74 my_real
75 . ms_2d(*),mcp_off(*),
76 . forneqs(3,*)
77 my_real , INTENT(INOUT) :: fcont(3,numnod),fncont(3,numnod),
78 . ftcont(3,numnod)
79 TYPE(h3d_database) :: h3d_data
80 TYPE(glob_therm_) ,INTENT(IN) :: GLOB_THERM
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84#ifdef MPI
85 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,MSGOFF,
86 . siz,j,k,l,nb_nod,iadmsph,
87 . status(mpi_status_size),
88 . iad_send(nspmd+1),iad_recv(nspmd+1),
89 . req_r(nspmd),req_s(nspmd)
90 DATA msgoff/120/
91
92 REAL(kind=8)
93 . rbuf(size*lenr + nfacnit*lenr + lenc*lenr),
94 . sbuf(size*lenr + nfacnit*lenr + lenc*lenr)
95 REAL(kind=8), dimension(:,:), POINTER :: acc_pointer
96C-----------------------------------------------
97C S o u r c e L i n e s
98C-----------------------------------------------
99#ifdef MYREAL4
100 acc_pointer=>adp(1:3,1:numnod)
101#else
102 acc_pointer=>a(1:3,1:numnod)
103#endif
104 loc_proc = ispmd + 1
105 l = 1
106 iad_recv(1) = 1
107 DO i=1,nspmd
108 siz = (size+nfacnit+lenc)*(iad_elem(1,i+1)-iad_elem(1,i))
109 IF(siz/=0)THEN
110 msgtyp = msgoff
111 CALL mpi_irecv(
112 s rbuf(l),siz,mpi_double_precision,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
118C
119 IF(sol2sph_flag/=0)THEN
120 iadmsph=5
121 IF(iroddl/=0)iadmsph=iadmsph+4
122 IF(glob_therm%INTHEAT /= 0 .OR. glob_therm%ITHERM_FE /= 0) iadmsph=iadmsph+1
123 l = 1
124 DO i=1,nspmd
125C preparation envoi partie fixe (elem) a proc I
126#include "vectorize.inc"
127 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
128 nod = fr_elem(j)
129 sbuf(l + iadmsph - 1) = dmsph(nod)
130 l = l + SIZE
131 END DO
132 END DO
133 END IF
134C
135 IF(iresp==1) THEN
136 DO i = 1, nspmd
137 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
138 nod = fr_elem(j)
139 acc_pointer(1,nod) = a(1,nod)
140 acc_pointer(2,nod) = a(2,nod)
141 acc_pointer(3,nod) = a(3,nod)
142 ENDDO
143 ENDDO
144 ENDIF
145
146
147 l = 1
148 iad_send(1) = 1
149 DO i=1,nspmd
150C preparation envoi partie fixe (elem) a proc I
151 IF(glob_therm%INTHEAT == 0 .AND. glob_therm%ITHERM_FE == 0 )THEN
152 IF (n2d==0.AND.ifsubm==0) THEN
153 IF(iroddl/=0) THEN
154#include "vectorize.inc"
155 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
156 nod = fr_elem(j)
157 sbuf(l ) = acc_pointer(1,nod)
158 sbuf(l+1) = acc_pointer(2,nod)
159 sbuf(l+2) = acc_pointer(3,nod)
160 sbuf(l+3) = ar(1,nod)
161 sbuf(l+4) = ar(2,nod)
162 sbuf(l+5) = ar(3,nod)
163 sbuf(l+6) = stifn(nod)
164 sbuf(l+7) = stifr(nod)
165 l = l + SIZE
166 END DO
167 ELSE
168#include "vectorize.inc"
169 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
170 nod = fr_elem(j)
171 sbuf(l ) = acc_pointer(1,nod)
172 sbuf(l+1) = acc_pointer(2,nod)
173 sbuf(l+2) = acc_pointer(3,nod)
174 sbuf(l+3) = stifn(nod)
175 l = l + SIZE
176 END DO
177 ENDIF
178C cas 2D la masse est recalculee a chaque cycle, il faut la cumuler
179 ELSEIF(n2d/=0.AND.ifsubm==1)THEN
180 IF(iroddl/=0) THEN
181#include "vectorize.inc"
182 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
183 nod = fr_elem(j)
184 sbuf(l ) = acc_pointer(1,nod)
185 sbuf(l+1) = acc_pointer(2,nod)
186 sbuf(l+2) = acc_pointer(3,nod)
187 sbuf(l+3) = ar(1,nod)
188 sbuf(l+4) = ar(2,nod)
189 sbuf(l+5) = ar(3,nod)
190 sbuf(l+6) = stifn(nod)
191 sbuf(l+7) = stifr(nod)
192 sbuf(l+8) = ms(nod)
193 sbuf(l+9) = ms_2d(nod)
194 l = l + SIZE
195 END DO
196 ELSE
197#include "vectorize.inc"
198 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
199 nod = fr_elem(j)
200 sbuf(l ) = acc_pointer(1,nod)
201 sbuf(l+1) = acc_pointer(2,nod)
202 sbuf(l+2) = acc_pointer(3,nod)
203 sbuf(l+3) = stifn(nod)
204 sbuf(l+4) = ms(nod)
205 sbuf(l+5) = ms_2d(nod)
206 l = l + SIZE
207 END DO
208 ENDIF
209 ELSEIF(n2d/=0.AND.ifsubm==0)THEN
210 IF(iroddl/=0) THEN
211#include "vectorize.inc"
212 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
213 nod = fr_elem(j)
214 sbuf(l ) = acc_pointer(1,nod)
215 sbuf(l+1) = acc_pointer(2,nod)
216 sbuf(l+2) = acc_pointer(3,nod)
217 sbuf(l+3) = ar(1,nod)
218 sbuf(l+4) = ar(2,nod)
219 sbuf(l+5) = ar(3,nod)
220 sbuf(l+6) = stifn(nod)
221 sbuf(l+7) = stifr(nod)
222 sbuf(l+8) = ms(nod)
223 l = l + SIZE
224 END DO
225 ELSE
226#include "vectorize.inc"
227 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
228 nod = fr_elem(j)
229 sbuf(l ) = acc_pointer(1,nod)
230 sbuf(l+1) = acc_pointer(2,nod)
231 sbuf(l+2) = acc_pointer(3,nod)
232 sbuf(l+3) = stifn(nod)
233 sbuf(l+4) = ms(nod)
234 l = l + SIZE
235 END DO
236 ENDIF
237
238 ELSEIF(n2d==0.AND.ifsubm==1)THEN
239 IF(iroddl/=0) THEN
240#include "vectorize.inc"
241 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
242 nod = fr_elem(j)
243 sbuf(l ) = acc_pointer(1,nod)
244 sbuf(l+1) = acc_pointer(2,nod)
245 sbuf(l+2) = acc_pointer(3,nod)
246 sbuf(l+3) = ar(1,nod)
247 sbuf(l+4) = ar(2,nod)
248 sbuf(l+5) = ar(3,nod)
249 sbuf(l+6) = stifn(nod)
250 sbuf(l+7) = stifr(nod)
251 sbuf(l+8) = ms(nod)
252 sbuf(l+9) = msnf(nod)
253 l = l + SIZE
254 END DO
255 ELSE
256#include "vectorize.inc"
257 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
258 nod = fr_elem(j)
259 sbuf(l ) = acc_pointer(1,nod)
260 sbuf(l+1) = acc_pointer(2,nod)
261 sbuf(l+2) = acc_pointer(3,nod)
262 sbuf(l+3) = stifn(nod)
263 sbuf(l+4) = ms(nod)
264 sbuf(l+5) = msnf(nod)
265 l = l + SIZE
266 END DO
267 ENDIF
268 ENDIF
269C
270C -- plus la thermique
271C
272 ELSE
273 IF (n2d==0.AND.ifsubm==0) THEN
274 IF(iroddl/=0) THEN
275#include "vectorize.inc"
276 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
277 nod = fr_elem(j)
278 sbuf(l ) = acc_pointer(1,nod)
279 sbuf(l+1) = acc_pointer(2,nod)
280 sbuf(l+2) = acc_pointer(3,nod)
281 sbuf(l+3) = ar(1,nod)
282 sbuf(l+4) = ar(2,nod)
283 sbuf(l+5) = ar(3,nod)
284 sbuf(l+6) = stifn(nod)
285 sbuf(l+7) = stifr(nod)
286 sbuf(l+8) = fthe(nod)
287 IF(glob_therm%ITHERM_FE == 1) sbuf(l+9) = mcp(nod)
288 IF(glob_therm%ITHERM_FE == 1) sbuf(l+10) = mcp_off(nod)
289 l = l + SIZE
290 END DO
291 ELSE
292 IF(glob_therm%NODADT_THERM ==1 )THEN
293#include "vectorize.inc"
294 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
295 nod = fr_elem(j)
296 sbuf(l ) = acc_pointer(1,nod)
297 sbuf(l+1) = acc_pointer(2,nod)
298 sbuf(l+2) = acc_pointer(3,nod)
299 sbuf(l+3) = stifn(nod)
300 sbuf(l+4) = fthe(nod)
301 sbuf(l+5) = condn(nod)
302 IF(glob_therm%ITHERM_FE == 1) sbuf(l+6) = mcp(nod)
303 IF(glob_therm%ITHERM_FE == 1) sbuf(l+7) = mcp_off(nod)
304 l = l + SIZE
305 END DO
306 ELSE
307#include "vectorize.inc"
308 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
309 nod = fr_elem(j)
310 sbuf(l ) = acc_pointer(1,nod)
311 sbuf(l+1) = acc_pointer(2,nod)
312 sbuf(l+2) = acc_pointer(3,nod)
313 sbuf(l+3) = stifn(nod)
314 sbuf(l+4) = fthe(nod)
315 IF(glob_therm%ITHERM_FE == 1) sbuf(l+5) = mcp(nod)
316 IF(glob_therm%ITHERM_FE == 1) sbuf(l+6) = mcp_off(nod)
317 l = l + SIZE
318 END DO
319 ENDIF
320 ENDIF
321C cas 2D la masse est recalculee a chaque cycle, il faut la cumuler
322 ELSEIF(n2d/=0.AND.ifsubm==1)THEN
323 IF(iroddl/=0) THEN
324#include "vectorize.inc"
325 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
326 nod = fr_elem(j)
327 sbuf(l ) = acc_pointer(1,nod)
328 sbuf(l+1) = acc_pointer(2,nod)
329 sbuf(l+2) = acc_pointer(3,nod)
330 sbuf(l+3) = ar(1,nod)
331 sbuf(l+4) = ar(2,nod)
332 sbuf(l+5) = ar(3,nod)
333 sbuf(l+6) = stifn(nod)
334 sbuf(l+7) = stifr(nod)
335 sbuf(l+8) = ms(nod)
336 sbuf(l+9) = fthe(nod)
337 sbuf(l+10) = mcp(nod)
338 sbuf(l+11) = ms_2d(nod)
339 l = l + SIZE
340 END DO
341 ELSE
342#include "vectorize.inc"
343 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
344 nod = fr_elem(j)
345 sbuf(l ) = acc_pointer(1,nod)
346 sbuf(l+1) = acc_pointer(2,nod)
347 sbuf(l+2) = acc_pointer(3,nod)
348 sbuf(l+3) = stifn(nod)
349 sbuf(l+4) = ms(nod)
350 sbuf(l+5) = fthe(nod)
351 sbuf(l+6) = mcp(nod)
352 sbuf(l+7) = ms_2d(nod)
353 l = l + SIZE
354 END DO
355 ENDIF
356 ELSEIF(n2d/=0.AND.ifsubm==0)THEN
357 IF(iroddl/=0) THEN
358#include "vectorize.inc"
359 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
360 nod = fr_elem(j)
361 sbuf(l ) = acc_pointer(1,nod)
362 sbuf(l+1) = acc_pointer(2,nod)
363 sbuf(l+2) = acc_pointer(3,nod)
364 sbuf(l+3) = ar(1,nod)
365 sbuf(l+4) = ar(2,nod)
366 sbuf(l+5) = ar(3,nod)
367 sbuf(l+6) = stifn(nod)
368 sbuf(l+7) = stifr(nod)
369 sbuf(l+8) = ms(nod)
370 sbuf(l+9) = fthe(nod)
371 sbuf(l+10) = mcp(nod)
372 l = l + SIZE
373 END DO
374 ELSE
375#include "vectorize.inc"
376 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
377 nod = fr_elem(j)
378 sbuf(l ) = acc_pointer(1,nod)
379 sbuf(l+1) = acc_pointer(2,nod)
380 sbuf(l+2) = acc_pointer(3,nod)
381 sbuf(l+3) = stifn(nod)
382 sbuf(l+4) = ms(nod)
383 sbuf(l+5) = fthe(nod)
384 sbuf(l+6) = mcp(nod)
385 l = l + SIZE
386 END DO
387 ENDIF
388 ELSEIF(n2d==0.AND.ifsubm==1)THEN
389 IF(iroddl/=0) THEN
390#include "vectorize.inc"
391 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
392 nod = fr_elem(j)
393 sbuf(l ) = acc_pointer(1,nod)
394 sbuf(l+1) = acc_pointer(2,nod)
395 sbuf(l+2) = acc_pointer(3,nod)
396 sbuf(l+3) = ar(1,nod)
397 sbuf(l+4) = ar(2,nod)
398 sbuf(l+5) = ar(3,nod)
399 sbuf(l+6) = stifn(nod)
400 sbuf(l+7) = stifr(nod)
401 sbuf(l+8) = ms(nod)
402 sbuf(l+9) = msnf(nod)
403 sbuf(l+10) = fthe(nod)
404 sbuf(l+11) = mcp(nod)
405 l = l + SIZE
406 END DO
407 ELSE
408#include "vectorize.inc"
409 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
410 nod = fr_elem(j)
411 sbuf(l ) = acc_pointer(1,nod)
412 sbuf(l+1) = acc_pointer(2,nod)
413 sbuf(l+2) = acc_pointer(3,nod)
414 sbuf(l+3) = stifn(nod)
415 sbuf(l+4) = ms(nod)
416 sbuf(l+5) = msnf(nod)
417 sbuf(l+6) = fthe(nod)
418 sbuf(l+7) = mcp(nod)
419 l = l + SIZE
420 END DO
421 ENDIF
422 ENDIF
423 ENDIF
424
425c
426C
427C --- NITSCHE
428 IF(nitsche > 0) THEN
429#include "vectorize.inc"
430 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
431 nod = fr_elem(j)
432 sbuf(l ) = forneqs(1,nod)
433 sbuf(l+1) = forneqs(2,nod)
434 sbuf(l+2) = forneqs(3,nod)
435 l = l + nfacnit
436 END DO
437 ENDIF
438C --- /CONT/MAX output
439 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
440#include "vectorize.inc"
441 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
442 nod = fr_elem(j)
443 sbuf(l ) = fcont(1,nod)
444 sbuf(l+1) = fcont(2,nod)
445 sbuf(l+2) = fcont(3,nod)
446 l = l + 3
447 END DO
448 ENDIF
449C
450C --- /PCONT/MAX output
451 IF(h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
452#include "vectorize.inc"
453 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
454 nod = fr_elem(j)
455 sbuf(l ) = fncont(1,nod)
456 sbuf(l+1) = fncont(2,nod)
457 sbuf(l+2) = fncont(3,nod)
458 sbuf(l+3) = ftcont(1,nod)
459 sbuf(l+4) = ftcont(2,nod)
460 sbuf(l+5) = ftcont(3,nod)
461 l = l + 6
462 END DO
463 ENDIF
464C
465 iad_send(i+1) = l
466 ENDDO
467C
468C echange messages
469C
470 DO i=1,nspmd
471C--------------------------------------------------------------------
472C envoi a N+I mod P
473C test si msg necessaire a envoyer a completer par test interface
474 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
475 msgtyp = msgoff
476 siz = iad_send(i+1)-iad_send(i)
477 l = iad_send(i)
478 CALL mpi_isend(
479 s sbuf(l),siz,mpi_double_precision,it_spmd(i),msgtyp,
480 g spmd_comm_world,req_s(i),ierror)
481 ENDIF
482C--------------------------------------------------------------------
483 ENDDO
484C
485C decompactage
486C
487 IF(sol2sph_flag/=0)THEN
488 iadmsph=5
489 IF(iroddl/=0)iadmsph=iadmsph+4
490 IF (glob_therm%INTHEAT /= 0 .OR. glob_therm%ITHERM_FE /= 0) iadmsph=iadmsph+1
491 DO i = 1, nspmd
492 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
493 IF(nb_nod>0)THEN
494 CALL mpi_wait(req_r(i),status,ierror)
495 l = iad_recv(i)
496#include "vectorize.inc"
497 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
498 nod = fr_elem(j)
499 dmsph(nod) = dmsph(nod) + rbuf(l+iadmsph-1)
500 l = l + SIZE
501 END DO
502 END IF
503 END DO
504 END IF
505C
506 DO i = 1, nspmd
507C test si msg necessaire a envoyer a completer par test interface
508 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
509 IF(nb_nod>0)THEN
510 CALL mpi_wait(req_r(i),status,ierror)
511 l = iad_recv(i)
512C cas 3D
513 IF (glob_therm%ITHERM_FE == 0 .AND. glob_therm%INTHEAT == 0 ) THEN
514 IF (n2d==0.AND.ifsubm==0) THEN
515 IF(iroddl/=0) THEN
516#include "vectorize.inc"
517 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
518 nod = fr_elem(j)
519 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
520 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
521 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
522 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
523 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
524 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
525 stifn(nod)= stifn(nod)+ rbuf(l+6)
526 stifr(nod)= stifr(nod)+ rbuf(l+7)
527 l = l + SIZE
528 END DO
529 ELSE
530#include "vectorize.inc"
531 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
532 nod = fr_elem(j)
533 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
534 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
535 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
536 stifn(nod)= stifn(nod)+ rbuf(l+3)
537 l = l + SIZE
538 END DO
539 ENDIF
540C cas 2D
541 ELSEIF(n2d/=0.AND.ifsubm==1)THEN
542 IF(iroddl/=0) THEN
543#include "vectorize.inc"
544 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
545 nod = fr_elem(j)
546 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
547 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
548 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
549 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
550 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
551 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
552 stifn(nod)= stifn(nod)+ rbuf(l+6)
553 stifr(nod)= stifr(nod)+ rbuf(l+7)
554 ms(nod) = ms(nod)+ rbuf(l+8)
555 ms_2d(nod) = ms_2d(nod)+ rbuf(l+9)
556 l = l + SIZE
557 END DO
558 ELSE
559#include "vectorize.inc"
560 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
561 nod = fr_elem(j)
562 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
563 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
564 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
565 stifn(nod)= stifn(nod)+ rbuf(l+3)
566 ms(nod) = ms(nod)+ rbuf(l+4)
567 ms_2d(nod) = ms_2d(nod)+ rbuf(l+5)
568 l = l + SIZE
569 END DO
570 ENDIF
571 ELSEIF(n2d/=0.AND.ifsubm==0)THEN
572 IF(iroddl/=0) THEN
573#include "vectorize.inc"
574 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
575 nod = fr_elem(j)
576 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
577 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
578 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
579 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
580 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
581 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
582 stifn(nod)= stifn(nod)+ rbuf(l+6)
583 stifr(nod)= stifr(nod)+ rbuf(l+7)
584 ms(nod) = ms(nod)+ rbuf(l+8)
585 l = l + SIZE
586 END DO
587 ELSE
588#include "vectorize.inc"
589 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
590 nod = fr_elem(j)
591 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
592 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
593 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
594 stifn(nod)= stifn(nod)+ rbuf(l+3)
595 ms(nod) = ms(nod)+ rbuf(l+4)
596 l = l + SIZE
597 END DO
598 ENDIF
599 ELSEIF(n2d==0.AND.ifsubm==1)THEN
600 IF(iroddl/=0) THEN
601#include "vectorize.inc"
602 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
603 nod = fr_elem(j)
604 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
605 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
606 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
607 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
608 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
609 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
610 stifn(nod)= stifn(nod)+ rbuf(l+6)
611 stifr(nod)= stifr(nod)+ rbuf(l+7)
612 ms(nod) = ms(nod)+ rbuf(l+8)
613 msnf(nod) = msnf(nod) + rbuf(l+9)
614 l = l + SIZE
615 END DO
616 ELSE
617#include "vectorize.inc"
618 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
619 nod = fr_elem(j)
620 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
621 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
622 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
623 stifn(nod)= stifn(nod)+ rbuf(l+3)
624 ms(nod) = ms(nod)+ rbuf(l+4)
625 msnf(nod) = msnf(nod) + rbuf(l+5)
626 l = l + SIZE
627 END DO
628 ENDIF
629 ENDIF
630C
631C ----plus la thermique
632C
633 ELSE
634 IF (n2d==0.AND.ifsubm==0) THEN
635 IF(iroddl/=0) THEN
636#include "vectorize.inc"
637 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
638 nod = fr_elem(j)
639 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
640 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
641 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
642 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
643 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
644 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
645 stifn(nod)= stifn(nod)+ rbuf(l+6)
646 stifr(nod)= stifr(nod)+ rbuf(l+7)
647 fthe(nod) = fthe(nod) + rbuf(l+8)
648 IF(glob_therm%ITHERM_FE == 1) mcp(nod) = mcp(nod) + rbuf(l+9)
649 IF(glob_therm%ITHERM_FE == 1) mcp_off(nod) = max(mcp_off(nod),rbuf(l+10))
650 l = l + SIZE
651 END DO
652 ELSE
653 IF(glob_therm%NODADT_THERM == 1) THEN
654#include "vectorize.inc"
655 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
656 nod = fr_elem(j)
657 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
658 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
659 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
660 stifn(nod)= stifn(nod)+ rbuf(l+3)
661 fthe(nod) = fthe(nod) + rbuf(l+4)
662 condn(nod) = condn(nod) + rbuf(l+5)
663 IF(glob_therm%ITHERM_FE == 1) mcp(nod) = mcp(nod) + rbuf(l+6)
664 IF(glob_therm%ITHERM_FE == 1) mcp_off(nod) =max(mcp_off(nod),rbuf(l+7))
665 l = l + SIZE
666 END DO
667 ELSE
668#include "vectorize.inc"
669 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
670 nod = fr_elem(j)
671 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
672 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
673 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
674 stifn(nod)= stifn(nod)+ rbuf(l+3)
675 fthe(nod) = fthe(nod) + rbuf(l+4)
676 IF(glob_therm%ITHERM_FE == 1) mcp(nod) = mcp(nod) + rbuf(l+5)
677 IF(glob_therm%ITHERM_FE == 1) mcp_off(nod) =max(mcp_off(nod),rbuf(l+6))
678 l = l + SIZE
679 END DO
680 ENDIF
681 ENDIF
682C cas 2D
683 ELSEIF(n2d/=0.AND.ifsubm==1)THEN
684 IF(iroddl/=0) THEN
685#include "vectorize.inc"
686 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
687 nod = fr_elem(j)
688 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
689 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
690 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
691 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
692 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
693 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
694 stifn(nod)= stifn(nod)+ rbuf(l+6)
695 stifr(nod)= stifr(nod)+ rbuf(l+7)
696 ms(nod) = ms(nod)+ rbuf(l+8)
697 fthe(nod) = fthe(nod) + rbuf(l+9)
698 mcp(nod) = mcp(nod) + rbuf(l+10)
699 ms_2d(nod) = ms_2d(nod)+ rbuf(l+11)
700 l = l + SIZE
701 END DO
702 ELSE
703#include "vectorize.inc"
704 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
705 nod = fr_elem(j)
706 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
707 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
708 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
709 stifn(nod)= stifn(nod)+ rbuf(l+3)
710 ms(nod) = ms(nod)+ rbuf(l+4)
711 fthe(nod) = fthe(nod) + rbuf(l+5)
712 mcp(nod) = mcp(nod) + rbuf(l+6)
713 ms_2d(nod) = ms_2d(nod)+ rbuf(l+7)
714 l = l + SIZE
715 END DO
716 ENDIF
717 ELSEIF(n2d/=0.AND.ifsubm==0)THEN
718 IF(iroddl/=0) THEN
719#include "vectorize.inc"
720 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
721 nod = fr_elem(j)
722 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
723 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
724 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
725 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
726 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
727 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
728 stifn(nod)= stifn(nod)+ rbuf(l+6)
729 stifr(nod)= stifr(nod)+ rbuf(l+7)
730 ms(nod) = ms(nod)+ rbuf(l+8)
731 fthe(nod) = fthe(nod) + rbuf(l+9)
732 mcp(nod) = mcp(nod) + rbuf(l+10)
733 l = l + SIZE
734 END DO
735 ELSE
736#include "vectorize.inc"
737 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
738 nod = fr_elem(j)
739 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
740 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
741 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
742 stifn(nod)= stifn(nod)+ rbuf(l+3)
743 ms(nod) = ms(nod)+ rbuf(l+4)
744 fthe(nod) = fthe(nod) + rbuf(l+5)
745 mcp(nod) = mcp(nod) + rbuf(l+6)
746 l = l + SIZE
747 END DO
748 ENDIF
749 ELSEIF(n2d==0.AND.ifsubm==1)THEN
750 IF(iroddl/=0) THEN
751#include "vectorize.inc"
752 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
753 nod = fr_elem(j)
754 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
755 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
756 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
757 ar(1,nod)= ar(1,nod)+ rbuf(l+3)
758 ar(2,nod)= ar(2,nod)+ rbuf(l+4)
759 ar(3,nod)= ar(3,nod)+ rbuf(l+5)
760 stifn(nod)= stifn(nod)+ rbuf(l+6)
761 stifr(nod)= stifr(nod)+ rbuf(l+7)
762 ms(nod) = ms(nod)+ rbuf(l+8)
763 msnf(nod) = msnf(nod) + rbuf(l+9)
764 fthe(nod) = fthe(nod) + rbuf(l+10)
765 mcp(nod) = mcp(nod) + rbuf(l+11)
766 l = l + SIZE
767 END DO
768 ELSE
769#include "vectorize.inc"
770 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
771 nod = fr_elem(j)
772 acc_pointer(1,nod) = acc_pointer(1,nod) + rbuf(l)
773 acc_pointer(2,nod) = acc_pointer(2,nod) + rbuf(l+1)
774 acc_pointer(3,nod) = acc_pointer(3,nod) + rbuf(l+2)
775 stifn(nod)= stifn(nod)+ rbuf(l+3)
776 ms(nod) = ms(nod)+ rbuf(l+4)
777 msnf(nod) = msnf(nod) + rbuf(l+5)
778 fthe(nod) = fthe(nod) + rbuf(l+6)
779 mcp(nod) = mcp(nod) + rbuf(l+7)
780 l = l + SIZE
781 END DO
782 ENDIF
783 ENDIF
784 ENDIF
785C
786 ENDIF
787cc IF(IPLYXFEM > 0) THEN
788cc#include "vectorize.inc"
789cc DO J=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
790cc NOD = FR_ELEM(J)
791cc NOD_PXFEM = INOD_PXFEM(NOD)
792cc IF(NOD_PXFEM > 0) THEN
793cc DO J = 1,NPLYMAX
794cc PLY(J)%ACC_POINTER(1,NOD_PXFEM)=PLY(J)%ACC_POINTER(1,NOD_PXFEM) + RBUF(L)
795cc PLY(J)%ACC_POINTER(2,NOD_PXFEM)=PLY(J)%ACC_POINTER(2,NOD_PXFEM) + RBUF(L+1)
796cc PLY(J)%ACC_POINTER(3,NOD_PXFEM)=PLY(J)%ACC_POINTER(3,NOD_PXFEM) + RBUF(L+2)
797cc PLY(J)%A(4,NOD_PXFEM)=PLY(J)%A(4,NOD_PXFEM) + RBUF(L+3)
798cc L = L + 4
799cc END DO
800cc ENDDO
801cc ENDIF
802C
803C --- NITSCHE
804 IF(nitsche > 0) THEN
805#include "vectorize.inc"
806 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
807 nod = fr_elem(j)
808 forneqs(1,nod) = forneqs(1,nod) + rbuf(l)
809 forneqs(2,nod) = forneqs(2,nod) + rbuf(l+1)
810 forneqs(3,nod) = forneqs(3,nod) + rbuf(l+2)
811 l = l + nfacnit
812 END DO
813 ENDIF
814C --- /CONT/MAX output
815 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
816#include "vectorize.inc"
817 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
818 nod = fr_elem(j)
819 fcont(1,nod) = fcont(1,nod) + rbuf(l)
820 fcont(2,nod) = fcont(2,nod) + rbuf(l+1)
821 fcont(3,nod) = fcont(3,nod) + rbuf(l+2)
822 l = l + 3
823 END DO
824 ENDIF
825C
826C --- /PCONT/MAX output
827 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
828#include "vectorize.inc"
829 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
830 nod = fr_elem(j)
831 fncont(1,nod) = fncont(1,nod) + rbuf(l)
832 fncont(2,nod) = fncont(2,nod) + rbuf(l+1)
833 fncont(3,nod) = fncont(3,nod) + rbuf(l+2)
834 ftcont(1,nod) = ftcont(1,nod) + rbuf(l+3)
835 ftcont(2,nod) = ftcont(2,nod) + rbuf(l+4)
836 ftcont(3,nod) = ftcont(3,nod) + rbuf(l+5)
837 l = l + 6
838 END DO
839 ENDIF
840C
841C
842C
843
844 END DO
845C
846C wait terminaison isend
847C
848 IF(iresp==1) THEN
849 DO i = 1, nspmd
850 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
851 IF(nb_nod>0)THEN
852 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
853 nod = fr_elem(j)
854 a(1,nod) = acc_pointer(1,nod)
855 a(2,nod) = acc_pointer(2,nod)
856 a(3,nod) = acc_pointer(3,nod)
857 ENDDO
858 ENDIF
859 ENDDO
860 ENDIF
861
862 DO i = 1, nspmd
863 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
864 CALL mpi_wait(req_s(i),status,ierror)
865 ENDIF
866 ENDDO
867C
868#endif
869 RETURN
870 END
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
spmd_exch_a
subroutine spmd_exch_a(a, adp, ar, stifn, stifr, ms, iad_elem, fr_elem, msnf, ifsubm, size, lenr, fthe, mcp, dmsph, condn, ms_2d, mcp_off, forneqs, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)
Definition spmd_exch_a.F:40
h3d_mod::h3d_database
Definition h3d_mod.F:435