OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_int2_ams.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/.
23C
24!||====================================================================
25!|| spmd_exch_a_int2_ams ../engine/source/mpi/forces/spmd_exch_a_int2_ams.F
26!||--- called by ------------------------------------------------------
27!|| intti1 ../engine/source/interfaces/interf/intti1.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
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_int2_ams(
34 1 A ,AR ,MS ,IN ,STIFN,
35 2 STIFR,FR_I2M,IAD_I2M,LCOMI2M,ISIZE,
36 3 NB_FRI2M,FR_LOCI2M,INTTH2,FTHE,CONDN,
37 4 FNCONT ,FNCONTP,FTCONTP,H3D_DATA,IDT_THERM)
38C-----------------------------------------------
39 USE h3d_mod
40C-----------------------------------------------
41C realise le cumul des acc et masses aux noeuds main d'int2
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45 USE spmd_comm_world_mod, ONLY : spmd_comm_world
46#include "implicit_f.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 "com01_c.inc"
55#include "com04_c.inc"
56#include "task_c.inc"
57#include "scr18_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER LCOMI2M, ISIZE, NB_FRI2M,INTTH2,
62 . FR_I2M(*), IAD_I2M(*),FR_LOCI2M(*)
63 INTEGER ,INTENT(IN) :: IDT_THERM
64 my_real
65 . a(3,*), ar(3,*), ms(*), in(*),
66 . stifn(*), stifr(*),fthe(*),condn(*)
67 my_real , INTENT(INOUT) :: fncont(3,numnod),
68 . fncontp(3,numnod),ftcontp(3,numnod)
69 TYPE(h3d_database) :: H3D_DATA
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73#ifdef MPI
74 INTEGER MSGTYP,LOC_PROC,NOD,I,J,L,IDEB,IAD,LEN,P,
75 . NBINDEX,INDEX,MSGOFF,SIZ,IERROR,ISIZE2,LENSAV,
76 . STATUS(MPI_STATUS_SIZE),
77 . REQ_S(NSPMD),REQ_R(NSPMD),INDEXI(NSPMD)
78 DATA msgoff/118/
79 my_real,
80 . DIMENSION(:,:),ALLOCATABLE :: sav_acc
81 my_real,
82 . DIMENSION (:),ALLOCATABLE :: sbuf,rbuf
83C-----------------------------------------------
84C S o u r c e L i n e s
85C-----------------------------------------------
86 isize2=isize
87 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
88 isize2 = isize + 3
89 ENDIF
90 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
91 isize2 = isize2 + 6
92 ENDIF
93 ALLOCATE(sbuf(lcomi2m*isize2))
94 ALLOCATE(rbuf(lcomi2m*isize2))
95 ALLOCATE (sav_acc(isize2,nb_fri2m))
96C
97 loc_proc = ispmd + 1
98C
99 ideb = 1
100 l = 0
101 DO i = 1, nspmd
102 len = iad_i2m(i+1)-iad_i2m(i)
103 IF(len>0) THEN
104 siz = len*isize2
105 l=l+1
106 indexi(l)=i
107 msgtyp = msgoff
108 CALL mpi_irecv(
109 s rbuf(ideb),siz,real,it_spmd(i),msgtyp,
110 g spmd_comm_world,req_r(l),ierror)
111 ideb = ideb + siz
112 ENDIF
113 ENDDO
114 nbindex = l
115C
116 ideb = 1
117 DO l = 1, nbindex
118 i = indexi(l)
119 len = iad_i2m(i+1) - iad_i2m(i)
120 iad = iad_i2m(i)-1
121 IF (intth2 == 1) THEN
122 IF(idt_therm == 1) THEN
123 IF (iroddl==0) THEN
124#include "vectorize.inc"
125 DO j = 1, len
126 nod = fr_i2m(iad+j)
127 sbuf(ideb) = a(1,nod)
128 sbuf(ideb+1) = a(2,nod)
129 sbuf(ideb+2) = a(3,nod)
130 sbuf(ideb+3) = ms(nod)
131 sbuf(ideb+4) = stifn(nod)
132 sbuf(ideb+5) = fthe(nod)
133 sbuf(ideb+6) = condn(nod)
134 ideb = ideb + isize
135 ENDDO
136 ELSE
137#include "vectorize.inc"
138 DO j = 1, len
139 nod = fr_i2m(iad+j)
140 sbuf(ideb) = a(1,nod)
141 sbuf(ideb+1) = a(2,nod)
142 sbuf(ideb+2) = a(3,nod)
143 sbuf(ideb+3) = ar(1,nod)
144 sbuf(ideb+4) = ar(2,nod)
145 sbuf(ideb+5) = ar(3,nod)
146 sbuf(ideb+6) = ms(nod)
147 sbuf(ideb+7) = in(nod)
148 sbuf(ideb+8) = stifn(nod)
149 sbuf(ideb+9) = stifr(nod)
150 sbuf(ideb+10) = fthe(nod)
151 sbuf(ideb+11) = condn(nod)
152 ideb = ideb + isize
153 ENDDO
154 ENDIF
155 ELSE
156 IF (iroddl==0) THEN
157#include "vectorize.inc"
158 DO j = 1, len
159 nod = fr_i2m(iad+j)
160 sbuf(ideb) = a(1,nod)
161 sbuf(ideb+1) = a(2,nod)
162 sbuf(ideb+2) = a(3,nod)
163 sbuf(ideb+3) = ms(nod)
164 sbuf(ideb+4) = stifn(nod)
165 sbuf(ideb+5) = fthe(nod)
166 ideb = ideb + isize
167 ENDDO
168 ELSE
169#include "vectorize.inc"
170 DO j = 1, len
171 nod = fr_i2m(iad+j)
172 sbuf(ideb) = a(1,nod)
173 sbuf(ideb+1) = a(2,nod)
174 sbuf(ideb+2) = a(3,nod)
175 sbuf(ideb+3) = ar(1,nod)
176 sbuf(ideb+4) = ar(2,nod)
177 sbuf(ideb+5) = ar(3,nod)
178 sbuf(ideb+6) = ms(nod)
179 sbuf(ideb+7) = in(nod)
180 sbuf(ideb+8) = stifn(nod)
181 sbuf(ideb+9) = stifr(nod)
182 sbuf(ideb+10) = fthe(nod)
183 ideb = ideb + isize
184 ENDDO
185 ENDIF
186 ENDIF
187 ELSE
188 IF (iroddl==0) THEN
189#include "vectorize.inc"
190 DO j = 1, len
191 nod = fr_i2m(iad+j)
192 sbuf(ideb) = a(1,nod)
193 sbuf(ideb+1) = a(2,nod)
194 sbuf(ideb+2) = a(3,nod)
195 sbuf(ideb+3) = ms(nod)
196 sbuf(ideb+4) = stifn(nod)
197 ideb = ideb + isize
198 ENDDO
199 ELSE
200#include "vectorize.inc"
201 DO j = 1, len
202 nod = fr_i2m(iad+j)
203 sbuf(ideb) = a(1,nod)
204 sbuf(ideb+1) = a(2,nod)
205 sbuf(ideb+2) = a(3,nod)
206 sbuf(ideb+3) = ar(1,nod)
207 sbuf(ideb+4) = ar(2,nod)
208 sbuf(ideb+5) = ar(3,nod)
209 sbuf(ideb+6) = ms(nod)
210 sbuf(ideb+7) = in(nod)
211 sbuf(ideb+8) = stifn(nod)
212 sbuf(ideb+9) = stifr(nod)
213 ideb = ideb + isize
214 ENDDO
215 ENDIF
216 ENDIF
217C
218 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
219#include "vectorize.inc"
220 DO j = 1, len
221 nod = fr_i2m(iad+j)
222 sbuf(ideb) = fncont(1,nod)
223 sbuf(ideb+1) = fncont(2,nod)
224 sbuf(ideb+2) = fncont(3,nod)
225 ideb = ideb + 3
226 ENDDO
227 ENDIF
228 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
229#include "vectorize.inc"
230 DO j = 1, len
231 nod = fr_i2m(iad+j)
232 sbuf(ideb) = fncontp(1,nod)
233 sbuf(ideb+1) = fncontp(2,nod)
234 sbuf(ideb+2) = fncontp(3,nod)
235 sbuf(ideb+3) = ftcontp(1,nod)
236 sbuf(ideb+4) = ftcontp(2,nod)
237 sbuf(ideb+5) = ftcontp(3,nod)
238 ideb = ideb + 6
239 ENDDO
240 ENDIF
241C
242
243 ENDDO
244C
245 ideb = 1
246 DO l=1,nbindex
247 i = indexi(l)
248 len = iad_i2m(i+1)-iad_i2m(i)
249 siz = len*isize2
250 msgtyp = msgoff
251 CALL mpi_isend(
252 s sbuf(ideb),siz,real,it_spmd(i),msgtyp,
253 g spmd_comm_world,req_s(l),ierror)
254 ideb = ideb + siz
255 ENDDO
256C
257 IF (intth2 == 1) THEN
258 IF(idt_therm == 1) THEN
259 IF(iroddl==0)THEN
260 DO i=1,nb_fri2m
261 nod = fr_loci2m(i)
262 sav_acc(1,i)=a(1,nod)
263 sav_acc(2,i)=a(2,nod)
264 sav_acc(3,i)=a(3,nod)
265 sav_acc(4,i)=ms(nod)
266 sav_acc(5,i)=stifn(nod)
267 sav_acc(6,i)=fthe(nod)
268 sav_acc(7,i)=condn(nod)
269
270C
271 a(1,nod) = zero
272 a(2,nod) = zero
273 a(3,nod) = zero
274 ms(nod) = zero
275 stifn(nod) = zero
276 fthe(nod) = zero
277 condn(nod) = zero
278C
279 ENDDO
280 lensav = 7
281 ELSE
282 DO i=1,nb_fri2m
283 nod = fr_loci2m(i)
284 sav_acc( 1,i) = a(1,nod)
285 sav_acc( 2,i) = a(2,nod)
286 sav_acc( 3,i) = a(3,nod)
287 sav_acc( 4,i) = ar(1,nod)
288 sav_acc( 5,i) = ar(2,nod)
289 sav_acc( 6,i) = ar(3,nod)
290 sav_acc( 7,i) = ms(nod)
291 sav_acc( 8,i) = in(nod)
292 sav_acc( 9,i) = stifn(nod)
293 sav_acc(10,i) = stifr(nod)
294 sav_acc(11,i) = fthe(nod)
295 sav_acc(12,i) = condn(nod)
296 a(1,nod) = zero
297 a(2,nod) = zero
298 a(3,nod) = zero
299 ar(1,nod) = zero
300 ar(2,nod) = zero
301 ar(3,nod) = zero
302 ms(nod) = zero
303 in(nod) = zero
304 stifn(nod) = zero
305 stifr(nod) = zero
306 fthe(nod) = zero
307 condn(nod) = zero
308C
309 ENDDO
310 lensav = 12
311 ENDIF
312 ELSE
313 IF(iroddl==0)THEN
314 DO i=1,nb_fri2m
315 nod = fr_loci2m(i)
316 sav_acc(1,i)=a(1,nod)
317 sav_acc(2,i)=a(2,nod)
318 sav_acc(3,i)=a(3,nod)
319 sav_acc(4,i)=ms(nod)
320 sav_acc(5,i)=stifn(nod)
321 sav_acc(6,i)=fthe(nod)
322C
323 a(1,nod) = zero
324 a(2,nod) = zero
325 a(3,nod) = zero
326 ms(nod) = zero
327 stifn(nod) = zero
328 fthe(nod) = zero
329C
330 ENDDO
331 lensav = 6
332 ELSE
333 DO i=1,nb_fri2m
334 nod = fr_loci2m(i)
335 sav_acc( 1,i) = a(1,nod)
336 sav_acc( 2,i) = a(2,nod)
337 sav_acc( 3,i) = a(3,nod)
338 sav_acc( 4,i) = ar(1,nod)
339 sav_acc( 5,i) = ar(2,nod)
340 sav_acc( 6,i) = ar(3,nod)
341 sav_acc( 7,i) = ms(nod)
342 sav_acc( 8,i) = in(nod)
343 sav_acc( 9,i) = stifn(nod)
344 sav_acc(10,i) = stifr(nod)
345 sav_acc(11,i) = fthe(nod)
346 a(1,nod) = zero
347 a(2,nod) = zero
348 a(3,nod) = zero
349 ar(1,nod) = zero
350 ar(2,nod) = zero
351 ar(3,nod) = zero
352 ms(nod) = zero
353 in(nod) = zero
354 stifn(nod) = zero
355 stifr(nod) = zero
356 fthe(nod) = zero
357C
358 ENDDO
359 lensav = 11
360 ENDIF
361 ENDIF
362C
363 ELSE
364 IF(iroddl==0)THEN
365 DO i=1,nb_fri2m
366 nod = fr_loci2m(i)
367 sav_acc(1,i)=a(1,nod)
368 sav_acc(2,i)=a(2,nod)
369 sav_acc(3,i)=a(3,nod)
370 sav_acc(4,i)=ms(nod)
371 sav_acc(5,i)=stifn(nod)
372C
373 a(1,nod) = zero
374 a(2,nod) = zero
375 a(3,nod) = zero
376 ms(nod) = zero
377 stifn(nod) = zero
378C
379 ENDDO
380 lensav = 5
381 ELSE
382 DO i=1,nb_fri2m
383 nod = fr_loci2m(i)
384 sav_acc( 1,i) = a(1,nod)
385 sav_acc( 2,i) = a(2,nod)
386 sav_acc( 3,i) = a(3,nod)
387 sav_acc( 4,i) = ar(1,nod)
388 sav_acc( 5,i) = ar(2,nod)
389 sav_acc( 6,i) = ar(3,nod)
390 sav_acc( 7,i) = ms(nod)
391 sav_acc( 8,i) = in(nod)
392 sav_acc( 9,i) = stifn(nod)
393 sav_acc(10,i) = stifr(nod)
394 a(1,nod) = zero
395 a(2,nod) = zero
396 a(3,nod) = zero
397 ar(1,nod) = zero
398 ar(2,nod) = zero
399 ar(3,nod) = zero
400 ms(nod) = zero
401 in(nod) = zero
402 stifn(nod) = zero
403 stifr(nod) = zero
404C
405 ENDDO
406 lensav = 10
407 ENDIF
408 ENDIF
409
410 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
411 DO i=1,nb_fri2m
412 nod = fr_loci2m(i)
413 sav_acc(lensav+1,i)=fncont(1,nod)
414 sav_acc(lensav+2,i)=fncont(2,nod)
415 sav_acc(lensav+3,i)=fncont(3,nod)
416 lensav = lensav + 3
417C
418 fncont(1,nod) = zero
419 fncont(2,nod) = zero
420 fncont(3,nod) = zero
421 ENDDO
422 lensav = lensav + 3
423 ENDIF
424C
425 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
426 DO i=1,nb_fri2m
427 nod = fr_loci2m(i)
428 sav_acc(lensav+1,i)=fncontp(1,nod)
429 sav_acc(lensav+2,i)=fncontp(2,nod)
430 sav_acc(lensav+3,i)=fncontp(3,nod)
431 sav_acc(lensav+4,i)=ftcontp(1,nod)
432 sav_acc(lensav+5,i)=ftcontp(2,nod)
433 sav_acc(lensav+6,i)=ftcontp(3,nod)
434C
435 fncontp(1,nod) = zero
436 fncontp(2,nod) = zero
437 fncontp(3,nod) = zero
438 ftcontp(1,nod) = zero
439 ftcontp(2,nod) = zero
440 ftcontp(3,nod) = zero
441 ENDDO
442 ENDIF
443C
444 l = 0
445 DO p=1,nspmd
446 IF(p/=loc_proc)THEN
447 len= iad_i2m(p+1)-iad_i2m(p)
448 IF(len>0) THEN
449 l=l+1
450 ideb = 1+(iad_i2m(p)-1)*isize2
451 iad = iad_i2m(p)-1
452 CALL mpi_wait(req_r(l),status,ierror)
453 IF (intth2 == 1) THEN
454 IF(idt_therm == 1) THEN
455 IF(iroddl==0)THEN
456#include "vectorize.inc"
457 DO j = 1, len
458 nod = fr_i2m(iad+j)
459 a(1,nod) = a(1,nod) + rbuf(ideb)
460 a(2,nod) = a(2,nod) + rbuf(ideb+1)
461 a(3,nod) = a(3,nod) + rbuf(ideb+2)
462 ms(nod) = ms(nod) + rbuf(ideb+3)
463 stifn(nod) = stifn(nod)+rbuf(ideb+4)
464 fthe(nod) = fthe(nod)+rbuf(ideb+5)
465 condn(nod) = condn(nod)+rbuf(ideb+6)
466 ideb = ideb + isize
467 ENDDO
468 ELSE
469#include "vectorize.inc"
470 DO j = 1, len
471 nod = fr_i2m(iad+j)
472 a(1,nod) = a(1,nod) + rbuf(ideb)
473 a(2,nod) = a(2,nod) + rbuf(ideb+1)
474 a(3,nod) = a(3,nod) + rbuf(ideb+2)
475 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
476 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
477 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
478 ms(nod) = ms(nod) + rbuf(ideb+6)
479 in(nod) = in(nod) + rbuf(ideb+7)
480 stifn(nod) = stifn(nod)+rbuf(ideb+8)
481 stifr(nod) = stifr(nod)+rbuf(ideb+9)
482 fthe(nod) = fthe(nod)+rbuf(ideb+10)
483 condn(nod) = condn(nod)+rbuf(ideb+11)
484 ideb = ideb + isize
485 END DO
486 ENDIF
487 ELSE
488 IF(iroddl==0)THEN
489#include "vectorize.inc"
490 DO j = 1, len
491 nod = fr_i2m(iad+j)
492 a(1,nod) = a(1,nod) + rbuf(ideb)
493 a(2,nod) = a(2,nod) + rbuf(ideb+1)
494 a(3,nod) = a(3,nod) + rbuf(ideb+2)
495 ms(nod) = ms(nod) + rbuf(ideb+3)
496 stifn(nod) = stifn(nod)+rbuf(ideb+4)
497 fthe(nod) = fthe(nod)+rbuf(ideb+5)
498 ideb = ideb + isize
499 ENDDO
500 ELSE
501#include "vectorize.inc"
502 DO j = 1, len
503 nod = fr_i2m(iad+j)
504 a(1,nod) = a(1,nod) + rbuf(ideb)
505 a(2,nod) = a(2,nod) + rbuf(ideb+1)
506 a(3,nod) = a(3,nod) + rbuf(ideb+2)
507 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
508 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
509 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
510 ms(nod) = ms(nod) + rbuf(ideb+6)
511 in(nod) = in(nod) + rbuf(ideb+7)
512 stifn(nod) = stifn(nod)+rbuf(ideb+8)
513 stifr(nod) = stifr(nod)+rbuf(ideb+9)
514 fthe(nod) = fthe(nod)+rbuf(ideb+10)
515 ideb = ideb + isize
516 END DO
517 ENDIF
518 ENDIF
519 ELSE
520 IF(iroddl==0)THEN
521#include "vectorize.inc"
522 DO j = 1, len
523 nod = fr_i2m(iad+j)
524 a(1,nod) = a(1,nod) + rbuf(ideb)
525 a(2,nod) = a(2,nod) + rbuf(ideb+1)
526 a(3,nod) = a(3,nod) + rbuf(ideb+2)
527 ms(nod) = ms(nod) + rbuf(ideb+3)
528 stifn(nod) = stifn(nod)+rbuf(ideb+4)
529 ideb = ideb + isize
530 ENDDO
531 ELSE
532#include "vectorize.inc"
533 DO j = 1, len
534 nod = fr_i2m(iad+j)
535 a(1,nod) = a(1,nod) + rbuf(ideb)
536 a(2,nod) = a(2,nod) + rbuf(ideb+1)
537 a(3,nod) = a(3,nod) + rbuf(ideb+2)
538 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
539 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
540 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
541 ms(nod) = ms(nod) + rbuf(ideb+6)
542 in(nod) = in(nod) + rbuf(ideb+7)
543 stifn(nod) = stifn(nod)+rbuf(ideb+8)
544 stifr(nod) = stifr(nod)+rbuf(ideb+9)
545 ideb = ideb + isize
546 END DO
547 ENDIF
548 ENDIF
549 ENDIF
550C
551 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
552#include "vectorize.inc"
553 DO j = 1, len
554 nod = fr_i2m(iad+j)
555 fncont(1,nod) = fncont(1,nod) + rbuf(ideb)
556 fncont(2,nod) = fncont(2,nod) + rbuf(ideb+1)
557 fncont(3,nod) = fncont(3,nod) + rbuf(ideb+2)
558 ideb = ideb + 3
559 ENDDO
560 ENDIF
561 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
562#include "vectorize.inc"
563 DO j = 1, len
564 nod = fr_i2m(iad+j)
565 fncontp(1,nod) = fncontp(1,nod) + rbuf(ideb)
566 fncontp(2,nod) = fncontp(2,nod) + rbuf(ideb+1)
567 fncontp(3,nod) = fncontp(3,nod) + rbuf(ideb+2)
568 ftcontp(1,nod) = ftcontp(1,nod) + rbuf(ideb+3)
569 ftcontp(2,nod) = ftcontp(2,nod) + rbuf(ideb+4)
570 ftcontp(3,nod) = ftcontp(3,nod) + rbuf(ideb+5)
571 ideb = ideb + 6
572 ENDDO
573 ENDIF
574C
575
576 ELSE
577 IF (intth2 == 1) THEN
578 IF (idt_therm== 1) THEN
579 IF(iroddl==0)THEN
580 DO j=1,nb_fri2m
581 nod=fr_loci2m(j)
582 a(1,nod) = a(1,nod) + sav_acc(1,j)
583 a(2,nod) = a(2,nod) + sav_acc(2,j)
584 a(3,nod) = a(3,nod) + sav_acc(3,j)
585 ms(nod) = ms(nod) + sav_acc(4,j)
586 stifn(nod) = stifn(nod)+sav_acc(5,j)
587 fthe(nod) = fthe(nod) +sav_acc(6,j)
588 condn(nod) = condn(nod)+sav_acc(7,j)
589 ENDDO
590 lensav = 7
591 ELSE
592 DO j=1,nb_fri2m
593 nod=fr_loci2m(j)
594 a(1,nod) = a(1,nod) + sav_acc(1,j)
595 a(2,nod) = a(2,nod) + sav_acc(2,j)
596 a(3,nod) = a(3,nod) + sav_acc(3,j)
597 ar(1,nod) = ar(1,nod)+ sav_acc(4,j)
598 ar(2,nod) = ar(2,nod)+ sav_acc(5,j)
599 ar(3,nod) = ar(3,nod)+ sav_acc(6,j)
600 ms(nod) = ms(nod) + sav_acc(7,j)
601 in(nod) = in(nod) + sav_acc(8,j)
602 stifn(nod) = stifn(nod)+sav_acc(9,j)
603 stifr(nod) = stifr(nod)+sav_acc(10,j)
604 fthe(nod) = fthe(nod) +sav_acc(11,j)
605 condn(nod) = condn(nod)+sav_acc(12,j)
606 ENDDO
607 lensav = 12
608 ENDIF
609 ELSE
610 IF(iroddl==0)THEN
611 DO j=1,nb_fri2m
612 nod=fr_loci2m(j)
613 a(1,nod) = a(1,nod) + sav_acc(1,j)
614 a(2,nod) = a(2,nod) + sav_acc(2,j)
615 a(3,nod) = a(3,nod) + sav_acc(3,j)
616 ms(nod) = ms(nod) + sav_acc(4,j)
617 stifn(nod) = stifn(nod)+sav_acc(5,j)
618 fthe(nod) = fthe(nod) +sav_acc(6,j)
619 ENDDO
620 lensav = 6
621 ELSE
622 DO j=1,nb_fri2m
623 nod=fr_loci2m(j)
624 a(1,nod) = a(1,nod) + sav_acc(1,j)
625 a(2,nod) = a(2,nod) + sav_acc(2,j)
626 a(3,nod) = a(3,nod) + sav_acc(3,j)
627 ar(1,nod) = ar(1,nod)+ sav_acc(4,j)
628 ar(2,nod) = ar(2,nod)+ sav_acc(5,j)
629 ar(3,nod) = ar(3,nod)+ sav_acc(6,j)
630 ms(nod) = ms(nod) + sav_acc(7,j)
631 in(nod) = in(nod) + sav_acc(8,j)
632 stifn(nod) = stifn(nod)+sav_acc(9,j)
633 stifr(nod) = stifr(nod)+sav_acc(10,j)
634 fthe(nod) = fthe(nod) +sav_acc(11,j)
635 ENDDO
636 lensav = 11
637 ENDIF
638 ENDIF
639 ELSE
640 IF(iroddl==0)THEN
641 DO j=1,nb_fri2m
642 nod=fr_loci2m(j)
643 a(1,nod) = a(1,nod) + sav_acc(1,j)
644 a(2,nod) = a(2,nod) + sav_acc(2,j)
645 a(3,nod) = a(3,nod) + sav_acc(3,j)
646 ms(nod) = ms(nod) + sav_acc(4,j)
647 stifn(nod) = stifn(nod)+sav_acc(5,j)
648 ENDDO
649 lensav = 5
650 ELSE
651 DO j=1,nb_fri2m
652 nod=fr_loci2m(j)
653 a(1,nod) = a(1,nod) + sav_acc(1,j)
654 a(2,nod) = a(2,nod) + sav_acc(2,j)
655 a(3,nod) = a(3,nod) + sav_acc(3,j)
656 ar(1,nod) = ar(1,nod)+ sav_acc(4,j)
657 ar(2,nod) = ar(2,nod)+ sav_acc(5,j)
658 ar(3,nod) = ar(3,nod)+ sav_acc(6,j)
659 ms(nod) = ms(nod) + sav_acc(7,j)
660 in(nod) = in(nod) + sav_acc(8,j)
661 stifn(nod) = stifn(nod)+sav_acc(9,j)
662 stifr(nod) = stifr(nod)+sav_acc(10,j)
663 ENDDO
664 lensav = 10
665 ENDIF
666 ENDIF
667
668 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
669 DO j=1,nb_fri2m
670 nod=fr_loci2m(j)
671 fncont(1,nod) = fncont(1,nod) + sav_acc(lensav+1,j)
672 fncont(2,nod) = fncont(2,nod) + sav_acc(lensav+2,j)
673 fncont(3,nod) = fncont(3,nod) + sav_acc(lensav+3,j)
674 ENDDO
675 lensav = lensav +3
676 ENDIF
677 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
678 DO j=1,nb_fri2m
679 nod=fr_loci2m(j)
680 fncontp(1,nod) = fncontp(1,nod) + sav_acc(lensav+1,j)
681 fncontp(2,nod) = fncontp(2,nod) + sav_acc(lensav+2,j)
682 fncontp(3,nod) = fncontp(3,nod) + sav_acc(lensav+3,j)
683 ftcontp(1,nod) = ftcontp(1,nod) + sav_acc(lensav+4,j)
684 ftcontp(2,nod) = ftcontp(2,nod) + sav_acc(lensav+5,j)
685 ftcontp(3,nod) = ftcontp(3,nod) + sav_acc(lensav+6,j)
686 ENDDO
687 ENDIF
688
689 ENDIF
690 ENDDO
691C
692 DO l=1,nbindex
693 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
694 ENDDO
695 DEALLOCATE(sav_acc)
696 DEALLOCATE(rbuf)
697 DEALLOCATE(sbuf)
698C
699#endif
700 RETURN
701 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_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
spmd_exch_a_int2_ams
subroutine spmd_exch_a_int2_ams(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, nb_fri2m, fr_loci2m, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2_ams.F:38
h3d_mod::h3d_database
Definition h3d_mod.F:435