OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_int2h_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_int2h_ams ../engine/source/mpi/forces/spmd_exch_a_int2h_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_int2h_ams(
34 1 A ,AR ,MS ,IN ,STIFN,
35 2 STIFR,FR_I2M,IAD_I2M,LCOMI2M,ISIZE,
36 3 NB_FRI2M,FR_LOCI2M,TAGNOD,INTTH2,FTHE,
37 4 CONDN,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(*),TAGNOD(*)
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,
76 . LENSAV,STATUS(MPI_STATUS_SIZE),
77 . REQ_S(NSPMD),REQ_R(NSPMD),INDEXI(NSPMD)
78 DATA msgoff/118/
79 my_real,
80 . DIMENSION (:),ALLOCATABLE :: sbuf,rbuf
81 my_real,
82 . DIMENSION(:,:),ALLOCATABLE :: sav_acc
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)*tagnod(nod)
128 sbuf(ideb+1) = a(2,nod)*tagnod(nod)
129 sbuf(ideb+2) = a(3,nod)*tagnod(nod)
130 sbuf(ideb+3) = ms(nod)*tagnod(nod)
131 sbuf(ideb+4) = stifn(nod)*tagnod(nod)
132 sbuf(ideb+5) = fthe(nod)*tagnod(nod)
133 sbuf(ideb+6) = condn(nod)*tagnod(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)*tagnod(nod)
141 sbuf(ideb+1) = a(2,nod)*tagnod(nod)
142 sbuf(ideb+2) = a(3,nod)*tagnod(nod)
143 sbuf(ideb+3) = ar(1,nod)*tagnod(nod)
144 sbuf(ideb+4) = ar(2,nod)*tagnod(nod)
145 sbuf(ideb+5) = ar(3,nod)*tagnod(nod)
146 sbuf(ideb+6) = ms(nod)*tagnod(nod)
147 sbuf(ideb+7) = in(nod)*tagnod(nod)
148 sbuf(ideb+8) = stifn(nod)*tagnod(nod)
149 sbuf(ideb+9) = stifr(nod)*tagnod(nod)
150 sbuf(ideb+10)= fthe(nod)*tagnod(nod)
151 sbuf(ideb+11)= condn(nod)*tagnod(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)*tagnod(nod)
161 sbuf(ideb+1) = a(2,nod)*tagnod(nod)
162 sbuf(ideb+2) = a(3,nod)*tagnod(nod)
163 sbuf(ideb+3) = ms(nod)*tagnod(nod)
164 sbuf(ideb+4) = stifn(nod)*tagnod(nod)
165 sbuf(ideb+5) = fthe(nod)*tagnod(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)*tagnod(nod)
173 sbuf(ideb+1) = a(2,nod)*tagnod(nod)
174 sbuf(ideb+2) = a(3,nod)*tagnod(nod)
175 sbuf(ideb+3) = ar(1,nod)*tagnod(nod)
176 sbuf(ideb+4) = ar(2,nod)*tagnod(nod)
177 sbuf(ideb+5) = ar(3,nod)*tagnod(nod)
178 sbuf(ideb+6) = ms(nod)*tagnod(nod)
179 sbuf(ideb+7) = in(nod)*tagnod(nod)
180 sbuf(ideb+8) = stifn(nod)*tagnod(nod)
181 sbuf(ideb+9) = stifr(nod)*tagnod(nod)
182 sbuf(ideb+10)= fthe(nod)*tagnod(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)*tagnod(nod)
193 sbuf(ideb+1) = a(2,nod)*tagnod(nod)
194 sbuf(ideb+2) = a(3,nod)*tagnod(nod)
195 sbuf(ideb+3) = ms(nod)*tagnod(nod)
196 sbuf(ideb+4) = stifn(nod)*tagnod(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)*tagnod(nod)
204 sbuf(ideb+1) = a(2,nod)*tagnod(nod)
205 sbuf(ideb+2) = a(3,nod)*tagnod(nod)
206 sbuf(ideb+3) = ar(1,nod)*tagnod(nod)
207 sbuf(ideb+4) = ar(2,nod)*tagnod(nod)
208 sbuf(ideb+5) = ar(3,nod)*tagnod(nod)
209 sbuf(ideb+6) = ms(nod)*tagnod(nod)
210 sbuf(ideb+7) = in(nod)*tagnod(nod)
211 sbuf(ideb+8) = stifn(nod)*tagnod(nod)
212 sbuf(ideb+9) = stifr(nod)*tagnod(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)*tagnod(nod)
223 sbuf(ideb+1) = fncont(2,nod)*tagnod(nod)
224 sbuf(ideb+2) = fncont(3,nod)*tagnod(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)*tagnod(nod)
233 sbuf(ideb+1) = fncontp(2,nod)*tagnod(nod)
234 sbuf(ideb+2) = fncontp(3,nod)*tagnod(nod)
235 sbuf(ideb+3) = ftcontp(1,nod)*tagnod(nod)
236 sbuf(ideb+4) = ftcontp(2,nod)*tagnod(nod)
237 sbuf(ideb+5) = ftcontp(3,nod)*tagnod(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)*tagnod(nod)
263 sav_acc(2,i)=a(2,nod)*tagnod(nod)
264 sav_acc(3,i)=a(3,nod)*tagnod(nod)
265 sav_acc(4,i)=ms(nod)*tagnod(nod)
266 sav_acc(5,i)=stifn(nod)*tagnod(nod)
267 sav_acc(6,i)=fthe(nod)*tagnod(nod)
268 sav_acc(7,i)=condn(nod)*tagnod(nod)
269C
270 IF(tagnod(nod)==1)THEN
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
278 END IF
279C
280 ENDDO
281 lensav = 7
282
283 ELSE
284 DO i=1,nb_fri2m
285 nod = fr_loci2m(i)
286 sav_acc( 1,i) = a(1,nod)*tagnod(nod)
287 sav_acc( 2,i) = a(2,nod)*tagnod(nod)
288 sav_acc( 3,i) = a(3,nod)*tagnod(nod)
289 sav_acc( 4,i) = ar(1,nod)*tagnod(nod)
290 sav_acc( 5,i) = ar(2,nod)*tagnod(nod)
291 sav_acc( 6,i) = ar(3,nod)*tagnod(nod)
292 sav_acc( 7,i) = ms(nod)*tagnod(nod)
293 sav_acc( 8,i) = in(nod)*tagnod(nod)
294 sav_acc( 9,i) = stifn(nod)*tagnod(nod)
295 sav_acc(10,i) = stifr(nod)*tagnod(nod)
296 sav_acc(11,i) = fthe(nod)*tagnod(nod)
297 sav_acc(12,i) = condn(nod)*tagnod(nod)
298 IF(tagnod(nod)==1)THEN
299 a(1,nod) = zero
300 a(2,nod) = zero
301 a(3,nod) = zero
302 ar(1,nod) = zero
303 ar(2,nod) = zero
304 ar(3,nod) = zero
305 ms(nod) = zero
306 in(nod) = zero
307 stifn(nod) = zero
308 stifr(nod) = zero
309 fthe(nod) = zero
310 condn(nod) = zero
311 END IF
312 ENDDO
313 lensav = 12
314C
315 ENDIF
316 ELSE
317 IF(iroddl==0)THEN
318 DO i=1,nb_fri2m
319 nod = fr_loci2m(i)
320 sav_acc(1,i)=a(1,nod)*tagnod(nod)
321 sav_acc(2,i)=a(2,nod)*tagnod(nod)
322 sav_acc(3,i)=a(3,nod)*tagnod(nod)
323 sav_acc(4,i)=ms(nod)*tagnod(nod)
324 sav_acc(5,i)=stifn(nod)*tagnod(nod)
325 sav_acc(6,i)=fthe(nod)*tagnod(nod)
326C
327 IF(tagnod(nod)==1)THEN
328 a(1,nod) = zero
329 a(2,nod) = zero
330 a(3,nod) = zero
331 ms(nod) = zero
332 stifn(nod) = zero
333 fthe(nod) = zero
334 END IF
335C
336 ENDDO
337 lensav = 6
338 ELSE
339 DO i=1,nb_fri2m
340 nod = fr_loci2m(i)
341 sav_acc( 1,i) = a(1,nod)*tagnod(nod)
342 sav_acc( 2,i) = a(2,nod)*tagnod(nod)
343 sav_acc( 3,i) = a(3,nod)*tagnod(nod)
344 sav_acc( 4,i) = ar(1,nod)*tagnod(nod)
345 sav_acc( 5,i) = ar(2,nod)*tagnod(nod)
346 sav_acc( 6,i) = ar(3,nod)*tagnod(nod)
347 sav_acc( 7,i) = ms(nod)*tagnod(nod)
348 sav_acc( 8,i) = in(nod)*tagnod(nod)
349 sav_acc( 9,i) = stifn(nod)*tagnod(nod)
350 sav_acc(10,i) = stifr(nod)*tagnod(nod)
351 sav_acc(11,i) = fthe(nod)*tagnod(nod)
352 IF(tagnod(nod)==1)THEN
353 a(1,nod) = zero
354 a(2,nod) = zero
355 a(3,nod) = zero
356 ar(1,nod) = zero
357 ar(2,nod) = zero
358 ar(3,nod) = zero
359 ms(nod) = zero
360 in(nod) = zero
361 stifn(nod) = zero
362 stifr(nod) = zero
363 fthe(nod) = zero
364 END IF
365C
366 ENDDO
367 lensav = 11
368C
369 ENDIF
370 ENDIF
371C
372 ELSE
373 IF(iroddl==0)THEN
374 DO i=1,nb_fri2m
375 nod = fr_loci2m(i)
376 sav_acc(1,i)=a(1,nod)*tagnod(nod)
377 sav_acc(2,i)=a(2,nod)*tagnod(nod)
378 sav_acc(3,i)=a(3,nod)*tagnod(nod)
379 sav_acc(4,i)=ms(nod)*tagnod(nod)
380 sav_acc(5,i)=stifn(nod)*tagnod(nod)
381C
382 IF(tagnod(nod)==1)THEN
383 a(1,nod) = zero
384 a(2,nod) = zero
385 a(3,nod) = zero
386 ms(nod) = zero
387 stifn(nod) = zero
388 END IF
389C
390 ENDDO
391 lensav = 5
392
393 ELSE
394 DO i=1,nb_fri2m
395 nod = fr_loci2m(i)
396 sav_acc( 1,i) = a(1,nod)*tagnod(nod)
397 sav_acc( 2,i) = a(2,nod)*tagnod(nod)
398 sav_acc( 3,i) = a(3,nod)*tagnod(nod)
399 sav_acc( 4,i) = ar(1,nod)*tagnod(nod)
400 sav_acc( 5,i) = ar(2,nod)*tagnod(nod)
401 sav_acc( 6,i) = ar(3,nod)*tagnod(nod)
402 sav_acc( 7,i) = ms(nod)*tagnod(nod)
403 sav_acc( 8,i) = in(nod)*tagnod(nod)
404 sav_acc( 9,i) = stifn(nod)*tagnod(nod)
405 sav_acc(10,i) = stifr(nod)*tagnod(nod)
406 IF(tagnod(nod)==1)THEN
407 a(1,nod) = zero
408 a(2,nod) = zero
409 a(3,nod) = zero
410 ar(1,nod) = zero
411 ar(2,nod) = zero
412 ar(3,nod) = zero
413 ms(nod) = zero
414 in(nod) = zero
415 stifn(nod) = zero
416 stifr(nod) = zero
417 END IF
418C
419 ENDDO
420 lensav = 10
421C
422 ENDIF
423C
424 IF (h3d_data%N_VECT_CONT2_MAX > 0) THEN
425 DO i=1,nb_fri2m
426 nod = fr_loci2m(i)
427 sav_acc(lensav+1,i)=fncont(1,nod)*tagnod(nod)
428 sav_acc(lensav+2,i)=fncont(2,nod)*tagnod(nod)
429 sav_acc(lensav+3,i)=fncont(3,nod)*tagnod(nod)
430C
431 IF(tagnod(nod)==1)THEN
432 fncont(1,nod) = zero
433 fncont(2,nod) = zero
434 fncont(3,nod) = zero
435 END IF
436C
437 ENDDO
438 lensav = lensav+3
439 ENDIF
440 IF (h3d_data%N_VECT_PCONT2_MAX > 0) THEN
441 DO i=1,nb_fri2m
442 nod = fr_loci2m(i)
443 sav_acc(lensav+1,i)=fncontp(1,nod)*tagnod(nod)
444 sav_acc(lensav+2,i)=fncontp(2,nod)*tagnod(nod)
445 sav_acc(lensav+3,i)=fncontp(3,nod)*tagnod(nod)
446 sav_acc(lensav+4,i)=ftcontp(1,nod)*tagnod(nod)
447 sav_acc(lensav+5,i)=ftcontp(2,nod)*tagnod(nod)
448 sav_acc(lensav+6,i)=ftcontp(3,nod)*tagnod(nod)
449C
450 IF(tagnod(nod)==1)THEN
451 fncontp(1,nod) = zero
452 fncontp(2,nod) = zero
453 fncontp(3,nod) = zero
454 ftcontp(1,nod) = zero
455 ftcontp(2,nod) = zero
456 ftcontp(3,nod) = zero
457 END IF
458 ENDDO
459 ENDIF
460C
461 ENDIF
462C
463 l = 0
464 DO p=1,nspmd
465 IF(p/=loc_proc)THEN
466 len= iad_i2m(p+1)-iad_i2m(p)
467 IF(len>0) THEN
468 l=l+1
469 ideb = 1+(iad_i2m(p)-1)*isize2
470 iad = iad_i2m(p)-1
471 CALL mpi_wait(req_r(l),status,ierror)
472 IF(intth2 == 1) THEN
473 IF (idt_therm== 1) THEN
474 IF(iroddl==0)THEN
475#include "vectorize.inc"
476 DO j = 1, len
477 nod = fr_i2m(iad+j)
478 a(1,nod) = a(1,nod) + rbuf(ideb)
479 a(2,nod) = a(2,nod) + rbuf(ideb+1)
480 a(3,nod) = a(3,nod) + rbuf(ideb+2)
481 ms(nod) = ms(nod) + rbuf(ideb+3)
482 stifn(nod) = stifn(nod)+rbuf(ideb+4)
483 fthe(nod) = fthe(nod)+rbuf(ideb+5)
484 condn(nod) = condn(nod)+rbuf(ideb+6)
485 ideb = ideb + isize
486 ENDDO
487 ELSE
488#include "vectorize.inc"
489 DO j = 1, len
490 nod = fr_i2m(iad+j)
491 a(1,nod) = a(1,nod) + rbuf(ideb)
492 a(2,nod) = a(2,nod) + rbuf(ideb+1)
493 a(3,nod) = a(3,nod) + rbuf(ideb+2)
494 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
495 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
496 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
497 ms(nod) = ms(nod) + rbuf(ideb+6)
498 in(nod) = in(nod) + rbuf(ideb+7)
499 stifn(nod) = stifn(nod)+rbuf(ideb+8)
500 stifr(nod) = stifr(nod)+rbuf(ideb+9)
501 fthe(nod) = fthe(nod) +rbuf(ideb+10)
502 condn(nod) = condn(nod)+rbuf(ideb+11)
503 ideb = ideb + isize
504 END DO
505 ENDIF
506 ELSE
507 IF(iroddl==0)THEN
508#include "vectorize.inc"
509 DO j = 1, len
510 nod = fr_i2m(iad+j)
511 a(1,nod) = a(1,nod) + rbuf(ideb)
512 a(2,nod) = a(2,nod) + rbuf(ideb+1)
513 a(3,nod) = a(3,nod) + rbuf(ideb+2)
514 ms(nod) = ms(nod) + rbuf(ideb+3)
515 stifn(nod) = stifn(nod)+rbuf(ideb+4)
516 fthe(nod) = fthe(nod)+rbuf(ideb+5)
517 ideb = ideb + isize
518 ENDDO
519 ELSE
520#include "vectorize.inc"
521 DO j = 1, len
522 nod = fr_i2m(iad+j)
523 a(1,nod) = a(1,nod) + rbuf(ideb)
524 a(2,nod) = a(2,nod) + rbuf(ideb+1)
525 a(3,nod) = a(3,nod) + rbuf(ideb+2)
526 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
527 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
528 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
529 ms(nod) = ms(nod) + rbuf(ideb+6)
530 in(nod) = in(nod) + rbuf(ideb+7)
531 stifn(nod) = stifn(nod)+rbuf(ideb+8)
532 stifr(nod) = stifr(nod)+rbuf(ideb+9)
533 fthe(nod) = fthe(nod) +rbuf(ideb+10)
534 ideb = ideb + isize
535 END DO
536 ENDIF
537 ENDIF
538 ELSE
539 IF(iroddl==0)THEN
540#include "vectorize.inc"
541 DO j = 1, len
542 nod = fr_i2m(iad+j)
543 a(1,nod) = a(1,nod) + rbuf(ideb)
544 a(2,nod) = a(2,nod) + rbuf(ideb+1)
545 a(3,nod) = a(3,nod) + rbuf(ideb+2)
546 ms(nod) = ms(nod) + rbuf(ideb+3)
547 stifn(nod) = stifn(nod)+rbuf(ideb+4)
548 ideb = ideb + isize
549 ENDDO
550 ELSE
551#include "vectorize.inc"
552 DO j = 1, len
553 nod = fr_i2m(iad+j)
554 a(1,nod) = a(1,nod) + rbuf(ideb)
555 a(2,nod) = a(2,nod) + rbuf(ideb+1)
556 a(3,nod) = a(3,nod) + rbuf(ideb+2)
557 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
558 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
559 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
560 ms(nod) = ms(nod) + rbuf(ideb+6)
561 in(nod) = in(nod) + rbuf(ideb+7)
562 stifn(nod) = stifn(nod)+rbuf(ideb+8)
563 stifr(nod) = stifr(nod)+rbuf(ideb+9)
564 ideb = ideb + isize
565 END DO
566 ENDIF
567 ENDIF
568 ENDIF
569C
570 IF (h3d_data%N_VECT_CONT2_MAX > 0) THEN
571#include "vectorize.inc"
572 DO j = 1, len
573 nod = fr_i2m(iad+j)
574 fncont(1,nod) = fncont(1,nod) + rbuf(ideb)
575 fncont(2,nod) = fncont(2,nod) + rbuf(ideb+1)
576 fncont(3,nod) = fncont(3,nod) + rbuf(ideb+2)
577 ideb = ideb + 3
578 ENDDO
579 ENDIF
580 IF (h3d_data%N_VECT_PCONT2_MAX > 0) THEN
581#include "vectorize.inc"
582 DO j = 1, len
583 nod = fr_i2m(iad+j)
584 fncontp(1,nod) = fncontp(1,nod) + rbuf(ideb)
585 fncontp(2,nod) = fncontp(2,nod) + rbuf(ideb+1)
586 fncontp(3,nod) = fncontp(3,nod) + rbuf(ideb+2)
587 ftcontp(1,nod) = ftcontp(1,nod) + rbuf(ideb+3)
588 ftcontp(2,nod) = ftcontp(2,nod) + rbuf(ideb+4)
589 ftcontp(3,nod) = ftcontp(3,nod) + rbuf(ideb+5)
590 ideb = ideb + 6
591 ENDDO
592 ENDIF
593C
594 ELSE
595 IF(intth2 == 1) THEN
596 IF (idt_therm== 1) THEN
597 IF(iroddl==0)THEN
598 DO j=1,nb_fri2m
599 nod=fr_loci2m(j)
600 a(1,nod) = a(1,nod) + sav_acc(1,j)
601 a(2,nod) = a(2,nod) + sav_acc(2,j)
602 a(3,nod) = a(3,nod) + sav_acc(3,j)
603 ms(nod) = ms(nod) + sav_acc(4,j)
604 stifn(nod) = stifn(nod)+sav_acc(5,j)
605 fthe(nod) = fthe(nod) +sav_acc(6,j)
606 condn(nod) = condn(nod) +sav_acc(7,j)
607 ENDDO
608 lensav = 7
609 ELSE
610 DO j=1,nb_fri2m
611 nod=fr_loci2m(j)
612 a(1,nod) = a(1,nod) + sav_acc(1,j)
613 a(2,nod) = a(2,nod) + sav_acc(2,j)
614 a(3,nod) = a(3,nod) + sav_acc(3,j)
615 ar(1,nod) = ar(1,nod)+ sav_acc(4,j)
616 ar(2,nod) = ar(2,nod)+ sav_acc(5,j)
617 ar(3,nod) = ar(3,nod)+ sav_acc(6,j)
618 ms(nod) = ms(nod) + sav_acc(7,j)
619 in(nod) = in(nod) + sav_acc(8,j)
620 stifn(nod) = stifn(nod)+sav_acc(9,j)
621 stifr(nod) = stifr(nod)+sav_acc(10,j)
622 fthe(nod) = fthe(nod) +sav_acc(11,j)
623 condn(nod) = condn(nod)+sav_acc(12,j)
624 ENDDO
625 lensav = 12
626 ENDIF
627 ELSE
628 IF(iroddl==0)THEN
629 DO j=1,nb_fri2m
630 nod=fr_loci2m(j)
631 a(1,nod) = a(1,nod) + sav_acc(1,j)
632 a(2,nod) = a(2,nod) + sav_acc(2,j)
633 a(3,nod) = a(3,nod) + sav_acc(3,j)
634 ms(nod) = ms(nod) + sav_acc(4,j)
635 stifn(nod) = stifn(nod)+sav_acc(5,j)
636 fthe(nod) = fthe(nod) +sav_acc(6,j)
637 ENDDO
638 lensav = 6
639 ELSE
640 DO j=1,nb_fri2m
641 nod=fr_loci2m(j)
642 a(1,nod) = a(1,nod) + sav_acc(1,j)
643 a(2,nod) = a(2,nod) + sav_acc(2,j)
644 a(3,nod) = a(3,nod) + sav_acc(3,j)
645 ar(1,nod) = ar(1,nod)+ sav_acc(4,j)
646 ar(2,nod) = ar(2,nod)+ sav_acc(5,j)
647 ar(3,nod) = ar(3,nod)+ sav_acc(6,j)
648 ms(nod) = ms(nod) + sav_acc(7,j)
649 in(nod) = in(nod) + sav_acc(8,j)
650 stifn(nod) = stifn(nod)+sav_acc(9,j)
651 stifr(nod) = stifr(nod)+sav_acc(10,j)
652 fthe(nod) = fthe(nod) +sav_acc(11,j)
653 ENDDO
654 lensav = 11
655 ENDIF
656 ENDIF
657 ELSE
658 IF(iroddl==0)THEN
659 DO j=1,nb_fri2m
660 nod=fr_loci2m(j)
661 a(1,nod) = a(1,nod) + sav_acc(1,j)
662 a(2,nod) = a(2,nod) + sav_acc(2,j)
663 a(3,nod) = a(3,nod) + sav_acc(3,j)
664 ms(nod) = ms(nod) + sav_acc(4,j)
665 stifn(nod) = stifn(nod)+sav_acc(5,j)
666 ENDDO
667 lensav = 5
668 ELSE
669 DO j=1,nb_fri2m
670 nod=fr_loci2m(j)
671 a(1,nod) = a(1,nod) + sav_acc(1,j)
672 a(2,nod) = a(2,nod) + sav_acc(2,j)
673 a(3,nod) = a(3,nod) + sav_acc(3,j)
674 ar(1,nod) = ar(1,nod)+ sav_acc(4,j)
675 ar(2,nod) = ar(2,nod)+ sav_acc(5,j)
676 ar(3,nod) = ar(3,nod)+ sav_acc(6,j)
677 ms(nod) = ms(nod) + sav_acc(7,j)
678 in(nod) = in(nod) + sav_acc(8,j)
679 stifn(nod) = stifn(nod)+sav_acc(9,j)
680 stifr(nod) = stifr(nod)+sav_acc(10,j)
681 ENDDO
682 lensav = 10
683 ENDIF
684 ENDIF
685C
686 IF (h3d_data%N_VECT_CONT2_MAX > 0) THEN
687 DO j=1,nb_fri2m
688 nod=fr_loci2m(j)
689 fncont(1,nod) = fncont(1,nod) + sav_acc(lensav+1,j)
690 fncont(2,nod) = fncont(2,nod) + sav_acc(lensav+2,j)
691 fncont(3,nod) = fncont(3,nod) + sav_acc(lensav+3,j)
692 ideb = ideb + 3
693 ENDDO
694 lensav = lensav +3
695 ENDIF
696 IF (h3d_data%N_VECT_PCONT2_MAX > 0) THEN
697 DO j=1,nb_fri2m
698 nod=fr_loci2m(j)
699 fncontp(1,nod) = fncontp(1,nod) + sav_acc(lensav+1,j)
700 fncontp(2,nod) = fncontp(2,nod) + sav_acc(lensav+2,j)
701 fncontp(3,nod) = fncontp(3,nod) + sav_acc(lensav+3,j)
702 ftcontp(1,nod) = ftcontp(1,nod) + sav_acc(lensav+4,j)
703 ftcontp(2,nod) = ftcontp(2,nod) + sav_acc(lensav+5,j)
704 ftcontp(3,nod) = ftcontp(3,nod) + sav_acc(lensav+6,j)
705 ENDDO
706 ENDIF
707C
708
709
710 ENDIF
711
712 ENDDO
713C
714 DO l=1,nbindex
715 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
716 ENDDO
717 DEALLOCATE(sav_acc)
718 DEALLOCATE(rbuf)
719 DEALLOCATE(sbuf)
720C
721#endif
722 RETURN
723 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_int2h_ams
subroutine spmd_exch_a_int2h_ams(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, nb_fri2m, fr_loci2m, tagnod, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2h_ams.F:38
h3d_mod::h3d_database
Definition h3d_mod.F:435