OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_cfd.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#include "macro.inc"
24!||====================================================================
25!|| spmd_xvois ../engine/source/mpi/fluid/spmd_cfd.F
26!||--- called by ------------------------------------------------------
27!|| alemain ../engine/source/ale/alemain.F
28!|| alethe ../engine/source/ale/alethe.F
29!|| alew1 ../engine/source/ale/grid/alew1.F
30!|| alew5 ../engine/source/ale/grid/alew5.F
31!||--- calls -----------------------------------------------------
32!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
33!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
34!||--- uses -----------------------------------------------------
35!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
36!||====================================================================
37 SUBROUTINE spmd_xvois(
38 1 X ,NBRCVOIS,NBSDVOIS,LNRCVOIS,LNSDVOIS,
39 2 LENCOM)
40 USE spmd_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "task_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NBRCVOIS(*), NBSDVOIS(*), LNRCVOIS(*), LNSDVOIS(*),
54 . LENCOM
55 my_real
56 . x(3,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60#ifdef MPI
61 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
62 . REQ_S(NSPMD), REQ_R(NSPMD),
63 . loc_proc, n, nn, nbirecv, irindex(nspmd), ii, index,
64 . len
65 DATA msgoff/3000/
66 my_real
67 . wa(lencom*3)
68C-----------------------------------------------
69C
70C Updating X on adjacent domains
71C
72
73 loc_proc = ispmd+1
74 ideb = 0
75 ideb2 = 0
76 nbirecv = 0
77 DO i = 1, nspmd
78 msgtyp = msgoff
79 iad_recv(i) = ideb2+1
80 IF(nbrcvois(i)>0) THEN
81 nbirecv = nbirecv + 1
82 irindex(nbirecv) = i
83 len = 3*nbrcvois(i)
84 CALL spmd_irecv(wa(ideb2+1),len,it_spmd(i),msgtyp,req_r(nbirecv))
85 ideb2 = ideb2 + len
86 ENDIF
87 ENDDO
88C
89 ideb = 0
90 DO i = 1, nspmd
91 msgtyp = msgoff
92 len = nbsdvois(i)
93 IF(len>0) THEN
94 DO n = 1, len
95 nn = lnsdvois(ideb+n)
96 wa(ideb2+3*(n-1)+1) = x(1,nn)
97 wa(ideb2+3*(n-1)+2) = x(2,nn)
98 wa(ideb2+3*(n-1)+3) = x(3,nn)
99 ENDDO
100 CALL spmd_isend(wa(ideb2+1),len*3,it_spmd(i),msgtyp,req_s(i))
101 ideb = ideb + len
102 ideb2 = ideb2 + 3*len
103 ENDIF
104 ENDDO
105C
106 ideb = 0
107 DO ii = 1, nbirecv
108 CALL spmd_waitany(nbirecv,req_r,index)
109 i = irindex(index)
110 ideb2 = iad_recv(i)
111 ideb = (ideb2-1)/3
112 DO n = 1, nbrcvois(i)
113 nn = lnrcvois(ideb+n)
114 x(1,nn) = wa(ideb2+3*(n-1))
115 x(2,nn) = wa(ideb2+3*(n-1)+1)
116 x(3,nn) = wa(ideb2+3*(n-1)+2)
117 ENDDO
118 ENDDO
119C
120 DO i = 1, nspmd
121 IF(nbsdvois(i)>0) THEN
122 CALL spmd_wait(req_s(i))
123 ENDIF
124 ENDDO
125C
126#endif
127 RETURN
128 END
129!||====================================================================
130!|| spmd_wvois ../engine/source/mpi/fluid/spmd_cfd.F
131!||--- called by ------------------------------------------------------
132!|| alew ../engine/source/ale/grid/alew.F
133!||--- calls -----------------------------------------------------
134!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
135!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
136!||--- uses -----------------------------------------------------
137!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
138!||====================================================================
139 SUBROUTINE spmd_wvois(X ,D ,W ,NBRCVOIS,NBSDVOIS,
140 . LNRCVOIS,LNSDVOIS,LENCOM)
141 USE spmd_mod
142C-----------------------------------------------
143C I m p l i c i t T y p e s
144C-----------------------------------------------
145#include "implicit_f.inc"
146C-----------------------------------------------
147C M e s s a g e P a s s i n g
148C-----------------------------------------------
149#include "spmd.inc"
150C-----------------------------------------------
151C C o m m o n B l o c k s
152C-----------------------------------------------
153#include "com01_c.inc"
154#include "task_c.inc"
155C-----------------------------------------------
156C D u m m y A r g u m e n t s
157C-----------------------------------------------
158 INTEGER NBRCVOIS(*), NBSDVOIS(*), LNRCVOIS(*), LNSDVOIS(*),
159 . LENCOM
160 my_real X(3,*), D(3,*), W(3,*)
161C-----------------------------------------------
162C L o c a l V a r i a b l e s
163C-----------------------------------------------
164#ifdef MPI
165 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
166 . REQ_S(NSPMD), REQ_R(NSPMD),
167 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
168 . len
169 DATA msgoff/3001/
170 my_real wa(lencom*9)
171C-----------------------------------------------
172C
173C Updating X on adjacent domains
174C
175
176 loc_proc = ispmd+1
177 ideb = 0
178 ideb2 = 0
179 nbirecv = 0
180 DO i = 1, nspmd
181 msgtyp = msgoff
182 iad_recv(i) = ideb2+1
183 IF(nbrcvois(i)>0) THEN
184 nbirecv = nbirecv + 1
185 irindex(nbirecv) = i
186 len = 9*nbrcvois(i)
187 CALL spmd_irecv(wa(ideb2+1),len,it_spmd(i),msgtyp,req_r(nbirecv))
188 ideb2 = ideb2 + len
189 ENDIF
190 ENDDO
191C
192 ideb = 0
193 DO i = 1, nspmd
194 msgtyp = msgoff
195 len = nbsdvois(i)
196 IF(len>0) THEN
197 DO n = 1, len
198 nn = lnsdvois(ideb+n)
199 wa(ideb2+9*(n-1)+1) = x(1,nn)
200 wa(ideb2+9*(n-1)+2) = x(2,nn)
201 wa(ideb2+9*(n-1)+3) = x(3,nn)
202 wa(ideb2+9*(n-1)+4) = d(1,nn)
203 wa(ideb2+9*(n-1)+5) = d(2,nn)
204 wa(ideb2+9*(n-1)+6) = d(3,nn)
205 wa(ideb2+9*(n-1)+7) = w(1,nn)
206 wa(ideb2+9*(n-1)+8) = w(2,nn)
207 wa(ideb2+9*(n-1)+9) = w(3,nn)
208 ENDDO
209 CALL spmd_isend(wa(ideb2+1),len*9,it_spmd(i),msgtyp,req_s(i))
210 ideb = ideb + len
211 ideb2 = ideb2 + 9*len
212 ENDIF
213 ENDDO
214C
215 ideb = 0
216 DO ii = 1, nbirecv
217 CALL spmd_waitany(nbirecv,req_r,index)
218 i = irindex(index)
219 ideb2 = iad_recv(i)
220 ideb = (ideb2-1)/9
221 DO n = 1, nbrcvois(i)
222 nn = lnrcvois(ideb+n)
223 x(1,nn) = wa(ideb2+9*(n-1))
224 x(2,nn) = wa(ideb2+9*(n-1)+1)
225 x(3,nn) = wa(ideb2+9*(n-1)+2)
226 d(1,nn) = wa(ideb2+9*(n-1)+3)
227 d(2,nn) = wa(ideb2+9*(n-1)+4)
228 d(3,nn) = wa(ideb2+9*(n-1)+5)
229 w(1,nn) = wa(ideb2+9*(n-1)+6)
230 w(2,nn) = wa(ideb2+9*(n-1)+7)
231 w(3,nn) = wa(ideb2+9*(n-1)+8)
232 ENDDO
233 ENDDO
234C
235 DO i = 1, nspmd
236 IF(nbsdvois(i)>0) THEN
237 CALL spmd_wait(req_s(i))
238 ENDIF
239 ENDDO
240C
241
242#endif
243 RETURN
244 END
245
246!||====================================================================
247!|| spmd_evois ../engine/source/mpi/fluid/spmd_cfd.F
248!||--- called by ------------------------------------------------------
249!|| aeturb ../engine/source/ale/turbulence/aeturb.F
250!|| akturb ../engine/source/ale/turbulence/akturb.F
251!|| atherm ../engine/source/ale/atherm.F
252!||--- calls -----------------------------------------------------
253!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
254!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
255!||--- uses -----------------------------------------------------
256!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
257!||====================================================================
258 SUBROUTINE spmd_evois(
259 1 T ,VAL2 ,NERCVOIS,NESDVOIS,LERCVOIS,
260 2 LESDVOIS,LENCOM)
261 USE spmd_mod
262C-----------------------------------------------
263C I m p l i c i t T y p e s
264C-----------------------------------------------
265#include "implicit_f.inc"
266C-----------------------------------------------
267C M e s s a g e P a s s i n g
268C-----------------------------------------------
269#include "spmd.inc"
270C-----------------------------------------------
271C C o m m o n B l o c k s
272C-----------------------------------------------
273#include "com01_c.inc"
274#include "task_c.inc"
275C-----------------------------------------------
276C D u m m y A r g u m e n t s
277C-----------------------------------------------
278 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),
279 . LENCOM
280 my_real T(*), VAL2(*)
281C-----------------------------------------------
282C L o c a l V a r i a b l e s
283C-----------------------------------------------
284#ifdef MPI
285 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
286 . REQ_S(NSPMD), REQ_R(NSPMD),
287 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
288 . LEN
289 DATA MSGOFF/3002/
290 my_real
291 . wa(lencom*2)
292C-----------------------------------------------
293C
294C Updating X on adjacent domains
295C
296
297 loc_proc = ispmd+1
298 ideb = 0
299 ideb2 = 0
300 nbirecv = 0
301 DO i = 1, nspmd
302 msgtyp = msgoff
303 iad_recv(i) = ideb2+1
304 IF(nercvois(i)>0) THEN
305 nbirecv = nbirecv + 1
306 irindex(nbirecv) = i
307 len = 2*nercvois(i)
308 CALL spmd_irecv(wa(ideb2+1),len,it_spmd(i),msgtyp,req_r(nbirecv))
309 ideb2 = ideb2 + len
310 ENDIF
311 ENDDO
312C
313 ideb = 0
314 DO i = 1, nspmd
315 msgtyp = msgoff
316 len = nesdvois(i)
317 IF(len>0) THEN
318 DO n = 1, len
319 nn = lesdvois(ideb+n)
320 wa(ideb2+2*(n-1)+1) = t(nn)
321 wa(ideb2+2*(n-1)+2) = val2(nn)
322 ENDDO
323 CALL spmd_isend(wa(ideb2+1),len*2,it_spmd(i),msgtyp,req_s(i))
324 ideb = ideb + len
325 ideb2 = ideb2 + 2*len
326 ENDIF
327 ENDDO
328C
329 ideb = 0
330 DO ii = 1, nbirecv
331 CALL spmd_waitany(nbirecv,req_r,index)
332 i = irindex(index)
333 ideb2 = iad_recv(i)
334 ideb = (ideb2-1)/2
335 DO n = 1, nercvois(i)
336 nn = lercvois(ideb+n)
337 t(nn) = wa(ideb2+2*(n-1))
338 val2(nn) = wa(ideb2+2*(n-1)+1)
339 ENDDO
340 ENDDO
341C
342 DO i = 1, nspmd
343 IF(nesdvois(i)>0) THEN
344 CALL spmd_wait(req_s(i))
345 ENDIF
346 ENDDO
347C
348
349#endif
350 RETURN
351 END
352!||====================================================================
353!|| spmd_e1vois ../engine/source/mpi/fluid/spmd_cfd.F
354!||--- called by ------------------------------------------------------
355!|| aconve ../engine/source/ale/aconve.F
356!|| afluxt ../engine/source/ale/ale51/afluxt.F
357!|| agauge ../engine/source/ale/agauge.F
358!|| ale51_gradient_reconstruction ../engine/source/ale/alemuscl/ale51_gradient_reconstruction.F
359!|| ale51_gradient_reconstruction2 ../engine/source/ale/alemuscl/ale51_gradient_reconstruction2.F
360!|| alew6 ../engine/source/ale/grid/alew6.F
361!|| arezon ../engine/source/ale/arezon.F
362!|| multi_timeevolution ../engine/source/multifluid/multi_timeevolution.F
363!|| ns_fvm_diffusion ../engine/source/multifluid/ns_fvm_diffusion.F
364!|| prelecflow ../engine/source/elements/solid/solide/prelecflow.F
365!|| schlieren_buffer_gathering ../engine/source/output/anim/generate/schlieren_buffer_gathering.F
366!||--- calls -----------------------------------------------------
367!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
368!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
369!||--- uses -----------------------------------------------------
370!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
371!||====================================================================
372 SUBROUTINE spmd_e1vois(
373 1 PHI ,NERCVOIS,NESDVOIS,LERCVOIS,
374 2 LESDVOIS,LENCOM )
375 USE spmd_mod
376C-----------------------------------------------
377C I m p l i c i t T y p e s
378C-----------------------------------------------
379#include "implicit_f.inc"
380C-----------------------------------------------
381C M e s s a g e P a s s i n g
382C-----------------------------------------------
383#include "spmd.inc"
384C-----------------------------------------------
385C C o m m o n B l o c k s
386C-----------------------------------------------
387#include "com01_c.inc"
388#include "task_c.inc"
389C-----------------------------------------------
390C D u m m y A r g u m e n t s
391C-----------------------------------------------
392 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),LENCOM
393 my_real PHI(*)
394C-----------------------------------------------
395C L o c a l V a r i a b l e s
396C-----------------------------------------------
397#ifdef MPI
398 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
399 . req_s(nspmd), req_r(nspmd),
400 . loc_proc, n, nn, nbirecv, irindex(nspmd), ii, index,
401 . len
402 DATA msgoff/3003/
403 my_real wa(lencom)
404C-----------------------------------------------
405C
406C Updating Phi on adjacent elements
407C
408
409 loc_proc = ispmd+1
410 ideb = 0
411 ideb2 = 0
412 nbirecv = 0
413 DO i = 1, nspmd
414 msgtyp = msgoff
415 iad_recv(i) = ideb2+1
416 IF(nercvois(i)>0) THEN
417 nbirecv = nbirecv + 1
418 irindex(nbirecv) = i
419 len = nercvois(i)
420 CALL spmd_irecv(wa(ideb2+1),len,it_spmd(i),msgtyp,req_r(nbirecv))
421 ideb2 = ideb2 + len
422 ENDIF
423 ENDDO
424C
425 ideb = 0
426 DO i = 1, nspmd
427 msgtyp = msgoff
428 len = nesdvois(i)
429 IF(len>0) THEN
430 DO n = 1, len
431 nn = lesdvois(ideb+n)
432 wa(ideb2+n) = phi(nn)
433 ENDDO
434 CALL spmd_isend(wa(ideb2+1),len,it_spmd(i),msgtyp,req_s(i))
435 ideb = ideb + len
436 ideb2 = ideb2 + len
437 ENDIF
438 ENDDO
439C
440 DO ii = 1, nbirecv
441 CALL spmd_waitany(nbirecv,req_r,index)
442 i = irindex(index)
443 ideb = iad_recv(i)-1
444 DO n = 1, nercvois(i)
445 nn = lercvois(ideb+n)
446 phi(nn) = wa(ideb+n)
447 ENDDO
448 ENDDO
449C
450 DO i = 1, nspmd
451 IF(nesdvois(i)>0) THEN
452 CALL spmd_wait(req_s(i))
453 ENDIF
454 ENDDO
455C
456
457#endif
458 RETURN
459 END
460C
461!||====================================================================
462!|| spmd_e6vois ../engine/source/mpi/fluid/spmd_cfd.F
463!||--- called by ------------------------------------------------------
464!|| afluxt ../engine/source/ale/ale51/afluxt.F
465!||--- calls -----------------------------------------------------
466!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
467!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
468!||--- uses -----------------------------------------------------
469!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
470!||====================================================================
471 SUBROUTINE spmd_e6vois(
472 1 PHI ,NERCVOIS,NESDVOIS,LERCVOIS,
473 2 LESDVOIS,LENCOM )
474 USE spmd_mod
475C-----------------------------------------------
476C I m p l i c i t T y p e s
477C-----------------------------------------------
478#include "implicit_f.inc"
479C-----------------------------------------------
480C M e s s a g e P a s s i n g
481C-----------------------------------------------
482#include "spmd.inc"
483C-----------------------------------------------
484C C o m m o n B l o c k s
485C-----------------------------------------------
486#include "com01_c.inc"
487#include "com04_c.inc"
488#include "task_c.inc"
489#include "spmd_c.inc"
490C-----------------------------------------------
491C D u m m y A r g u m e n t s
492C-----------------------------------------------
493 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),LENCOM
494 my_real PHI(NUMELS+NSVOIS,6)
495C-----------------------------------------------
496C L o c a l V a r i a b l e s
497C-----------------------------------------------
498#ifdef MPI
499 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
500 . REQ_S(NSPMD), REQ_R(NSPMD),
501 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
502 . len
503 DATA msgoff/3004/
504 my_real
505 . wa(6,lencom)
506C-----------------------------------------------
507C
508C Updating Phi on adjacent elements
509C
510
511 loc_proc = ispmd+1
512 ideb = 0
513 ideb2 = 0
514 nbirecv = 0
515 DO i = 1, nspmd
516 msgtyp = msgoff
517 iad_recv(i) = ideb2+1
518 IF(nercvois(i)>0) THEN
519 nbirecv = nbirecv + 1
520 irindex(nbirecv) = i
521 len = nercvois(i)
522 CALL spmd_irecv(wa(1,ideb2+1),len*6,it_spmd(i),msgtyp,req_r(nbirecv))
523 ideb2 = ideb2 + len
524 ENDIF
525 ENDDO
526C
527 ideb = 0
528 DO i = 1, nspmd
529 msgtyp = msgoff
530 len = nesdvois(i)
531 IF(len>0) THEN
532 DO n = 1, len
533 nn = lesdvois(ideb+n)
534 wa(1,ideb2+n) = phi(nn,1)
535 wa(2,ideb2+n) = phi(nn,2)
536 wa(3,ideb2+n) = phi(nn,3)
537 wa(4,ideb2+n) = phi(nn,4)
538 wa(5,ideb2+n) = phi(nn,5)
539 wa(6,ideb2+n) = phi(nn,6)
540 ENDDO
541 CALL spmd_isend(wa(1,ideb2+1),len*6,it_spmd(i),msgtyp,req_s(i))
542 ideb = ideb + len
543 ideb2 = ideb2 + len
544 ENDIF
545 ENDDO
546C
547 DO ii = 1, nbirecv
548 CALL spmd_waitany(nbirecv,req_r,index)
549 i = irindex(index)
550 ideb = iad_recv(i)-1
551 DO n = 1, nercvois(i)
552 nn = lercvois(ideb+n)
553 phi(nn,1) = wa(1,ideb+n)
554 phi(nn,2) = wa(2,ideb+n)
555 phi(nn,3) = wa(3,ideb+n)
556 phi(nn,4) = wa(4,ideb+n)
557 phi(nn,5) = wa(5,ideb+n)
558 phi(nn,6) = wa(6,ideb+n)
559 ENDDO
560 ENDDO
561C
562 DO i = 1, nspmd
563 IF(nesdvois(i)>0) THEN
564 CALL spmd_wait(req_s(i))
565 ENDIF
566 ENDDO
567C
568
569#endif
570 RETURN
571 END
572
573!||====================================================================
574!|| spmd_e4vois ../engine/source/mpi/fluid/spmd_cfd.f
575!||--- called by ------------------------------------------------------
576!|| afluxt ../engine/source/ale/ale51/afluxt.F
577!||--- calls -----------------------------------------------------
578!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
579!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
580!||--- uses -----------------------------------------------------
581!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
582!||====================================================================
583 SUBROUTINE spmd_e4vois(
584 1 PHI ,NERCVOIS,NESDVOIS,LERCVOIS,
585 2 LESDVOIS,LENCOM )
586 USE spmd_mod
587C-----------------------------------------------
588C I m p l i c i t T y p e s
589C-----------------------------------------------
590#include "implicit_f.inc"
591C-----------------------------------------------
592C M e s s a g e P a s s i n g
593C-----------------------------------------------
594#include "spmd.inc"
595C-----------------------------------------------
596C C o m m o n B l o c k s
597C-----------------------------------------------
598#include "com01_c.inc"
599#include "com04_c.inc"
600#include "task_c.inc"
601#include "spmd_c.inc"
602C-----------------------------------------------
603C D u m m y A r g u m e n t s
604C-----------------------------------------------
605 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*), LENCOM
606 my_real PHI(NUMELQ+NQVOIS,4)
607C-----------------------------------------------
608C L o c a l V a r i a b l e s
609C-----------------------------------------------
610#ifdef MPI
611 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
612 . REQ_S(NSPMD), REQ_R(NSPMD),
613 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
614 . LEN
615 DATA MSGOFF/3004/
616 my_real
617 . wa(4,lencom)
618C-----------------------------------------------
619C
620C Updating Phi on adjacent elements
621C
622
623 loc_proc = ispmd+1
624 ideb = 0
625 ideb2 = 0
626 nbirecv = 0
627 DO i = 1, nspmd
628 msgtyp = msgoff
629 iad_recv(i) = ideb2+1
630 IF(nercvois(i)>0) THEN
631 nbirecv = nbirecv + 1
632 irindex(nbirecv) = i
633 len = nercvois(i)
634 CALL spmd_irecv(wa(1,ideb2+1),len*4,it_spmd(i),msgtyp,req_r(nbirecv))
635 ideb2 = ideb2 + len
636 ENDIF
637 ENDDO
638C
639 ideb = 0
640 DO i = 1, nspmd
641 msgtyp = msgoff
642 len = nesdvois(i)
643 IF(len>0) THEN
644 DO n = 1, len
645 nn = lesdvois(ideb+n)
646 wa(1,ideb2+n) = phi(nn,1)
647 wa(2,ideb2+n) = phi(nn,2)
648 wa(3,ideb2+n) = phi(nn,3)
649 wa(4,ideb2+n) = phi(nn,4)
650 ENDDO
651 CALL spmd_isend(wa(1,ideb2+1),len*4,it_spmd(i),msgtyp,req_s(i))
652 ideb = ideb + len
653 ideb2 = ideb2 + len
654 ENDIF
655 ENDDO
656C
657 DO ii = 1, nbirecv
658 CALL spmd_waitany(nbirecv,req_r,index)
659 i = irindex(index)
660 ideb = iad_recv(i)-1
661 DO n = 1, nercvois(i)
662 nn = lercvois(ideb+n)
663 phi(nn,1) = wa(1,ideb+n)
664 phi(nn,2) = wa(2,ideb+n)
665 phi(nn,3) = wa(3,ideb+n)
666 phi(nn,4) = wa(4,ideb+n)
667 ENDDO
668 ENDDO
669C
670 DO i = 1, nspmd
671 IF(nesdvois(i)>0) THEN
672 CALL spmd_wait(req_s(i))
673 ENDIF
674 ENDDO
675C
676
677#endif
678 RETURN
679 END
680!||====================================================================
681!|| spmd_envois ../engine/source/mpi/fluid/spmd_cfd.F
682!||--- called by ------------------------------------------------------
683!|| alemain ../engine/source/ale/alemain.F
684!|| alew6 ../engine/source/ale/grid/alew6.F
685!|| multi_timeevolution ../engine/source/multifluid/multi_timeevolution.F
686!||--- calls -----------------------------------------------------
687!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
688!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
689!||--- uses -----------------------------------------------------
690!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
691!||====================================================================
692 SUBROUTINE spmd_envois(DIM,
693 1 PHI ,NERCVOIS,NESDVOIS,LERCVOIS,
694 2 LESDVOIS,LENCOM )
695 USE spmd_mod
696C-----------------------------------------------
697C I m p l i c i t T y p e s
698C-----------------------------------------------
699#include "implicit_f.inc"
700C-----------------------------------------------
701C M e s s a g e P a s s i n g
702C-----------------------------------------------
703#include "spmd.inc"
704C-----------------------------------------------
705C C o m m o n B l o c k s
706C-----------------------------------------------
707#include "com01_c.inc"
708#include "task_c.inc"
709C-----------------------------------------------
710C D u m m y A r g u m e n t s
711C-----------------------------------------------
712 INTEGER :: DIM
713 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*), LENCOM
714 my_real PHI(*)
715C-----------------------------------------------
716C L o c a l V a r i a b l e s
717C-----------------------------------------------
718#ifdef MPI
719 INTEGER I, NDIM, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
720 . REQ_S(NSPMD), REQ_R(NSPMD),
721 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
722 . LEN
723 DATA MSGOFF/3004/
724 my_real
725 . wa(dim, lencom)
726C-----------------------------------------------
727C
728C Updating Phi on adjacent elements
729C
730
731 loc_proc = ispmd+1
732 ideb = 0
733 ideb2 = 0
734 nbirecv = 0
735 DO i = 1, nspmd
736 msgtyp = msgoff
737 iad_recv(i) = ideb2+1
738 IF(nercvois(i)>0) THEN
739 nbirecv = nbirecv + 1
740 irindex(nbirecv) = i
741 len = nercvois(i)
742 CALL spmd_irecv(wa(1,ideb2+1),len*dim,it_spmd(i),msgtyp,req_r(nbirecv))
743 ideb2 = ideb2 + len
744 ENDIF
745 ENDDO
746C
747 ideb = 0
748 DO i = 1, nspmd
749 msgtyp = msgoff
750 len = nesdvois(i)
751 IF(len>0) THEN
752 DO n = 1, len
753 nn = lesdvois(ideb+n)
754 DO ndim = 1, dim
755 wa(ndim,ideb2+n) = phi(dim * (nn - 1) + ndim)
756 ENDDO
757 ENDDO
758 CALL spmd_isend(wa(1,ideb2+1),len*dim,it_spmd(i),msgtyp,req_s(i))
759 ideb = ideb + len
760 ideb2 = ideb2 + len
761 ENDIF
762 ENDDO
763C
764 DO ii = 1, nbirecv
765 CALL spmd_waitany(nbirecv,req_r,index)
766 i = irindex(index)
767 ideb = iad_recv(i)-1
768 DO n = 1, nercvois(i)
769 nn = lercvois(ideb+n)
770 DO ndim = 1, dim
771 phi(dim * (nn - 1) + ndim) = wa(ndim,ideb+n)
772 ENDDO
773 ENDDO
774 ENDDO
775C
776 DO i = 1, nspmd
777 IF(nesdvois(i)>0) THEN
778 CALL spmd_wait(req_s(i))
779 ENDIF
780 ENDDO
781C
782
783#endif
784 RETURN
785 END
786!||====================================================================
787!|| spmd_i8vois ../engine/source/mpi/fluid/spmd_cfd.F
788!||--- called by ------------------------------------------------------
789!|| afluxt ../engine/source/ale/ale51/afluxt.F
790!||--- calls -----------------------------------------------------
791!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
792!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
793!||--- uses -----------------------------------------------------
794!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
795!||====================================================================
796 SUBROUTINE spmd_i8vois(
797 1 PHI ,NERCVOIS,NESDVOIS,LERCVOIS,LESDVOIS,
798 2 LENCOM)
799 USE spmd_mod
800C-----------------------------------------------
801C I m p l i c i t T y p e s
802C-----------------------------------------------
803#include "implicit_f.inc"
804C-----------------------------------------------
805C M e s s a g e P a s s i n g
806C-----------------------------------------------
807#include "spmd.inc"
808C-----------------------------------------------
809C C o m m o n B l o c k s
810C-----------------------------------------------
811#include "com01_c.inc"
812#include "com04_c.inc"
813#include "task_c.inc"
814#include "spmd_c.inc"
815C-----------------------------------------------
816C D u m m y A r g u m e n t s
817C-----------------------------------------------
818 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),
819 . PHI(NUMELS+NSVOIS,8), LENCOM
820C-----------------------------------------------
821C L o c a l V a r i a b l e s
822C-----------------------------------------------
823#ifdef MPI
824 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
825 . REQ_S(NSPMD), REQ_R(NSPMD),
826 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
827 . LEN, WA(8,LENCOM)
828 DATA MSGOFF/3006/
829C-----------------------------------------------
830C
831C Updating X on adjacent domains
832C
833
834 loc_proc = ispmd+1
835 ideb = 0
836 ideb2 = 0
837 nbirecv = 0
838 DO i = 1, nspmd
839 msgtyp = msgoff
840 iad_recv(i) = ideb2+1
841 IF(nercvois(i)>0) THEN
842 nbirecv = nbirecv + 1
843 irindex(nbirecv) = i
844 len = nercvois(i)
845 CALL spmd_irecv(
846 s wa(1,ideb2+1),len*8,it_spmd(i),msgtyp,
847 g req_r(nbirecv))
848 ideb2 = ideb2 + len
849 ENDIF
850 ENDDO
851C
852 ideb = 0
853 DO i = 1, nspmd
854 msgtyp = msgoff
855 len = nesdvois(i)
856 IF(len>0) THEN
857 DO n = 1, len
858 nn = lesdvois(ideb+n)
859 wa(1,ideb2+n) = phi(nn,1)
860 wa(2,ideb2+n) = phi(nn,2)
861 wa(3,ideb2+n) = phi(nn,3)
862 wa(4,ideb2+n) = phi(nn,4)
863 wa(5,ideb2+n) = phi(nn,5)
864 wa(6,ideb2+n) = phi(nn,6)
865 wa(7,ideb2+n) = phi(nn,7)
866 wa(8,ideb2+n) = phi(nn,8)
867
868 ENDDO
869 CALL spmd_isend(
870 s wa(1,ideb2+1),len*8,it_spmd(i),msgtyp,
871 g req_s(i))
872 ideb = ideb + len
873 ideb2 = ideb2 + len
874 ENDIF
875 ENDDO
876C
877 ideb = 0
878 DO ii = 1, nbirecv
879 CALL spmd_waitany(nbirecv,req_r,index)
880 i = irindex(index)
881 ideb = iad_recv(i)-1
882 DO n = 1, nercvois(i)
883 nn = lercvois(ideb+n)
884 phi(nn,1) = wa(1,ideb+n)
885 phi(nn,2) = wa(2,ideb+n)
886 phi(nn,3) = wa(3,ideb+n)
887 phi(nn,4) = wa(4,ideb+n)
888 phi(nn,5) = wa(5,ideb+n)
889 phi(nn,6) = wa(6,ideb+n)
890 phi(nn,7) = wa(7,ideb+n)
891 phi(nn,8) = wa(8,ideb+n)
892 ENDDO
893 ENDDO
894C
895 DO i = 1, nspmd
896 IF(nesdvois(i)>0) THEN
897 CALL spmd_wait(req_s(i))
898 ENDIF
899 ENDDO
900C
901
902#endif
903 RETURN
904 END
905
906!||====================================================================
907!|| spmd_i4vois ../engine/source/mpi/fluid/spmd_cfd.F
908!||--- called by ------------------------------------------------------
909!|| afluxt ../engine/source/ale/ale51/afluxt.F
910!||--- calls -----------------------------------------------------
911!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
912!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
913!||--- uses -----------------------------------------------------
914!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
915!||====================================================================
916 SUBROUTINE spmd_i4vois(
917 1 PHI ,NERCVOIS,NESDVOIS,LERCVOIS,LESDVOIS,
918 2 LENCOM)
919 USE spmd_mod
920C-----------------------------------------------
921C I m p l i c i t T y p e s
922C-----------------------------------------------
923#include "implicit_f.inc"
924C-----------------------------------------------
925C M e s s a g e P a s s i n g
926C-----------------------------------------------
927#include "spmd.inc"
928C-----------------------------------------------
929C C o m m o n B l o c k s
930C-----------------------------------------------
931#include "com01_c.inc"
932#include "com04_c.inc"
933#include "task_c.inc"
934#include "spmd_c.inc"
935C-----------------------------------------------
936C D u m m y A r g u m e n t s
937C-----------------------------------------------
938 INTEGER NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),
939 . PHI(NUMELQ+NQVOIS,4), LENCOM
940C-----------------------------------------------
941C L o c a l V a r i a b l e s
942C-----------------------------------------------
943#ifdef MPI
944 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
945 . REQ_S(NSPMD), REQ_R(NSPMD),
946 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), II, INDEX,
947 . LEN, WA(4,LENCOM)
948 DATA MSGOFF/3006/
949C-----------------------------------------------
950C
951C Updating X on adjacent domains
952C
953
954 LOC_PROC = ispmd+1
955 ideb = 0
956 ideb2 = 0
957 nbirecv = 0
958 DO i = 1, nspmd
959 msgtyp = msgoff
960 iad_recv(i) = ideb2+1
961 IF(nercvois(i)>0) THEN
962 nbirecv = nbirecv + 1
963 irindex(nbirecv) = i
964 len = nercvois(i)
965 CALL spmd_irecv(
966 s wa(1,ideb2+1),len*4,it_spmd(i),msgtyp,
967 g req_r(nbirecv))
968 ideb2 = ideb2 + len
969 ENDIF
970 ENDDO
971C
972 ideb = 0
973 DO i = 1, nspmd
974 msgtyp = msgoff
975 len = nesdvois(i)
976 IF(len>0) THEN
977 DO n = 1, len
978 nn = lesdvois(ideb+n)
979 wa(1,ideb2+n) = phi(nn,1)
980 wa(2,ideb2+n) = phi(nn,2)
981 wa(3,ideb2+n) = phi(nn,3)
982 wa(4,ideb2+n) = phi(nn,4)
983 ENDDO
984 CALL spmd_isend(
985 s wa(1,ideb2+1),len*4,it_spmd(i),msgtyp,
986 g req_s(i))
987 ideb = ideb + len
988 ideb2 = ideb2 + len
989 ENDIF
990 ENDDO
991C
992 ideb = 0
993 DO ii = 1, nbirecv
994 CALL spmd_waitany(nbirecv,req_r,index)
995 i = irindex(index)
996 ideb = iad_recv(i)-1
997 DO n = 1, nercvois(i)
998 nn = lercvois(ideb+n)
999 phi(nn,1) = wa(1,ideb+n)
1000 phi(nn,2) = wa(2,ideb+n)
1001 phi(nn,3) = wa(3,ideb+n)
1002 phi(nn,4) = wa(4,ideb+n)
1003 ENDDO
1004 ENDDO
1005C
1006 DO i = 1, nspmd
1007 IF(nesdvois(i)>0) THEN
1008 CALL spmd_wait(req_s(i))
1009 ENDIF
1010 ENDDO
1011C
1012
1013#endif
1014 RETURN
1015 END
1016!||====================================================================
1017!|| spmd_l11vois ../engine/source/mpi/fluid/spmd_cfd.F
1018!||--- called by ------------------------------------------------------
1019!|| alemain ../engine/source/ale/alemain.F
1020!||--- calls -----------------------------------------------------
1021!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
1022!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
1023!||--- uses -----------------------------------------------------
1024!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1025!|| element_mod ../common_source/modules/elements/element_mod.F90
1026!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1027!||====================================================================
1028 SUBROUTINE spmd_l11vois(
1029 1 LBVOIS ,IPARG ,ELBUF_TAB,PM ,IXS,
1030 2 IXQ ,NERCVOIS,NESDVOIS,LERCVOIS,LESDVOIS,
1031 3 LENCOM )
1032C-----------------------------------------------
1033C M o d u l e s
1034C-----------------------------------------------
1035 USE elbufdef_mod
1036 USE spmd_mod
1037 use element_mod , only : nixs,nixq
1038C-----------------------------------------------
1039C I m p l i c i t T y p e s
1040C-----------------------------------------------
1041#include "implicit_f.inc"
1042C-----------------------------------------------
1043C M e s s a g e P a s s i n g
1044C-----------------------------------------------
1045#include "spmd.inc"
1046C-----------------------------------------------
1047C C o m m o n B l o c k s
1048C-----------------------------------------------
1049#include "com01_c.inc"
1050#include "com04_c.inc"
1051#include "task_c.inc"
1052#include "param_c.inc"
1053C-----------------------------------------------
1054C D u m m y A r g u m e n t s
1055C-----------------------------------------------
1056 INTEGER IPARG(NPARG,*),IXS(NIXS,*), IXQ(NIXQ,*),
1057 . nercvois(*), nesdvois(*), lercvois(*), lesdvois(*),
1058 . lencom
1059 my_real lbvois(6,*), pm(npropm,*)
1060 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
1061C-----------------------------------------------
1062C L o c a l V a r i a b l e s
1063C-----------------------------------------------
1064#ifdef MPI
1065 INTEGER I,II,JJ,IDEB,IDEB2,MSGOFF,MSGTYP,IAD_RECV(NSPMD),
1066 . REQ_S(NSPMD), REQ_R(NSPMD),
1067 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), INDEX,
1068 . LEN, ML, NI, KTY, KLT, MFT, IS,
1069 . KB1, KB2, KB3 ,KB4 ,KB10, KB11, KB12, KKB2,
1070 . G_PLA,G_RK,L_RE,L_TEMP,KK(6),K
1071 DATA MSGOFF/3007/
1072 my_real WA(6*LENCOM)
1073 my_real ELBUF(10000) ! contents not used
1074 TYPE(G_BUFEL_) ,POINTER :: GBUF
1075 TYPE(L_BUFEL_) ,POINTER :: LBUF
1076C-----------------------------------------------
1077C
1078C Updating X on adjacent domains
1079C
1080
1081 loc_proc = ispmd+1
1082 ideb = 0
1083 ideb2 = 0
1084 nbirecv = 0
1085 DO i = 1, nspmd
1086 msgtyp = msgoff
1087 iad_recv(i) = ideb2+1
1088 IF(nercvois(i)>0) THEN
1089 nbirecv = nbirecv + 1
1090 irindex(nbirecv) = i
1091 len = 6*nercvois(i)
1092 CALL spmd_irecv(
1093 s wa(ideb2+1) , len, it_spmd(i) , msgtyp,
1094 g req_r(nbirecv) )
1095 ideb2 = ideb2 + len
1096 ENDIF
1097 ENDDO
1098 ideb = 0
1099 DO i = 1, nspmd
1100 msgtyp = msgoff
1101 len = nesdvois(i)
1102 IF(len>0) THEN
1103 kty = -1
1104 klt = -1
1105 mft = -1
1106 DO n = 1, len
1107 ii = ideb2+6*(n-1)
1108 nn = lesdvois(ideb+n)
1109 ! Searching in element buffer : sending if material law /= 11
1110 IF (n2d == 0) THEN
1111 ml=nint(pm(19,ixs(1,nn)))
1112 ELSE
1113 ml=nint(pm(19,ixq(1,nn)))
1114 ENDIF
1115
1116 IF (ml /= 11) THEN
1117 DO ni=1,ngroup
1118 gbuf => elbuf_tab(ni)%GBUF
1119 lbuf => elbuf_tab(ni)%BUFLY(1)%LBUF(1,1,1)
1120 kty = iparg(5,ni)
1121 klt = iparg(2,ni)
1122 mft = iparg(3,ni)
1123 IF( (kty == 1.OR.kty == 2).AND.(nn<=klt+mft) .AND. nn>mft) THEN
1124 g_pla = elbuf_tab(ni)%GBUF%G_PLA
1125 g_rk = elbuf_tab(ni)%GBUF%G_RK
1126 l_re = elbuf_tab(ni)%BUFLY(1)%L_RE
1127 l_temp= elbuf_tab(ni)%BUFLY(1)%L_TEMP
1128 is = nn-mft
1129!
1130 DO k=1,6
1131 kk(k) = klt*(k-1)
1132 ENDDO
1133!
1134 wa(ii+1) =-(gbuf%SIG(kk(1)+is)+gbuf%SIG(kk(2)+is)+ gbuf%SIG(kk(3)+is))*third
1135 wa(ii+2) = gbuf%EINT(is)
1136 wa(ii+3) = gbuf%RHO(is)
1137 IF (g_pla > 0) THEN
1138 wa(ii+4) = gbuf%PLA(is)
1139 ELSEIF (g_rk > 0) THEN
1140 wa(ii+4) = gbuf%RK(is)
1141 ELSE
1142 wa(ii+4) = zero
1143 ENDIF
1144 IF (l_temp > 0)THEN
1145 wa(ii+5) = lbuf%TEMP(is)
1146 ELSE
1147 wa(ii+5) = zero
1148 ENDIF
1149 IF (l_re > 0) THEN
1150 wa(ii+6) = lbuf%RE(is)
1151 ELSE
1152 wa(ii+6) = zero
1153 ENDIF
1154 EXIT
1155 ENDIF
1156 enddo!next NI
1157 ELSE ! ML == 11
1158 wa(ii+1) = zero
1159 wa(ii+2) = zero
1160 wa(ii+3) = zero
1161 wa(ii+4) = zero
1162 wa(ii+5) = zero
1163 wa(ii+6) = zero
1164 ENDIF
1165 enddo!next N
1166 CALL spmd_isend(
1167 s wa(ideb2+1) ,len*6 ,it_spmd(i) , msgtyp,
1168 g req_s(i) )
1169 ideb = ideb + len
1170 ideb2 = ideb2 + 6*len
1171 ENDIF
1172 ENDDO
1173
1174 ideb = 0
1175 DO ii = 1, nbirecv
1176 CALL spmd_waitany(nbirecv,req_r,index)
1177 i = irindex(index)
1178 ideb2 = iad_recv(i)
1179 ideb = (ideb2-1)/6
1180 DO n = 1, nercvois(i)
1181 jj = ideb2+6*(n-1)
1182 nn = lercvois(ideb+n)-numels-numelq
1183 lbvois(1,nn) = wa(jj)
1184 lbvois(2,nn) = wa(jj+1)
1185 lbvois(3,nn) = wa(jj+2)
1186 lbvois(4,nn) = wa(jj+3)
1187 lbvois(5,nn) = wa(jj+4)
1188 lbvois(6,nn) = wa(jj+5)
1189 ENDDO
1190 ENDDO
1191
1192 DO i = 1, nspmd
1193 IF(nesdvois(i)>0) THEN
1194 CALL spmd_wait(req_s(i))
1195 ENDIF
1196 ENDDO
1197
1198#endif
1199 RETURN
1200 END
1201!||====================================================================
1202!|| spmd_exalew ../engine/source/mpi/fluid/spmd_cfd.F
1203!||--- called by ------------------------------------------------------
1204!|| alew2 ../engine/source/ale/grid/alew2.F
1205!|| alew4 ../engine/source/ale/grid/alew4.F
1206!||--- calls -----------------------------------------------------
1207!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
1208!||--- uses -----------------------------------------------------
1209!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1210!||====================================================================
1211 SUBROUTINE spmd_exalew(WA,WB,IAD_ELEM,FR_ELEM,NALE,SIZE,LENR)
1212 USE spmd_mod
1213C-----------------------------------------------
1214C D e s c r i p t i o n
1215C-----------------------------------------------
1216C Sum of grid velocities WA,WB at boundary nodes. Parith/off
1217C-----------------------------------------------
1218C I m p l i c i t T y p e s
1219C-----------------------------------------------
1220#include "implicit_f.inc"
1221C-----------------------------------------------------------------
1222C M e s s a g e P a s s i n g
1223C-----------------------------------------------
1224#include "spmd.inc"
1225C-----------------------------------------------
1226C C o m m o n B l o c k s
1227C-----------------------------------------------
1228#include "com01_c.inc"
1229#include "task_c.inc"
1230C-----------------------------------------------
1231C D u m m y A r g u m e n t s
1232C-----------------------------------------------
1233 INTEGER IAD_ELEM(2,*), FR_ELEM(*), NALE(*),
1234 . SIZE, LENR
1235 my_real
1236 . WA(3,*),WB(3,*)
1237C-----------------------------------------------
1238C L o c a l V a r i a b l e s
1239C-----------------------------------------------
1240#ifdef MPI
1241 INTEGER MSGTYP,I,NOD,LOC_PROC,SIZ,J, L
1242 INTEGER IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),REQ_R(NSPMD),REQ_S(NSPMD), MSGOFF
1243 my_real RBUF(SIZE*LENR), SBUF(SIZE*LENR)
1244 DATA MSGOFF/3008/
1245C-----------------------------------------------
1246C S o u r c e L i n e s
1247C-----------------------------------------------
1248C
1249
1250 LOC_PROC = ispmd + 1
1251 l = 1
1252 iad_recv(1) = 1
1253C SIZE = 6
1254 DO i=1,nspmd
1255 siz = size*(iad_elem(1,i+1)-iad_elem(1,i))
1256 IF(siz/=0)THEN
1257 msgtyp = msgoff
1258 CALL spmd_irecv(
1259 s rbuf(l),siz,it_spmd(i),msgtyp,
1260 g req_r(i))
1261 l = l + siz
1262 ENDIF
1263 iad_recv(i+1) = l
1264 END DO
1265C
1266 l = 1
1267 iad_send(1) = l
1268 DO i=1,nspmd
1269#include "vectorize.inc"
1270 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1271 nod = fr_elem(j)
1272 IF(iabs(nale(nod)) == 1) THEN
1273 sbuf(l ) = wa(1,nod)
1274 sbuf(l+1) = wa(2,nod)
1275 sbuf(l+2) = wa(3,nod)
1276 sbuf(l+3) = wb(1,nod)
1277 sbuf(l+4) = wb(2,nod)
1278 sbuf(l+5) = wb(3,nod)
1279 l = l + SIZE
1280 ENDIF
1281 ENDDO
1282 iad_send(i+1) = l
1283 ENDDO
1284C
1285 DO i=1,nspmd
1286 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1287 msgtyp = msgoff
1288 siz = iad_send(i+1)-iad_send(i)
1289 l = iad_send(i)
1290 CALL spmd_isend(
1291 s sbuf(l),siz,it_spmd(i),msgtyp,
1292 g req_s(i))
1293 ENDIF
1294 ENDDO
1295C
1296C decompaction
1297C
1298 DO i = 1, nspmd
1299 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1300 CALL spmd_wait(req_r(i))
1301 l = iad_recv(i)
1302#include "vectorize.inc"
1303 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1304 nod = fr_elem(j)
1305 IF(iabs(nale(nod)) == 1) THEN
1306 wa(1,nod) = wa(1,nod) + rbuf(l )
1307 wa(2,nod) = wa(2,nod) + rbuf(l+1)
1308 wa(3,nod) = wa(3,nod) + rbuf(l+2)
1309 wb(1,nod) = wb(1,nod) + rbuf(l+3)
1310 wb(2,nod) = wb(2,nod) + rbuf(l+4)
1311 wb(3,nod) = wb(3,nod) + rbuf(l+5)
1312 l = l + SIZE
1313 END IF
1314 ENDDO
1315 ENDIF
1316 END DO
1317C
1318C Wait terminaison isend
1319C
1320 DO i = 1, nspmd
1321 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
1322 . CALL spmd_wait(req_s(i))
1323 ENDDO
1324C
1325
1326#endif
1327 RETURN
1328 END
1329C
1330!||====================================================================
1331!|| spmd_exalew_pon ../engine/source/mpi/fluid/spmd_cfd.F
1332!||--- called by ------------------------------------------------------
1333!|| alew2 ../engine/source/ale/grid/alew2.F
1334!|| alew4 ../engine/source/ale/grid/alew4.F
1335!||--- calls -----------------------------------------------------
1336!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
1337!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
1338!||--- uses -----------------------------------------------------
1339!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1340!||====================================================================
1341 SUBROUTINE spmd_exalew_pon(
1342 1 FSKY ,FSKYV ,IAD_ELEM,FR_ELEM,NALE,
1343 2 ADDCNE,PROCNE,FR_NBCC ,SIZE ,LENR,
1344 3 LENS )
1345 USE spmd_mod
1346C-----------------------------------------------
1347C D e s c r i p t i o n
1348C-----------------------------------------------
1349C Sum of grid velocities WA,WB at boundary nodes. Parith/on
1350C-----------------------------------------------
1351C I m p l i c i t T y p e s
1352C-----------------------------------------------
1353#include "implicit_f.inc"
1354C-----------------------------------------------
1355C M e s s a g e P a s s i n g
1356C-----------------------------------------------
1357#include "spmd.inc"
1358C-----------------------------------------------
1359C C o m m o n B l o c k s
1360C-----------------------------------------------
1361#include "com01_c.inc"
1362#include "task_c.inc"
1363#include "parit_c.inc"
1364C-----------------------------------------------
1365C D u m m y A r g u m e n t s
1366C-----------------------------------------------
1367 INTEGER IAD_ELEM(2,*),FR_ELEM(*),FR_NBCC(2,*),NALE(*),ADDCNE(*), PROCNE(*),SIZE, LENR ,LENS
1368 my_real fsky(8,lsky), fskyv(lsky,8)
1369C-----------------------------------------------
1370C L o c a l V a r i a b l e s
1371C-----------------------------------------------
1372#ifdef MPI
1373 INTEGER MSGTYP,I,NOD,LOC_PROC,SIZ,J,L,CC,NBIRECV,
1374 . II, INDEX,
1375 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
1376 . REQ_R(NSPMD),REQ_S(NSPMD),IRINDEX(NSPMD),MSGOFF
1377 my_real RBUF(SIZE*LENR+1), SBUF(SIZE*LENS)
1378 DATA MSGOFF/3009/
1379C-----------------------------------------------
1380C S o u r c e L i n e s
1381C-----------------------------------------------
1382C
1383
1384 LOC_PROC = ispmd + 1
1385C SIZE = 6
1386C
1387 nbirecv = 0
1388 l = 1
1389 iad_recv(1) = 1
1390 DO i=1,nspmd
1391 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
1392 msgtyp = msgoff
1393 siz = size*fr_nbcc(2,i)
1394 nbirecv = nbirecv + 1
1395 irindex(nbirecv) = i
1396 CALL spmd_irecv(
1397 s rbuf(l),siz,it_spmd(i),msgtyp,
1398 g req_r(nbirecv))
1399 l = l + siz
1400 ENDIF
1401 iad_recv(i+1) = l
1402 END DO
1403C
1404 l = 1
1405 iad_send(1) = l
1406 DO i=1,nspmd
1407 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1408 nod = fr_elem(j)
1409 IF(iabs(nale(nod)) == 1) THEN
1410 IF(ivector == 1) THEN
1411 ELSE
1412 DO cc = addcne(nod),addcne(nod+1)-1
1413 IF(procne(cc) == loc_proc) THEN
1414 sbuf(l) = fsky(1,cc)
1415 sbuf(l+1) = fsky(2,cc)
1416 sbuf(l+2) = fsky(3,cc)
1417 sbuf(l+3) = fsky(4,cc)
1418 sbuf(l+4) = fsky(5,cc)
1419 sbuf(l+5) = fsky(6,cc)
1420 l = l + SIZE
1421 ENDIF
1422 ENDDO
1423 ENDIF
1424 ENDIF
1425 ENDDO
1426 iad_send(i+1) = l
1427 ENDDO
1428C
1429 DO i=1,nspmd
1430 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1431 siz = iad_send(i+1)-iad_send(i)
1432 l = iad_send(i)
1433 msgtyp = msgoff
1434 CALL spmd_isend(
1435 s sbuf(l),siz,it_spmd(i),msgtyp,
1436 g req_s(i))
1437 ENDIF
1438 ENDDO
1439C
1440C decompaction
1441C
1442 DO ii=1,nbirecv
1443 CALL spmd_waitany(nbirecv,req_r,index)
1444 i = irindex(index)
1445 l = iad_recv(i)
1446 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1447 nod = fr_elem(j)
1448 IF(iabs(nale(nod)) == 1) THEN
1449 IF(ivector == 1) THEN
1450 ELSE
1451 DO cc = addcne(nod), addcne(nod+1)-1
1452 IF(procne(cc) == i) THEN
1453 fsky(1,cc) = rbuf(l)
1454 fsky(2,cc) = rbuf(l+1)
1455 fsky(3,cc) = rbuf(l+2)
1456 fsky(4,cc) = rbuf(l+3)
1457 fsky(5,cc) = rbuf(l+4)
1458 fsky(6,cc) = rbuf(l+5)
1459 l = l + SIZE
1460 ENDIF
1461 ENDDO
1462 ENDIF
1463 ENDIF
1464 ENDDO
1465 ENDDO
1466
1467C
1468C Wait terminaison isend
1469 DO i = 1, nspmd
1470 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
1471 siz = iad_send(i+1)-iad_send(i)
1472 CALL spmd_wait(req_s(i))
1473 ENDIF
1474 ENDDO
1475C
1476
1477#endif
1478 RETURN
1479 END
1480C
1481!||====================================================================
1482!|| spmd_glob_dmin9 ../engine/source/mpi/fluid/spmd_cfd.F
1483!||--- called by ------------------------------------------------------
1484!|| wrrestp ../engine/source/output/restart/wrrestp.F
1485!||--- calls -----------------------------------------------------
1486!||--- uses -----------------------------------------------------
1487!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1488!||====================================================================
1489 SUBROUTINE spmd_glob_dmin9(V,LEN)
1490 USE spmd_mod
1491C-----------------------------------------------
1492C D e s c r i p t i o n
1493C-----------------------------------------------
1494C minimum of array V (length=LEN) of type my_real
1495C-----------------------------------------------
1496C I m p l i c i t T y p e s
1497C-----------------------------------------------
1498#include "implicit_f.inc"
1499C-----------------------------------------------------------------
1500C M e s s a g e P a s s i n g
1501C-----------------------------------------------
1502#include "spmd.inc"
1503C-----------------------------------------------
1504C C o m m o n B l o c k s
1505C-----------------------------------------------
1506#include "task_c.inc"
1507C-----------------------------------------------
1508C D u m m y A r g u m e n t s
1509C-----------------------------------------------
1510 INTEGER LEN
1511 my_real V(LEN)
1512C-----------------------------------------------
1513C L o c a l V a r i a b l e s
1514C-----------------------------------------------
1515#ifdef MPI
1516 INTEGER MSGTYP,INFO,I,K,ATID,ATAG,ALEN
1517 my_real VTMP(LEN)
1518C-----------------------------------------------
1519C S o u r c e L i n e s
1520C-----------------------------------------------
1521
1522 IF (LEN > 0) THEN
1523 CALL SPMD_REDUCE(V,VTMP,LEN,
1524 . SPMD_MIN,IT_SPMD(1))
1525 ENDIF
1526 IF (ISPMD == 0) then
1527 DO i=1,len
1528 v(i) = vtmp(i)
1529 END DO
1530 ENDIF
1531C
1532
1533#endif
1534 RETURN
1535 END
1536!||====================================================================
1537!|| spmd_extag ../engine/source/mpi/fluid/spmd_cfd.F
1538!||--- called by ------------------------------------------------------
1539!|| rgwat2 ../engine/source/interfaces/int09/rgwat2.F
1540!|| rgwat3 ../engine/source/interfaces/int09/rgwat3.F
1541!||--- calls -----------------------------------------------------
1542!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
1543!||--- uses -----------------------------------------------------
1544!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1545!||====================================================================
1546 SUBROUTINE spmd_extag(NTAG,IAD_ELEM,FR_ELEM,LENR)
1547 USE spmd_mod
1548C-----------------------------------------------
1549C D e s c r i p t i o n
1550C-----------------------------------------------
1551C Sum of tags
1552C-----------------------------------------------
1553C I m p l i c i t T y p e s
1554C-----------------------------------------------
1555#include "implicit_f.inc"
1556C-----------------------------------------------------------------
1557C M e s s a g e P a s s i n g
1558C-----------------------------------------------
1559#include "spmd.inc"
1560C-----------------------------------------------
1561C C o m m o n B l o c k s
1562C-----------------------------------------------
1563#include "com01_c.inc"
1564#include "task_c.inc"
1565C-----------------------------------------------
1566C D u m m y A r g u m e n t s
1567C-----------------------------------------------
1568 INTEGER IAD_ELEM(2,*), FR_ELEM(*), SIZE, LENR, NTAG(*)
1569C-----------------------------------------------
1570C L o c a l V a r i a b l e s
1571C-----------------------------------------------
1572#ifdef MPI
1573 INTEGER MSGTYP,I,NOD,LOC_PROC,NB_NOD,
1574 . SIZ,J, L,
1575 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
1576 . REQ_R(NSPMD),REQ_S(NSPMD),
1577 . RBUF(LENR), SBUF(LENR) ,MSGOFF
1578 DATA MSGOFF/3011/
1579C-----------------------------------------------
1580C S o u r c e L i n e s
1581C-----------------------------------------------
1582C
1583
1584 LOC_PROC = ispmd + 1
1585C
1586 l = 1
1587 iad_recv(1) = 1
1588 DO i=1,nspmd
1589 siz = iad_elem(1,i+1)-iad_elem(1,i)
1590 IF(siz/=0)THEN
1591 msgtyp = msgoff
1592 CALL spmd_irecv(
1593 s rbuf(l),siz,it_spmd(i),msgtyp,
1594 g req_r(i))
1595 l = l + siz
1596 ENDIF
1597 iad_recv(i+1) = l
1598 END DO
1599C
1600 l = 1
1601 iad_send(1) = l
1602 DO i=1,nspmd
1603#include "vectorize.inc"
1604 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1605 nod = fr_elem(j)
1606 IF(ntag(nod)>0) THEN
1607C removing initial tag already treated locally
1608 sbuf(l) = ntag(nod)-1
1609 ELSE
1610 sbuf(l) = 0
1611 END IF
1612 l=l+1
1613 END DO
1614 iad_send(i+1) = l
1615 ENDDO
1616C
1617 DO i=1,nspmd
1618 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1619 msgtyp = msgoff
1620 siz = iad_send(i+1)-iad_send(i)
1621 l = iad_send(i)
1622 CALL spmd_isend(
1623 s sbuf(l),siz,it_spmd(i),msgtyp,
1624 g req_s(i))
1625 ENDIF
1626 ENDDO
1627C
1628C decompaction
1629C
1630 DO i = 1, nspmd
1631 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
1632 IF(nb_nod>0)THEN
1633 CALL spmd_wait(req_r(i))
1634 l = iad_recv(i)
1635#include "vectorize.inc"
1636 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1637 nod = fr_elem(j)
1638 ntag(nod) = ntag(nod)+rbuf(l)
1639 l = l + 1
1640 ENDDO
1641 ENDIF
1642 END DO
1643C Wait terminaison isend
1644 DO i = 1, nspmd
1645 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
1646 . CALL spmd_wait(req_s(i))
1647 ENDDO
1648C
1649
1650#endif
1651 RETURN
1652 END
1653C
1654!||====================================================================
1655!|| spmd_segcom ../engine/source/mpi/fluid/spmd_cfd.F
1656!||--- called by ------------------------------------------------------
1657!|| alemain ../engine/source/ale/alemain.F
1658!||--- calls -----------------------------------------------------
1659!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
1660!||--- uses -----------------------------------------------------
1661!|| ale_mod ../common_source/modules/ale/ale_mod.f
1662!|| segvar_mod ../engine/share/modules/segvar_mod.F
1663!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1664!||====================================================================
1665 SUBROUTINE spmd_segcom(SEGVAR,NPSEGCOM,LSEGCOM,SIZE,FLAG)
1666C-----------------------------------------------
1667C M o d u l e s
1668C-----------------------------------------------
1669 USE segvar_mod
1670 USE ale_mod
1671 USE spmd_mod
1672C-----------------------------------------------
1673C I m p l i c i t T y p e s
1674C-----------------------------------------------
1675#include "implicit_f.inc"
1676C-----------------------------------------------
1677C M e s s a g e P a s s i n g
1678C-----------------------------------------------
1679#include "spmd.inc"
1680C-----------------------------------------------
1681C C o m m o n B l o c k s
1682C-----------------------------------------------
1683#include "com01_c.inc"
1684#include "task_c.inc"
1685C-----------------------------------------------
1686C D u m m y A r g u m e n t s
1687C-----------------------------------------------
1688 INTEGER NPSEGCOM(*), LSEGCOM(*), FLAG, SIZE
1689 TYPE(t_segvar) :: SEGVAR
1690C-----------------------------------------------
1691C L o c a l V a r i a b l e s
1692C-----------------------------------------------
1693#ifdef MPI
1694 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
1695 . REQ_R(NSPMD), IRINDEX(NSPMD),
1696 . LOC_PROC, N, KK, NN, NBIRECV, II, INDEX, LEN
1697 DATA MSGOFF/3012/
1698 my_real WA(SIZE*ALE%GLOBAL%NVCONV)
1699C-----------------------------------------------
1700
1701 LOC_PROC = ispmd+1
1702 IF(flag == 0) THEN
1703C
1704C Sending segvar from pi to p0
1705C
1706 IF(loc_proc/=1)THEN
1707 msgtyp = msgoff
1708 len = npsegcom(1)
1709 IF(len>0) THEN
1710 DO n = 1, len
1711 kk = lsegcom(n)
1712
1713 nn=1
1714 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1715 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RHO(kk)
1716 ENDIF
1717
1718 nn=2
1719 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1720 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%EINT(kk)
1721 ENDIF
1722
1723 nn=3
1724 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1725 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RK(kk)
1726 ENDIF
1727
1728 nn=4
1729 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1730 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RE(kk)
1731 ENDIF
1732
1733 nn=5
1734 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1735 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%UVAR(kk)
1736 ENDIF
1737
1738 ENDDO
1739 CALL spmd_send(
1740 s wa ,len*ale%GLOBAL%NVCONV,it_spmd(1),msgtyp)
1741 ENDIF
1742C
1743 ELSE
1744 ideb = 0
1745 nbirecv = 0
1746 DO i = 2, nspmd
1747 msgtyp = msgoff
1748 iad_recv(i) = ideb+1
1749 IF(npsegcom(i)>0) THEN
1750 nbirecv = nbirecv + 1
1751 irindex(nbirecv) = i
1752 len = ale%GLOBAL%NVCONV*npsegcom(i)
1753 CALL spmd_irecv(
1754 s wa(ideb+1),len,it_spmd(i),msgtyp,
1755 g req_r(nbirecv))
1756 ideb = ideb + len
1757 ENDIF
1758 ENDDO
1759C
1760 ideb = 0
1761 DO ii = 1, nbirecv
1762 CALL spmd_waitany(nbirecv,req_r,index)
1763 i = irindex(index)
1764 ideb2 = iad_recv(i)-1
1765 ideb = ideb2 / ale%GLOBAL%NVCONV
1766 DO n = 1, npsegcom(i)
1767 kk = lsegcom(ideb+n)
1768
1769 nn=1
1770 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1771 segvar%RHO(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1772 ENDIF
1773
1774 nn=2
1775 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1776 segvar%EINT(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1777 ENDIF
1778
1779 nn=3
1780 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1781 segvar%RK(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1782 ENDIF
1783
1784 nn=4
1785 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1786 segvar%RE(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1787 ENDIF
1788
1789 nn=5
1790 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1791 segvar%UVAR(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1792 ENDIF
1793
1794 ENDDO
1795 ENDDO
1796 ENDIF
1797C
1798 ELSE
1799C
1800C Sending segvar from p0 to pi
1801C
1802 IF(loc_proc/=1)THEN
1803 msgtyp = msgoff
1804 len = npsegcom(1)
1805 IF(len>0) THEN
1806 CALL spmd_recv(
1807 s wa,len*ale%GLOBAL%NVCONV,it_spmd(1),msgtyp)
1808 DO n = 1, len
1809 kk = lsegcom(n)
1810
1811 nn=1
1812 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1813 segvar%RHO(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1814 ENDIF
1815
1816 nn=2
1817 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1818 segvar%EINT(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1819 ENDIF
1820
1821 nn=3
1822 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1823 segvar%RK(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1824 ENDIF
1825
1826 nn=4
1827 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1828 segvar%RE(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1829 ENDIF
1830
1831 nn=5
1832 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1833 segvar%UVAR(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1834 ENDIF
1835
1836 ENDDO
1837 ENDIF
1838C
1839 ELSE
1840 ideb = 0
1841 DO i = 2, nspmd
1842 len = npsegcom(i)
1843 IF(len>0) THEN
1844 msgtyp = msgoff
1845 DO n = 1, len
1846 kk = lsegcom(ideb+n)
1847
1848 nn=1
1849 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1850 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RHO(kk)
1851 ENDIF
1852
1853 nn=2
1854 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1855 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%EINT(kk)
1856 ENDIF
1857
1858 nn=3
1859 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1860 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RK(kk)
1861 ENDIF
1862
1863 nn=4
1864 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1865 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RE(kk)
1866 ENDIF
1867
1868 nn=5
1869 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1870 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%UVAR(kk)
1871 ENDIF
1872
1873
1874 ENDDO
1875 CALL spmd_send(
1876 s wa ,len*ale%GLOBAL%NVCONV,it_spmd(i),msgtyp)
1877 ideb = ideb + len
1878 ENDIF
1879 ENDDO
1880 ENDIF
1881 ENDIF
1882C
1883
1884#endif
1885 RETURN
1886 END
1887C
1888!||====================================================================
1889!|| spmd_init_ebcs ../engine/source/mpi/fluid/spmd_cfd.F
1890!||--- called by ------------------------------------------------------
1891!|| alemain ../engine/source/ale/alemain.F
1892!||--- calls -----------------------------------------------------
1893!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
1894!||--- uses -----------------------------------------------------
1895!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.F90
1896!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
1897!||====================================================================
1898 SUBROUTINE spmd_init_ebcs(V,ISIZXV,IAD_ELEM,FR_ELEM,EBCS_TAB)
1899 USE ebcs_mod
1900 USE spmd_mod
1901C-----------------------------------------------
1902C I m p l i c i t T y p e s
1903C-----------------------------------------------
1904#include "implicit_f.inc"
1905C-----------------------------------------------------------------
1906C M e s s a g e P a s s i n g
1907C-----------------------------------------------
1908#include "spmd.inc"
1909C-----------------------------------------------
1910C C o m m o n B l o c k s
1911C-----------------------------------------------
1912#include "com01_c.inc"
1913#include "com04_c.inc"
1914#include "task_c.inc"
1915#include "param_c.inc"
1916C-----------------------------------------------
1917C D u m m y A r g u m e n t s
1918C-----------------------------------------------
1919 INTEGER IAD_ELEM(2,*), FR_ELEM(*), ISIZXV
1920 my_real V(3,*)
1921 TYPE(t_ebcs_tab), INTENT(IN) :: EBCS_TAB
1922C-----------------------------------------------
1923C L o c a l V a r i a b l e s
1924C-----------------------------------------------
1925#ifdef MPI
1926 INTEGER MSGTYP,I, NOD,LOC_PROC, MSGOFF,
1927 . SIZ, L, E_LEN, ICOMV, KK, TYP, J
1928 my_real WA(3*ISIZXV)
1929 DATA MSGOFF/3013/
1930C-----------------------------------------------
1931C S o u r c e L i n e s
1932C-----------------------------------------------
1933
1934 LOC_PROC = ispmd + 1
1935 e_len=3
1936 IF(ispmd == 0) THEN
1937 icomv = 0
1938 DO i=1,nebcs
1939 kk=(i-1)*npebc
1940 typ =ebcs_tab%tab(i)%poly%type
1941 IF(typ == 4.OR.typ == 5) icomv = 1
1942 ENDDO
1943 CALL spmd_ibcast(icomv,icomv,1,1,0,2)
1944 IF(icomv == 0) RETURN
1945C
1946 l = 0
1947C
1948 DO i=1,nspmd
1949#include "vectorize.inc"
1950 DO j=iad_elem(2,i),iad_elem(1,i+1)-1
1951 nod = fr_elem(j)
1952 wa(l+1) = v(1,nod)
1953 wa(l+2) = v(2,nod)
1954 wa(l+3) = v(3,nod)
1955 l = l + e_len
1956 END DO
1957 ENDDO
1958C
1959C exchanging messages
1960C
1961 l = 1
1962 DO i=1,nspmd
1963C----------------------------------------------------------------------------
1964 IF(iad_elem(1,i+1)-iad_elem(2,i)>0)THEN
1965 msgtyp = msgoff
1966 siz = e_len*(iad_elem(1,i+1)-iad_elem(2,i))
1967 CALL spmd_send(
1968 s wa(l),siz,it_spmd(i),msgtyp)
1969 l = l + siz
1970 ENDIF
1971 ENDDO
1972C
1973C decompaction
1974C
1975 ELSE
1976 CALL spmd_ibcast(icomv,icomv,1,1,0,2)
1977 IF(icomv == 0) RETURN
1978C
1979 siz = e_len*(iad_elem(1,2)-iad_elem(2,1))
1980 IF(siz/=0)THEN
1981 l = 0
1982 msgtyp = msgoff
1983 CALL spmd_recv(
1984 s wa,siz,it_spmd(1),msgtyp)
1985#include "vectorize.inc"
1986 DO j=iad_elem(2,1),iad_elem(1,2)-1
1987 nod = fr_elem(j)
1988 v(1,nod) = wa(l+1)
1989 v(2,nod) = wa(l+2)
1990 v(3,nod) = wa(l+3)
1991 l = l + e_len
1992 END DO
1993 ENDIF
1994 ENDIF
1995C
1996
1997#endif
1998 RETURN
1999 END
2000
2001!||====================================================================
2002!|| spmd_l51vois ../engine/source/mpi/fluid/spmd_cfd.F
2003!||--- called by ------------------------------------------------------
2004!|| alemain ../engine/source/ale/alemain.F
2005!||--- calls -----------------------------------------------------
2006!|| spmd_wait ../engine/source/mpi/spmd_wait.F90
2007!|| spmd_waitany ../engine/source/mpi/spmd_wait.F90
2008!||--- uses -----------------------------------------------------
2009!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
2010!|| element_mod ../common_source/modules/elements/element_mod.F90
2011!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
2012!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
2013!||====================================================================
2014 SUBROUTINE spmd_l51vois(
2015 1 LBVOIS ,IPARG ,ELBUF_TAB ,PM ,IXS ,
2016 2 IXQ ,NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS,
2017 3 LENCOM ,IPM ,BUFMAT)
2018C-----------------------------------------------
2019C M o d u l e s
2020C-----------------------------------------------
2021 USE spmd_mod
2022 USE elbufdef_mod
2023 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas, m51_iflg6_size
2024 use element_mod , only : nixs,nixq
2025C-----------------------------------------------
2026C I m p l i c i t T y p e s
2027C-----------------------------------------------
2028#include "implicit_f.inc"
2029C-----------------------------------------------
2030C M e s s a g e P a s s i n g
2031C-----------------------------------------------
2032#include "spmd.inc"
2033C-----------------------------------------------
2034C C o m m o n B l o c k s
2035C-----------------------------------------------
2036#include "com01_c.inc"
2037#include "com04_c.inc"
2038#include "task_c.inc"
2039#include "param_c.inc"
2040C-----------------------------------------------
2041C D u m m y A r g u m e n t s
2042C-----------------------------------------------
2043 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
2044
2045 INTEGER :: IPARG(NPARG,*),IXS(NIXS,*), IXQ(NIXQ,*),
2046 . NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),
2047 . lencom, ipm(npropmi,*)
2048 my_real :: lbvois(m51_iflg6_size,*), pm(npropm,*), bufmat(*)
2049
2050C-----------------------------------------------
2051C L o c a l V a r i a b l e s
2052C-----------------------------------------------
2053#ifdef MPI
2054 INTEGER :: I,II,JJ,IDEB,IDEB2,MSGOFF,MSGTYP,IAD_RECV(NSPMD),
2055 . REQ_S(NSPMD), REQ_R(NSPMD),
2056 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), INDEX,
2057 . LEN, ML, NI, KTY, KLT, MFT, IS,
2058 . KB1, KB2, KB3 ,KB4 ,KB10, KB11, KB12, KKB2,
2059 . G_PLA,G_RK,L_RE,L_TEMP,IMAT,IADBUF,IFLG,NELG,ITRIMAT,KK,KJ(6),K
2060
2061 DATA MSGOFF/3014/
2062
2063 my_real :: WA(M51_IFLG6_SIZE*LENCOM), ELBUF(10000) !necessary size : M51_IFLG6_SIZE
2064
2065 TYPE(G_BUFEL_) ,POINTER :: GBUF
2066 TYPE(L_BUFEL_) ,POINTER :: LBUF
2067 TYPE(BUF_MAT_) ,POINTER :: MBUF
2068C-----------------------------------------------
2069
2070 ! X We Remote Nodes
2071 loc_proc = ispmd+1
2072 ideb = 0
2073 ideb2 = 0
2074 nbirecv = 0
2075 DO i = 1, nspmd
2076 msgtyp = msgoff
2077 iad_recv(i) = ideb2+1
2078 IF(nercvois(i)>0) THEN
2079 nbirecv = nbirecv + 1
2080 irindex(nbirecv) = i
2081 len = m51_iflg6_size*nercvois(i)
2082 CALL spmd_irecv(
2083 s wa(ideb2+1) , len , it_spmd(i) , msgtyp,
2084 g req_r(nbirecv))
2085 ideb2 = ideb2 + len
2086 ENDIF
2087 ENDDO
2088 ideb = 0
2089 DO i = 1, nspmd
2090 msgtyp = msgoff
2091 len = nesdvois(i)
2092 IF(len>0) THEN
2093 kty = -1
2094 klt = -1
2095 mft = -1
2096 DO n = 1, len
2097 ii = ideb2+m51_iflg6_size*(n-1)
2098 nn = lesdvois(ideb+n)
2099 IF (n2d == 0) THEN
2100 ml = nint(pm(19,ixs(1,nn)))
2101 imat = ixs(1,nn)
2102 ELSE
2103 ml = nint(pm(19,ixq(1,nn)))
2104 imat = ixq(1,nn)
2105 ENDIF
2106 iadbuf = ipm(7,imat)
2107 iflg = 6
2108 IF(ml==51)iflg = nint(bufmat(iadbuf-1+31))
2109 ! SEARCH FOR REMOTE ELEM DATA TO SEND
2110 IF (iflg /= 6) THEN
2111 DO ni=1,ngroup
2112 gbuf => elbuf_tab(ni)%GBUF
2113 lbuf => elbuf_tab(ni)%BUFLY(1)%LBUF(1,1,1)
2114 mbuf => elbuf_tab(ni)%BUFLY(1)%MAT(1,1,1)
2115 lbuf => elbuf_tab(ni)%BUFLY(1)%LBUF(1,1,1)
2116 kty = iparg(5,ni)
2117 klt = iparg(2,ni)
2118 mft = iparg(3,ni)
2119 IF( (kty == 1.OR.kty == 2).AND.(nn<=klt+mft) .AND. nn>mft) THEN
2120 l_temp = elbuf_tab(ni)%BUFLY(1)%L_TEMP
2121 is = nn-mft
2122 DO k=1,6
2123 kj(k) = klt*(k-1)
2124 ENDDO
2125 !-------------GLOBAL DATA------------------------------------------!
2126 wa(ii+1) = -(gbuf%SIG(kj(1)+is)+gbuf%SIG(kj(2)+is)+gbuf%SIG(kj(3)+is))*third
2127 wa(ii+2) = gbuf%EINT(is)
2128 wa(ii+3) = gbuf%RHO(is)
2129 IF (l_temp > 0)THEN
2130 wa(ii+4) = lbuf%TEMP(is)
2131 ELSE
2132 wa(ii+4) = zero
2133 ENDIF
2134 wa(ii+5) = lbuf%SSP(is)
2135 wa(ii+6) = zero
2136 IF(elbuf_tab(ni)%BUFLY(1)%L_PLA > 0)wa(ii+6) = lbuf%PLA(is)
2137 !-------------SUBMATERIAL STATE------------------------------------!
2138 !Submaterial Data
2139 nelg = klt
2140 itrimat = 1
2141 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2142 iadbuf=18 ; wa(ii+07) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2143 iadbuf=1 ; wa(ii+08) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2144 iadbuf=8 ; wa(ii+09) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2145 iadbuf=9 ; wa(ii+10) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2146 iadbuf=16 ; wa(ii+11) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2147 iadbuf=14 ; wa(ii+12) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2148 iadbuf=15 ; wa(ii+13) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2149 itrimat = 2
2150 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2151 iadbuf=18 ; wa(ii+14) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2152 iadbuf=1 ; wa(ii+15) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2153 iadbuf=8 ; wa(ii+16) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2154 iadbuf=9 ; wa(ii+17) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2155 iadbuf=16 ; wa(ii+18) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2156 iadbuf=14 ; wa(ii+19) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2157 iadbuf=15 ; wa(ii+20) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2158 itrimat = 3
2159 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2160 iadbuf=18 ; wa(ii+21) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2161 iadbuf=1 ; wa(ii+22) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2162 iadbuf=8 ; wa(ii+23) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2163 iadbuf=9 ; wa(ii+24) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2164 iadbuf=16 ; wa(ii+25) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2165 iadbuf=14 ; wa(ii+26) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2166 iadbuf=15 ; wa(ii+27) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2167 itrimat = 4
2168 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2169 iadbuf=18 ; wa(ii+28) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2170 iadbuf=1 ; wa(ii+29) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2171 iadbuf=8 ; wa(ii+30) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2172 iadbuf=9 ; wa(ii+31) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2173 iadbuf=16 ; wa(ii+32) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2174 iadbuf=14 ; wa(ii+33) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2175 iadbuf=15 ; wa(ii+34) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2176 !
2177 wa(ii+35) = mbuf%VAR(nelg*3+is) !UVAR(4,I)
2178 wa(ii+36) = iflg
2179 iadbuf = ipm(7,imat)
2180 wa(ii+37) = 51 + 100*nint(bufmat(iadbuf-1+276+4))
2181 . + 1000*nint(bufmat(iadbuf-1+276+3))
2182 . + 10000*nint(bufmat(iadbuf-1+276+2))
2183 . + 100000*nint(bufmat(iadbuf-1+276+1))
2184 !-------------REMAINING INDEXES------------------------------------!
2185 !WA(II+36:II+36) = ZERO
2186 EXIT
2187 ENDIF
2188 ENDDO
2189 ELSE ! iflg = 6
2190 wa(ii+1:ii+m51_iflg6_size) = zero
2191 wa(ii+36) = 6
2192 wa(ii+37) = ml
2193 ENDIF
2194 ENDDO
2195 CALL spmd_isend(
2196 s wa(ideb2+1),len*m51_iflg6_size,it_spmd(i),msgtyp,
2197 g req_s(i))
2198 ideb = ideb + len
2199 ideb2 = ideb2 + m51_iflg6_size*len
2200 ENDIF
2201 ENDDO
2202 ideb = 0
2203 DO ii = 1, nbirecv
2204 CALL spmd_waitany(nbirecv,req_r,index)
2205 i = irindex(index)
2206 ideb2 = iad_recv(i)
2207 ideb = (ideb2-1)/m51_iflg6_size
2208 DO n = 1, nercvois(i)
2209 jj = ideb2+m51_iflg6_size*(n-1)
2210 nn = lercvois(ideb+n)-numels-numelq
2211 lbvois(1:m51_iflg6_size,nn) = wa(jj+0:jj+m51_iflg6_size-1)
2212 ENDDO
2213 ENDDO
2214 DO i = 1, nspmd
2215 IF(nesdvois(i)>0) THEN
2216 CALL spmd_wait(req_s(i))
2217 ENDIF
2218 ENDDO
2219
2220#endif
2221 RETURN
2222 END
2223
my_real
#define my_real
Definition cppsort.cpp:32
ale_mod
Definition ale_mod.F:150
segvar_mod
Definition segvar_mod.F:63
spmd_extag
subroutine spmd_extag(ntag, iad_elem, fr_elem, lenr)
Definition spmd_cfd.F:1547
spmd_envois
subroutine spmd_envois(dim, phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:695
spmd_e4vois
subroutine spmd_e4vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:586
spmd_glob_dmin9
subroutine spmd_glob_dmin9(v, len)
Definition spmd_cfd.F:1490
spmd_init_ebcs
subroutine spmd_init_ebcs(v, isizxv, iad_elem, fr_elem, ebcs_tab)
Definition spmd_cfd.F:1899
spmd_exalew_pon
subroutine spmd_exalew_pon(fsky, fskyv, iad_elem, fr_elem, nale, addcne, procne, fr_nbcc, size, lenr, lens)
Definition spmd_cfd.F:1345
spmd_xvois
subroutine spmd_xvois(x, nbrcvois, nbsdvois, lnrcvois, lnsdvois, lencom)
Definition spmd_cfd.F:40
spmd_wvois
subroutine spmd_wvois(x, d, w, nbrcvois, nbsdvois, lnrcvois, lnsdvois, lencom)
Definition spmd_cfd.F:141
spmd_exalew
subroutine spmd_exalew(wa, wb, iad_elem, fr_elem, nale, size, lenr)
Definition spmd_cfd.F:1212
spmd_evois
subroutine spmd_evois(t, val2, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:261
spmd_i8vois
subroutine spmd_i8vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:799
spmd_segcom
subroutine spmd_segcom(segvar, npsegcom, lsegcom, size, flag)
Definition spmd_cfd.F:1666
spmd_i4vois
subroutine spmd_i4vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:919
spmd_e6vois
subroutine spmd_e6vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:474
spmd_l51vois
subroutine spmd_l51vois(lbvois, iparg, elbuf_tab, pm, ixs, ixq, nercvois, nesdvois, lercvois, lesdvois, lencom, ipm, bufmat)
Definition spmd_cfd.F:2018
spmd_e1vois
subroutine spmd_e1vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:375
spmd_l11vois
subroutine spmd_l11vois(lbvois, iparg, elbuf_tab, pm, ixs, ixq, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:1032
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57