OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_cfd.F File Reference
#include "macro.inc"
#include "implicit_f.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "spmd.inc"
#include "com04_c.inc"
#include "spmd_c.inc"
#include "param_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_xvois (x, nbrcvois, nbsdvois, lnrcvois, lnsdvois, lencom)
subroutine spmd_wvois (x, d, w, nbrcvois, nbsdvois, lnrcvois, lnsdvois, lencom)
subroutine spmd_evois (t, val2, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_e1vois (phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_e6vois (phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_e4vois (phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_envois (dim, phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_i8vois (phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_i4vois (phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_l11vois (lbvois, iparg, elbuf_tab, pm, ixs, ixq, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine spmd_exalew (wa, wb, iad_elem, fr_elem, nale, size, lenr)
subroutine spmd_exalew_pon (fsky, fskyv, iad_elem, fr_elem, nale, addcne, procne, fr_nbcc, size, lenr, lens)
subroutine spmd_glob_dmin9 (v, len)
subroutine spmd_extag (ntag, iad_elem, fr_elem, lenr)
subroutine spmd_segcom (segvar, npsegcom, lsegcom, size, flag)
subroutine spmd_init_ebcs (v, isizxv, iad_elem, fr_elem, ebcs_tab)
subroutine spmd_l51vois (lbvois, iparg, elbuf_tab, pm, ixs, ixq, nercvois, nesdvois, lercvois, lesdvois, lencom, ipm, bufmat)

Function/Subroutine Documentation

◆ spmd_e1vois()

subroutine spmd_e1vois ( phi,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 372 of file spmd_cfd.F.

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
my_real
#define my_real
Definition cppsort.cpp:32

◆ spmd_e4vois()

subroutine spmd_e4vois ( phi,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 583 of file spmd_cfd.F.

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

◆ spmd_e6vois()

subroutine spmd_e6vois ( phi,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 471 of file spmd_cfd.F.

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

◆ spmd_envois()

subroutine spmd_envois ( integer dim,
phi,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 692 of file spmd_cfd.F.

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

◆ spmd_evois()

subroutine spmd_evois ( t,
val2,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 258 of file spmd_cfd.F.

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

◆ spmd_exalew()

subroutine spmd_exalew ( wa,
wb,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) nale,
integer size,
integer lenr )

Definition at line 1209 of file spmd_cfd.F.

1210 USE spmd_mod
1211C-----------------------------------------------
1212C D e s c r i p t i o n
1213C-----------------------------------------------
1214C Sum of grid velocities WA,WB at boundary nodes. Parith/off
1215C-----------------------------------------------
1216C I m p l i c i t T y p e s
1217C-----------------------------------------------
1218#include "implicit_f.inc"
1219C-----------------------------------------------------------------
1220C M e s s a g e P a s s i n g
1221C-----------------------------------------------
1222#include "spmd.inc"
1223C-----------------------------------------------
1224C C o m m o n B l o c k s
1225C-----------------------------------------------
1226#include "com01_c.inc"
1227#include "task_c.inc"
1228C-----------------------------------------------
1229C D u m m y A r g u m e n t s
1230C-----------------------------------------------
1231 INTEGER IAD_ELEM(2,*), FR_ELEM(*), NALE(*),
1232 . SIZE, LENR
1233 my_real
1234 . wa(3,*),wb(3,*)
1235C-----------------------------------------------
1236C L o c a l V a r i a b l e s
1237C-----------------------------------------------
1238#ifdef MPI
1239 INTEGER MSGTYP,I,NOD,LOC_PROC,SIZ,J, L
1240 INTEGER IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),REQ_R(NSPMD),REQ_S(NSPMD), MSGOFF
1241 my_real rbuf(size*lenr), sbuf(size*lenr)
1242 DATA msgoff/3008/
1243C-----------------------------------------------
1244C S o u r c e L i n e s
1245C-----------------------------------------------
1246C
1247
1248 loc_proc = ispmd + 1
1249 l = 1
1250 iad_recv(1) = 1
1251C SIZE = 6
1252 DO i=1,nspmd
1253 siz = size*(iad_elem(1,i+1)-iad_elem(1,i))
1254 IF(siz/=0)THEN
1255 msgtyp = msgoff
1256 CALL spmd_irecv(
1257 s rbuf(l),siz,it_spmd(i),msgtyp,
1258 g req_r(i))
1259 l = l + siz
1260 ENDIF
1261 iad_recv(i+1) = l
1262 END DO
1263C
1264 l = 1
1265 iad_send(1) = l
1266 DO i=1,nspmd
1267#include "vectorize.inc"
1268 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1269 nod = fr_elem(j)
1270 IF(iabs(nale(nod)) == 1) THEN
1271 sbuf(l ) = wa(1,nod)
1272 sbuf(l+1) = wa(2,nod)
1273 sbuf(l+2) = wa(3,nod)
1274 sbuf(l+3) = wb(1,nod)
1275 sbuf(l+4) = wb(2,nod)
1276 sbuf(l+5) = wb(3,nod)
1277 l = l + SIZE
1278 ENDIF
1279 ENDDO
1280 iad_send(i+1) = l
1281 ENDDO
1282C
1283 DO i=1,nspmd
1284 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1285 msgtyp = msgoff
1286 siz = iad_send(i+1)-iad_send(i)
1287 l = iad_send(i)
1288 CALL spmd_isend(
1289 s sbuf(l),siz,it_spmd(i),msgtyp,
1290 g req_s(i))
1291 ENDIF
1292 ENDDO
1293C
1294C decompaction
1295C
1296 DO i = 1, nspmd
1297 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1298 CALL spmd_wait(req_r(i))
1299 l = iad_recv(i)
1300#include "vectorize.inc"
1301 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1302 nod = fr_elem(j)
1303 IF(iabs(nale(nod)) == 1) THEN
1304 wa(1,nod) = wa(1,nod) + rbuf(l )
1305 wa(2,nod) = wa(2,nod) + rbuf(l+1)
1306 wa(3,nod) = wa(3,nod) + rbuf(l+2)
1307 wb(1,nod) = wb(1,nod) + rbuf(l+3)
1308 wb(2,nod) = wb(2,nod) + rbuf(l+4)
1309 wb(3,nod) = wb(3,nod) + rbuf(l+5)
1310 l = l + SIZE
1311 END IF
1312 ENDDO
1313 ENDIF
1314 END DO
1315C
1316C Wait terminaison isend
1317C
1318 DO i = 1, nspmd
1319 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
1320 . CALL spmd_wait(req_s(i))
1321 ENDDO
1322C
1323
1324#endif
1325 RETURN

◆ spmd_exalew_pon()

subroutine spmd_exalew_pon ( fsky,
fskyv,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) nale,
integer, dimension(*) addcne,
integer, dimension(*) procne,
integer, dimension(2,*) fr_nbcc,
integer size,
integer lenr,
integer lens )

Definition at line 1339 of file spmd_cfd.F.

1343 USE spmd_mod
1344C-----------------------------------------------
1345C D e s c r i p t i o n
1346C-----------------------------------------------
1347C Sum of grid velocities WA,WB at boundary nodes. Parith/on
1348C-----------------------------------------------
1349C I m p l i c i t T y p e s
1350C-----------------------------------------------
1351#include "implicit_f.inc"
1352C-----------------------------------------------
1353C M e s s a g e P a s s i n g
1354C-----------------------------------------------
1355#include "spmd.inc"
1356C-----------------------------------------------
1357C C o m m o n B l o c k s
1358C-----------------------------------------------
1359#include "com01_c.inc"
1360#include "task_c.inc"
1361#include "parit_c.inc"
1362C-----------------------------------------------
1363C D u m m y A r g u m e n t s
1364C-----------------------------------------------
1365 INTEGER IAD_ELEM(2,*),FR_ELEM(*),FR_NBCC(2,*),NALE(*),ADDCNE(*), PROCNE(*),SIZE, LENR ,LENS
1366 my_real fsky(8,lsky), fskyv(lsky,8)
1367C-----------------------------------------------
1368C L o c a l V a r i a b l e s
1369C-----------------------------------------------
1370#ifdef MPI
1371 INTEGER MSGTYP,I,NOD,LOC_PROC,SIZ,J,L,CC,NBIRECV,
1372 . II, INDEX,
1373 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
1374 . REQ_R(NSPMD),REQ_S(NSPMD),IRINDEX(NSPMD),MSGOFF
1375 my_real rbuf(size*lenr+1), sbuf(size*lens)
1376 DATA msgoff/3009/
1377C-----------------------------------------------
1378C S o u r c e L i n e s
1379C-----------------------------------------------
1380C
1381
1382 loc_proc = ispmd + 1
1383C SIZE = 6
1384C
1385 nbirecv = 0
1386 l = 1
1387 iad_recv(1) = 1
1388 DO i=1,nspmd
1389 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
1390 msgtyp = msgoff
1391 siz = size*fr_nbcc(2,i)
1392 nbirecv = nbirecv + 1
1393 irindex(nbirecv) = i
1394 CALL spmd_irecv(
1395 s rbuf(l),siz,it_spmd(i),msgtyp,
1396 g req_r(nbirecv))
1397 l = l + siz
1398 ENDIF
1399 iad_recv(i+1) = l
1400 END DO
1401C
1402 l = 1
1403 iad_send(1) = l
1404 DO i=1,nspmd
1405 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1406 nod = fr_elem(j)
1407 IF(iabs(nale(nod)) == 1) THEN
1408 IF(ivector == 1) THEN
1409 ELSE
1410 DO cc = addcne(nod),addcne(nod+1)-1
1411 IF(procne(cc) == loc_proc) THEN
1412 sbuf(l) = fsky(1,cc)
1413 sbuf(l+1) = fsky(2,cc)
1414 sbuf(l+2) = fsky(3,cc)
1415 sbuf(l+3) = fsky(4,cc)
1416 sbuf(l+4) = fsky(5,cc)
1417 sbuf(l+5) = fsky(6,cc)
1418 l = l + SIZE
1419 ENDIF
1420 ENDDO
1421 ENDIF
1422 ENDIF
1423 ENDDO
1424 iad_send(i+1) = l
1425 ENDDO
1426C
1427 DO i=1,nspmd
1428 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1429 siz = iad_send(i+1)-iad_send(i)
1430 l = iad_send(i)
1431 msgtyp = msgoff
1432 CALL spmd_isend(
1433 s sbuf(l),siz,it_spmd(i),msgtyp,
1434 g req_s(i))
1435 ENDIF
1436 ENDDO
1437C
1438C decompaction
1439C
1440 DO ii=1,nbirecv
1441 CALL spmd_waitany(nbirecv,req_r,index)
1442 i = irindex(index)
1443 l = iad_recv(i)
1444 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1445 nod = fr_elem(j)
1446 IF(iabs(nale(nod)) == 1) THEN
1447 IF(ivector == 1) THEN
1448 ELSE
1449 DO cc = addcne(nod), addcne(nod+1)-1
1450 IF(procne(cc) == i) THEN
1451 fsky(1,cc) = rbuf(l)
1452 fsky(2,cc) = rbuf(l+1)
1453 fsky(3,cc) = rbuf(l+2)
1454 fsky(4,cc) = rbuf(l+3)
1455 fsky(5,cc) = rbuf(l+4)
1456 fsky(6,cc) = rbuf(l+5)
1457 l = l + SIZE
1458 ENDIF
1459 ENDDO
1460 ENDIF
1461 ENDIF
1462 ENDDO
1463 ENDDO
1464
1465C
1466C Wait terminaison isend
1467 DO i = 1, nspmd
1468 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
1469 siz = iad_send(i+1)-iad_send(i)
1470 CALL spmd_wait(req_s(i))
1471 ENDIF
1472 ENDDO
1473C
1474
1475#endif
1476 RETURN

◆ spmd_extag()

subroutine spmd_extag ( integer, dimension(*) ntag,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer lenr )

Definition at line 1544 of file spmd_cfd.F.

1545 USE spmd_mod
1546C-----------------------------------------------
1547C D e s c r i p t i o n
1548C-----------------------------------------------
1549C Sum of tags
1550C-----------------------------------------------
1551C I m p l i c i t T y p e s
1552C-----------------------------------------------
1553#include "implicit_f.inc"
1554C-----------------------------------------------------------------
1555C M e s s a g e P a s s i n g
1556C-----------------------------------------------
1557#include "spmd.inc"
1558C-----------------------------------------------
1559C C o m m o n B l o c k s
1560C-----------------------------------------------
1561#include "com01_c.inc"
1562#include "task_c.inc"
1563C-----------------------------------------------
1564C D u m m y A r g u m e n t s
1565C-----------------------------------------------
1566 INTEGER IAD_ELEM(2,*), FR_ELEM(*), SIZE, LENR, NTAG(*)
1567C-----------------------------------------------
1568C L o c a l V a r i a b l e s
1569C-----------------------------------------------
1570#ifdef MPI
1571 INTEGER MSGTYP,I,NOD,LOC_PROC,NB_NOD,
1572 . SIZ,J, L,
1573 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
1574 . REQ_R(NSPMD),REQ_S(NSPMD),
1575 . RBUF(LENR), SBUF(LENR) ,MSGOFF
1576 DATA msgoff/3011/
1577C-----------------------------------------------
1578C S o u r c e L i n e s
1579C-----------------------------------------------
1580C
1581
1582 loc_proc = ispmd + 1
1583C
1584 l = 1
1585 iad_recv(1) = 1
1586 DO i=1,nspmd
1587 siz = iad_elem(1,i+1)-iad_elem(1,i)
1588 IF(siz/=0)THEN
1589 msgtyp = msgoff
1590 CALL spmd_irecv(
1591 s rbuf(l),siz,it_spmd(i),msgtyp,
1592 g req_r(i))
1593 l = l + siz
1594 ENDIF
1595 iad_recv(i+1) = l
1596 END DO
1597C
1598 l = 1
1599 iad_send(1) = l
1600 DO i=1,nspmd
1601#include "vectorize.inc"
1602 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1603 nod = fr_elem(j)
1604 IF(ntag(nod)>0) THEN
1605C removing initial tag already treated locally
1606 sbuf(l) = ntag(nod)-1
1607 ELSE
1608 sbuf(l) = 0
1609 END IF
1610 l=l+1
1611 END DO
1612 iad_send(i+1) = l
1613 ENDDO
1614C
1615 DO i=1,nspmd
1616 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
1617 msgtyp = msgoff
1618 siz = iad_send(i+1)-iad_send(i)
1619 l = iad_send(i)
1620 CALL spmd_isend(
1621 s sbuf(l),siz,it_spmd(i),msgtyp,
1622 g req_s(i))
1623 ENDIF
1624 ENDDO
1625C
1626C decompaction
1627C
1628 DO i = 1, nspmd
1629 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
1630 IF(nb_nod>0)THEN
1631 CALL spmd_wait(req_r(i))
1632 l = iad_recv(i)
1633#include "vectorize.inc"
1634 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1635 nod = fr_elem(j)
1636 ntag(nod) = ntag(nod)+rbuf(l)
1637 l = l + 1
1638 ENDDO
1639 ENDIF
1640 END DO
1641C Wait terminaison isend
1642 DO i = 1, nspmd
1643 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
1644 . CALL spmd_wait(req_s(i))
1645 ENDDO
1646C
1647
1648#endif
1649 RETURN

◆ spmd_glob_dmin9()

subroutine spmd_glob_dmin9 ( v,
integer len )

Definition at line 1487 of file spmd_cfd.F.

1488 USE spmd_mod
1489C-----------------------------------------------
1490C D e s c r i p t i o n
1491C-----------------------------------------------
1492C minimum of array V (length=LEN) of type my_real
1493C-----------------------------------------------
1494C I m p l i c i t T y p e s
1495C-----------------------------------------------
1496#include "implicit_f.inc"
1497C-----------------------------------------------------------------
1498C M e s s a g e P a s s i n g
1499C-----------------------------------------------
1500#include "spmd.inc"
1501C-----------------------------------------------
1502C C o m m o n B l o c k s
1503C-----------------------------------------------
1504#include "task_c.inc"
1505C-----------------------------------------------
1506C D u m m y A r g u m e n t s
1507C-----------------------------------------------
1508 INTEGER LEN
1509 my_real v(len)
1510C-----------------------------------------------
1511C L o c a l V a r i a b l e s
1512C-----------------------------------------------
1513#ifdef MPI
1514 INTEGER MSGTYP,INFO,I,K,ATID,ATAG,ALEN
1515 my_real vtmp(len)
1516C-----------------------------------------------
1517C S o u r c e L i n e s
1518C-----------------------------------------------
1519
1520 IF (len > 0) THEN
1521 CALL spmd_reduce(v,vtmp,len,
1522 . spmd_min,it_spmd(1))
1523 ENDIF
1524 IF (ispmd == 0) THEN
1525 DO i=1,len
1526 v(i) = vtmp(i)
1527 END DO
1528 ENDIF
1529C
1530
1531#endif
1532 RETURN

◆ spmd_i4vois()

subroutine spmd_i4vois ( integer, dimension(numelq+nqvois,4) phi,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 916 of file spmd_cfd.F.

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

◆ spmd_i8vois()

subroutine spmd_i8vois ( integer, dimension(numels+nsvois,8) phi,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 796 of file spmd_cfd.F.

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

◆ spmd_init_ebcs()

subroutine spmd_init_ebcs ( v,
integer isizxv,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
type(t_ebcs_tab), intent(in) ebcs_tab )

Definition at line 1896 of file spmd_cfd.F.

1897 USE ebcs_mod
1898 USE spmd_mod
1899C-----------------------------------------------
1900C I m p l i c i t T y p e s
1901C-----------------------------------------------
1902#include "implicit_f.inc"
1903C-----------------------------------------------------------------
1904C M e s s a g e P a s s i n g
1905C-----------------------------------------------
1906#include "spmd.inc"
1907C-----------------------------------------------
1908C C o m m o n B l o c k s
1909C-----------------------------------------------
1910#include "com01_c.inc"
1911#include "com04_c.inc"
1912#include "task_c.inc"
1913#include "param_c.inc"
1914C-----------------------------------------------
1915C D u m m y A r g u m e n t s
1916C-----------------------------------------------
1917 INTEGER IAD_ELEM(2,*), FR_ELEM(*), ISIZXV
1918 my_real v(3,*)
1919 TYPE(t_ebcs_tab), INTENT(IN) :: EBCS_TAB
1920C-----------------------------------------------
1921C L o c a l V a r i a b l e s
1922C-----------------------------------------------
1923#ifdef MPI
1924 INTEGER MSGTYP,I, NOD,LOC_PROC, MSGOFF,
1925 . SIZ, L, E_LEN, ICOMV, KK, TYP, J
1926 my_real wa(3*isizxv)
1927 DATA msgoff/3013/
1928C-----------------------------------------------
1929C S o u r c e L i n e s
1930C-----------------------------------------------
1931
1932 loc_proc = ispmd + 1
1933 e_len=3
1934 IF(ispmd == 0) THEN
1935 icomv = 0
1936 DO i=1,nebcs
1937 kk=(i-1)*npebc
1938 typ =ebcs_tab%tab(i)%poly%type
1939 IF(typ == 4.OR.typ == 5) icomv = 1
1940 ENDDO
1941 CALL spmd_ibcast(icomv,icomv,1,1,0,2)
1942 IF(icomv == 0) RETURN
1943C
1944 l = 0
1945C
1946 DO i=1,nspmd
1947#include "vectorize.inc"
1948 DO j=iad_elem(2,i),iad_elem(1,i+1)-1
1949 nod = fr_elem(j)
1950 wa(l+1) = v(1,nod)
1951 wa(l+2) = v(2,nod)
1952 wa(l+3) = v(3,nod)
1953 l = l + e_len
1954 END DO
1955 ENDDO
1956C
1957C exchanging messages
1958C
1959 l = 1
1960 DO i=1,nspmd
1961C----------------------------------------------------------------------------
1962 IF(iad_elem(1,i+1)-iad_elem(2,i)>0)THEN
1963 msgtyp = msgoff
1964 siz = e_len*(iad_elem(1,i+1)-iad_elem(2,i))
1965 CALL spmd_send(
1966 s wa(l),siz,it_spmd(i),msgtyp)
1967 l = l + siz
1968 ENDIF
1969 ENDDO
1970C
1971C decompaction
1972C
1973 ELSE
1974 CALL spmd_ibcast(icomv,icomv,1,1,0,2)
1975 IF(icomv == 0) RETURN
1976C
1977 siz = e_len*(iad_elem(1,2)-iad_elem(2,1))
1978 IF(siz/=0)THEN
1979 l = 0
1980 msgtyp = msgoff
1981 CALL spmd_recv(
1982 s wa,siz,it_spmd(1),msgtyp)
1983#include "vectorize.inc"
1984 DO j=iad_elem(2,1),iad_elem(1,2)-1
1985 nod = fr_elem(j)
1986 v(1,nod) = wa(l+1)
1987 v(2,nod) = wa(l+2)
1988 v(3,nod) = wa(l+3)
1989 l = l + e_len
1990 END DO
1991 ENDIF
1992 ENDIF
1993C
1994
1995#endif
1996 RETURN
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57

◆ spmd_l11vois()

subroutine spmd_l11vois ( lbvois,
integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
pm,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom )

Definition at line 1027 of file spmd_cfd.F.

1031C-----------------------------------------------
1032C M o d u l e s
1033C-----------------------------------------------
1034 USE elbufdef_mod
1035 USE spmd_mod
1036C-----------------------------------------------
1037C I m p l i c i t T y p e s
1038C-----------------------------------------------
1039#include "implicit_f.inc"
1040C-----------------------------------------------
1041C M e s s a g e P a s s i n g
1042C-----------------------------------------------
1043#include "spmd.inc"
1044C-----------------------------------------------
1045C C o m m o n B l o c k s
1046C-----------------------------------------------
1047#include "com01_c.inc"
1048#include "com04_c.inc"
1049#include "task_c.inc"
1050#include "param_c.inc"
1051C-----------------------------------------------
1052C D u m m y A r g u m e n t s
1053C-----------------------------------------------
1054 INTEGER IPARG(NPARG,*),IXS(NIXS,*), IXQ(NIXQ,*),
1055 . NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),
1056 . LENCOM
1057 my_real lbvois(6,*), pm(npropm,*)
1058 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
1059C-----------------------------------------------
1060C L o c a l V a r i a b l e s
1061C-----------------------------------------------
1062#ifdef MPI
1063 INTEGER I,II,JJ,IDEB,IDEB2,MSGOFF,MSGTYP,IAD_RECV(NSPMD),
1064 . REQ_S(NSPMD), REQ_R(NSPMD),
1065 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), INDEX,
1066 . LEN, ML, NI, KTY, KLT, MFT, IS,
1067 . KB1, KB2, KB3 ,KB4 ,KB10, KB11, KB12, KKB2,
1068 . G_PLA,G_RK,L_RE,L_TEMP,KK(6),K
1069 DATA msgoff/3007/
1070 my_real wa(6*lencom)
1071 my_real elbuf(10000) ! contents not used
1072 TYPE(G_BUFEL_) ,POINTER :: GBUF
1073 TYPE(L_BUFEL_) ,POINTER :: LBUF
1074C-----------------------------------------------
1075C
1076C Updating X on adjacent domains
1077C
1078
1079 loc_proc = ispmd+1
1080 ideb = 0
1081 ideb2 = 0
1082 nbirecv = 0
1083 DO i = 1, nspmd
1084 msgtyp = msgoff
1085 iad_recv(i) = ideb2+1
1086 IF(nercvois(i)>0) THEN
1087 nbirecv = nbirecv + 1
1088 irindex(nbirecv) = i
1089 len = 6*nercvois(i)
1090 CALL spmd_irecv(
1091 s wa(ideb2+1) , len, it_spmd(i) , msgtyp,
1092 g req_r(nbirecv) )
1093 ideb2 = ideb2 + len
1094 ENDIF
1095 ENDDO
1096 ideb = 0
1097 DO i = 1, nspmd
1098 msgtyp = msgoff
1099 len = nesdvois(i)
1100 IF(len>0) THEN
1101 kty = -1
1102 klt = -1
1103 mft = -1
1104 DO n = 1, len
1105 ii = ideb2+6*(n-1)
1106 nn = lesdvois(ideb+n)
1107 ! Searching in element buffer : sending if material law /= 11
1108 IF (n2d == 0) THEN
1109 ml=nint(pm(19,ixs(1,nn)))
1110 ELSE
1111 ml=nint(pm(19,ixq(1,nn)))
1112 ENDIF
1113
1114 IF (ml /= 11) THEN
1115 DO ni=1,ngroup
1116 gbuf => elbuf_tab(ni)%GBUF
1117 lbuf => elbuf_tab(ni)%BUFLY(1)%LBUF(1,1,1)
1118 kty = iparg(5,ni)
1119 klt = iparg(2,ni)
1120 mft = iparg(3,ni)
1121 IF( (kty == 1.OR.kty == 2).AND.(nn<=klt+mft) .AND. nn>mft) THEN
1122 g_pla = elbuf_tab(ni)%GBUF%G_PLA
1123 g_rk = elbuf_tab(ni)%GBUF%G_RK
1124 l_re = elbuf_tab(ni)%BUFLY(1)%L_RE
1125 l_temp= elbuf_tab(ni)%BUFLY(1)%L_TEMP
1126 is = nn-mft
1127!
1128 DO k=1,6
1129 kk(k) = klt*(k-1)
1130 ENDDO
1131!
1132 wa(ii+1) =-(gbuf%SIG(kk(1)+is)+gbuf%SIG(kk(2)+is)+ gbuf%SIG(kk(3)+is))*third
1133 wa(ii+2) = gbuf%EINT(is)
1134 wa(ii+3) = gbuf%RHO(is)
1135 IF (g_pla > 0) THEN
1136 wa(ii+4) = gbuf%PLA(is)
1137 ELSEIF (g_rk > 0) THEN
1138 wa(ii+4) = gbuf%RK(is)
1139 ELSE
1140 wa(ii+4) = zero
1141 ENDIF
1142 IF (l_temp > 0)THEN
1143 wa(ii+5) = lbuf%TEMP(is)
1144 ELSE
1145 wa(ii+5) = zero
1146 ENDIF
1147 IF (l_re > 0) THEN
1148 wa(ii+6) = lbuf%RE(is)
1149 ELSE
1150 wa(ii+6) = zero
1151 ENDIF
1152 EXIT
1153 ENDIF
1154 enddo!next NI
1155 ELSE ! ML == 11
1156 wa(ii+1) = zero
1157 wa(ii+2) = zero
1158 wa(ii+3) = zero
1159 wa(ii+4) = zero
1160 wa(ii+5) = zero
1161 wa(ii+6) = zero
1162 ENDIF
1163 enddo!next N
1164 CALL spmd_isend(
1165 s wa(ideb2+1) ,len*6 ,it_spmd(i) , msgtyp,
1166 g req_s(i) )
1167 ideb = ideb + len
1168 ideb2 = ideb2 + 6*len
1169 ENDIF
1170 ENDDO
1171
1172 ideb = 0
1173 DO ii = 1, nbirecv
1174 CALL spmd_waitany(nbirecv,req_r,index)
1175 i = irindex(index)
1176 ideb2 = iad_recv(i)
1177 ideb = (ideb2-1)/6
1178 DO n = 1, nercvois(i)
1179 jj = ideb2+6*(n-1)
1180 nn = lercvois(ideb+n)-numels-numelq
1181 lbvois(1,nn) = wa(jj)
1182 lbvois(2,nn) = wa(jj+1)
1183 lbvois(3,nn) = wa(jj+2)
1184 lbvois(4,nn) = wa(jj+3)
1185 lbvois(5,nn) = wa(jj+4)
1186 lbvois(6,nn) = wa(jj+5)
1187 ENDDO
1188 ENDDO
1189
1190 DO i = 1, nspmd
1191 IF(nesdvois(i)>0) THEN
1192 CALL spmd_wait(req_s(i))
1193 ENDIF
1194 ENDDO
1195
1196#endif
1197 RETURN

◆ spmd_l51vois()

subroutine spmd_l51vois ( lbvois,
integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
pm,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom,
integer, dimension(npropmi,*) ipm,
bufmat )

Definition at line 2011 of file spmd_cfd.F.

2015C-----------------------------------------------
2016C M o d u l e s
2017C-----------------------------------------------
2018 USE spmd_mod
2019 USE elbufdef_mod
2020 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas, m51_iflg6_size
2021C-----------------------------------------------
2022C I m p l i c i t T y p e s
2023C-----------------------------------------------
2024#include "implicit_f.inc"
2025C-----------------------------------------------
2026C M e s s a g e P a s s i n g
2027C-----------------------------------------------
2028#include "spmd.inc"
2029C-----------------------------------------------
2030C C o m m o n B l o c k s
2031C-----------------------------------------------
2032#include "com01_c.inc"
2033#include "com04_c.inc"
2034#include "task_c.inc"
2035#include "param_c.inc"
2036C-----------------------------------------------
2037C D u m m y A r g u m e n t s
2038C-----------------------------------------------
2039 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
2040
2041 INTEGER :: IPARG(NPARG,*),IXS(NIXS,*), IXQ(NIXQ,*),
2042 . NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*),
2043 . LENCOM, IPM(NPROPMI,*)
2044 my_real :: lbvois(m51_iflg6_size,*), pm(npropm,*), bufmat(*)
2045
2046C-----------------------------------------------
2047C L o c a l V a r i a b l e s
2048C-----------------------------------------------
2049#ifdef MPI
2050 INTEGER :: I,II,JJ,IDEB,IDEB2,MSGOFF,MSGTYP,IAD_RECV(NSPMD),
2051 . REQ_S(NSPMD), REQ_R(NSPMD),
2052 . LOC_PROC, N, NN, NBIRECV, IRINDEX(NSPMD), INDEX,
2053 . LEN, ML, NI, KTY, KLT, MFT, IS,
2054 . KB1, KB2, KB3 ,KB4 ,KB10, KB11, KB12, KKB2,
2055 . G_PLA,G_RK,L_RE,L_TEMP,IMAT,IADBUF,IFLG,NELG,ITRIMAT,KK,KJ(6),K
2056
2057 DATA msgoff/3014/
2058
2059 my_real :: wa(m51_iflg6_size*lencom), elbuf(10000) !necessary size : M51_IFLG6_SIZE
2060
2061 TYPE(G_BUFEL_) ,POINTER :: GBUF
2062 TYPE(L_BUFEL_) ,POINTER :: LBUF
2063 TYPE(BUF_MAT_) ,POINTER :: MBUF
2064C-----------------------------------------------
2065
2066 ! X on remote nodes
2067 loc_proc = ispmd+1
2068 ideb = 0
2069 ideb2 = 0
2070 nbirecv = 0
2071 DO i = 1, nspmd
2072 msgtyp = msgoff
2073 iad_recv(i) = ideb2+1
2074 IF(nercvois(i)>0) THEN
2075 nbirecv = nbirecv + 1
2076 irindex(nbirecv) = i
2077 len = m51_iflg6_size*nercvois(i)
2078 CALL spmd_irecv(
2079 s wa(ideb2+1) , len , it_spmd(i) , msgtyp,
2080 g req_r(nbirecv))
2081 ideb2 = ideb2 + len
2082 ENDIF
2083 ENDDO
2084 ideb = 0
2085 DO i = 1, nspmd
2086 msgtyp = msgoff
2087 len = nesdvois(i)
2088 IF(len>0) THEN
2089 kty = -1
2090 klt = -1
2091 mft = -1
2092 DO n = 1, len
2093 ii = ideb2+m51_iflg6_size*(n-1)
2094 nn = lesdvois(ideb+n)
2095 IF (n2d == 0) THEN
2096 ml = nint(pm(19,ixs(1,nn)))
2097 imat = ixs(1,nn)
2098 ELSE
2099 ml = nint(pm(19,ixq(1,nn)))
2100 imat = ixq(1,nn)
2101 ENDIF
2102 iadbuf = ipm(7,imat)
2103 iflg = 6
2104 IF(ml==51)iflg = nint(bufmat(iadbuf-1+31))
2105 ! SEARCH FOR REMOTE ELEM DATA TO SEND
2106 IF (iflg /= 6) THEN
2107 DO ni=1,ngroup
2108 gbuf => elbuf_tab(ni)%GBUF
2109 lbuf => elbuf_tab(ni)%BUFLY(1)%LBUF(1,1,1)
2110 mbuf => elbuf_tab(ni)%BUFLY(1)%MAT(1,1,1)
2111 lbuf => elbuf_tab(ni)%BUFLY(1)%LBUF(1,1,1)
2112 kty = iparg(5,ni)
2113 klt = iparg(2,ni)
2114 mft = iparg(3,ni)
2115 IF( (kty == 1.OR.kty == 2).AND.(nn<=klt+mft) .AND. nn>mft) THEN
2116 l_temp = elbuf_tab(ni)%BUFLY(1)%L_TEMP
2117 is = nn-mft
2118 DO k=1,6
2119 kj(k) = klt*(k-1)
2120 ENDDO
2121 !-------------GLOBAL DATA------------------------------------------!
2122 wa(ii+1) = -(gbuf%SIG(kj(1)+is)+gbuf%SIG(kj(2)+is)+gbuf%SIG(kj(3)+is))*third
2123 wa(ii+2) = gbuf%EINT(is)
2124 wa(ii+3) = gbuf%RHO(is)
2125 IF (l_temp > 0)THEN
2126 wa(ii+4) = lbuf%TEMP(is)
2127 ELSE
2128 wa(ii+4) = zero
2129 ENDIF
2130 wa(ii+5) = lbuf%SSP(is)
2131 wa(ii+6) = zero
2132 IF(elbuf_tab(ni)%BUFLY(1)%L_PLA > 0)wa(ii+6) = lbuf%PLA(is)
2133 !-------------SUBMATERIAL STATE------------------------------------!
2134 !Submaterial Data
2135 nelg = klt
2136 itrimat = 1
2137 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2138 iadbuf=18 ; wa(ii+07) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2139 iadbuf=1 ; wa(ii+08) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2140 iadbuf=8 ; wa(ii+09) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2141 iadbuf=9 ; wa(ii+10) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2142 iadbuf=16 ; wa(ii+11) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2143 iadbuf=14 ; wa(ii+12) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2144 iadbuf=15 ; wa(ii+13) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2145 itrimat = 2
2146 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2147 iadbuf=18 ; wa(ii+14) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2148 iadbuf=1 ; wa(ii+15) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2149 iadbuf=8 ; wa(ii+16) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2150 iadbuf=9 ; wa(ii+17) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2151 iadbuf=16 ; wa(ii+18) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2152 iadbuf=14 ; wa(ii+19) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2153 iadbuf=15 ; wa(ii+20) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2154 itrimat = 3
2155 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2156 iadbuf=18 ; wa(ii+21) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2157 iadbuf=1 ; wa(ii+22) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2158 iadbuf=8 ; wa(ii+23) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2159 iadbuf=9 ; wa(ii+24) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2160 iadbuf=16 ; wa(ii+25) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2161 iadbuf=14 ; wa(ii+26) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2162 iadbuf=15 ; wa(ii+27) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2163 itrimat = 4
2164 kk = m51_n0phas + (itrimat-1)*m51_nvphas
2165 iadbuf=18 ; wa(ii+28) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !PRES
2166 iadbuf=1 ; wa(ii+29) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !VFRAC
2167 iadbuf=8 ; wa(ii+30) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !ENER
2168 iadbuf=9 ; wa(ii+31) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !DENS
2169 iadbuf=16 ; wa(ii+32) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !TEMP
2170 iadbuf=14 ; wa(ii+33) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !SSP
2171 iadbuf=15 ; wa(ii+34) = mbuf%VAR(nelg*(iadbuf+kk-1)+is) !EPSP
2172 !
2173 wa(ii+35) = mbuf%VAR(nelg*3+is) !UVAR(4,I)
2174 wa(ii+36) = iflg
2175 iadbuf = ipm(7,imat)
2176 wa(ii+37) = 51 + 100*nint(bufmat(iadbuf-1+276+4))
2177 . + 1000*nint(bufmat(iadbuf-1+276+3))
2178 . + 10000*nint(bufmat(iadbuf-1+276+2))
2179 . + 100000*nint(bufmat(iadbuf-1+276+1))
2180 !-------------REMAINING INDEXES------------------------------------!
2181 !WA(II+36:II+36) = ZERO
2182 EXIT
2183 ENDIF
2184 ENDDO
2185 ELSE ! iflg = 6
2186 wa(ii+1:ii+m51_iflg6_size) = zero
2187 wa(ii+36) = 6
2188 wa(ii+37) = ml
2189 ENDIF
2190 ENDDO
2191 CALL spmd_isend(
2192 s wa(ideb2+1),len*m51_iflg6_size,it_spmd(i),msgtyp,
2193 g req_s(i))
2194 ideb = ideb + len
2195 ideb2 = ideb2 + m51_iflg6_size*len
2196 ENDIF
2197 ENDDO
2198 ideb = 0
2199 DO ii = 1, nbirecv
2200 CALL spmd_waitany(nbirecv,req_r,index)
2201 i = irindex(index)
2202 ideb2 = iad_recv(i)
2203 ideb = (ideb2-1)/m51_iflg6_size
2204 DO n = 1, nercvois(i)
2205 jj = ideb2+m51_iflg6_size*(n-1)
2206 nn = lercvois(ideb+n)-numels-numelq
2207 lbvois(1:m51_iflg6_size,nn) = wa(jj+0:jj+m51_iflg6_size-1)
2208 ENDDO
2209 ENDDO
2210 DO i = 1, nspmd
2211 IF(nesdvois(i)>0) THEN
2212 CALL spmd_wait(req_s(i))
2213 ENDIF
2214 ENDDO
2215
2216#endif
2217 RETURN

◆ spmd_segcom()

subroutine spmd_segcom ( type(t_segvar) segvar,
integer, dimension(*) npsegcom,
integer, dimension(*) lsegcom,
integer size,
integer flag )

Definition at line 1663 of file spmd_cfd.F.

1664C-----------------------------------------------
1665C M o d u l e s
1666C-----------------------------------------------
1667 USE segvar_mod
1668 USE ale_mod
1669 USE spmd_mod
1670C-----------------------------------------------
1671C I m p l i c i t T y p e s
1672C-----------------------------------------------
1673#include "implicit_f.inc"
1674C-----------------------------------------------
1675C M e s s a g e P a s s i n g
1676C-----------------------------------------------
1677#include "spmd.inc"
1678C-----------------------------------------------
1679C C o m m o n B l o c k s
1680C-----------------------------------------------
1681#include "com01_c.inc"
1682#include "task_c.inc"
1683C-----------------------------------------------
1684C D u m m y A r g u m e n t s
1685C-----------------------------------------------
1686 INTEGER NPSEGCOM(*), LSEGCOM(*), FLAG, SIZE
1687 TYPE(t_segvar) :: SEGVAR
1688C-----------------------------------------------
1689C L o c a l V a r i a b l e s
1690C-----------------------------------------------
1691#ifdef MPI
1692 INTEGER I, IDEB, IDEB2, MSGOFF, MSGTYP,IAD_RECV(NSPMD),
1693 . REQ_R(NSPMD), IRINDEX(NSPMD),
1694 . LOC_PROC, N, KK, NN, NBIRECV, II, INDEX, LEN
1695 DATA msgoff/3012/
1696 my_real wa(size*ale%GLOBAL%NVCONV)
1697C-----------------------------------------------
1698
1699 loc_proc = ispmd+1
1700 IF(flag == 0) THEN
1701C
1702C Sending segvar from pi to p0
1703C
1704 IF(loc_proc/=1)THEN
1705 msgtyp = msgoff
1706 len = npsegcom(1)
1707 IF(len>0) THEN
1708 DO n = 1, len
1709 kk = lsegcom(n)
1710
1711 nn=1
1712 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1713 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RHO(kk)
1714 ENDIF
1715
1716 nn=2
1717 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1718 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%EINT(kk)
1719 ENDIF
1720
1721 nn=3
1722 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1723 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RK(kk)
1724 ENDIF
1725
1726 nn=4
1727 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1728 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RE(kk)
1729 ENDIF
1730
1731 nn=5
1732 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1733 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%UVAR(kk)
1734 ENDIF
1735
1736 ENDDO
1737 CALL spmd_send(
1738 s wa ,len*ale%GLOBAL%NVCONV,it_spmd(1),msgtyp)
1739 ENDIF
1740C
1741 ELSE
1742 ideb = 0
1743 nbirecv = 0
1744 DO i = 2, nspmd
1745 msgtyp = msgoff
1746 iad_recv(i) = ideb+1
1747 IF(npsegcom(i)>0) THEN
1748 nbirecv = nbirecv + 1
1749 irindex(nbirecv) = i
1750 len = ale%GLOBAL%NVCONV*npsegcom(i)
1751 CALL spmd_irecv(
1752 s wa(ideb+1),len,it_spmd(i),msgtyp,
1753 g req_r(nbirecv))
1754 ideb = ideb + len
1755 ENDIF
1756 ENDDO
1757C
1758 ideb = 0
1759 DO ii = 1, nbirecv
1760 CALL spmd_waitany(nbirecv,req_r,index)
1761 i = irindex(index)
1762 ideb2 = iad_recv(i)-1
1763 ideb = ideb2 / ale%GLOBAL%NVCONV
1764 DO n = 1, npsegcom(i)
1765 kk = lsegcom(ideb+n)
1766
1767 nn=1
1768 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1769 segvar%RHO(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1770 ENDIF
1771
1772 nn=2
1773 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1774 segvar%EINT(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1775 ENDIF
1776
1777 nn=3
1778 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1779 segvar%RK(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1780 ENDIF
1781
1782 nn=4
1783 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1784 segvar%RE(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1785 ENDIF
1786
1787 nn=5
1788 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1789 segvar%UVAR(kk) = wa(ideb2+ale%GLOBAL%NVCONV*(n-1)+nn)
1790 ENDIF
1791
1792 ENDDO
1793 ENDDO
1794 ENDIF
1795C
1796 ELSE
1797C
1798C Sending segvar from p0 to pi
1799C
1800 IF(loc_proc/=1)THEN
1801 msgtyp = msgoff
1802 len = npsegcom(1)
1803 IF(len>0) THEN
1804 CALL spmd_recv(
1805 s wa,len*ale%GLOBAL%NVCONV,it_spmd(1),msgtyp)
1806 DO n = 1, len
1807 kk = lsegcom(n)
1808
1809 nn=1
1810 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1811 segvar%RHO(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1812 ENDIF
1813
1814 nn=2
1815 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1816 segvar%EINT(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1817 ENDIF
1818
1819 nn=3
1820 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1821 segvar%RK(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1822 ENDIF
1823
1824 nn=4
1825 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1826 segvar%RE(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1827 ENDIF
1828
1829 nn=5
1830 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1831 segvar%UVAR(kk) = wa(ale%GLOBAL%NVCONV*(n-1)+nn)
1832 ENDIF
1833
1834 ENDDO
1835 ENDIF
1836C
1837 ELSE
1838 ideb = 0
1839 DO i = 2, nspmd
1840 len = npsegcom(i)
1841 IF(len>0) THEN
1842 msgtyp = msgoff
1843 DO n = 1, len
1844 kk = lsegcom(ideb+n)
1845
1846 nn=1
1847 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rho)THEN
1848 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RHO(kk)
1849 ENDIF
1850
1851 nn=2
1852 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_eint)THEN
1853 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%EINT(kk)
1854 ENDIF
1855
1856 nn=3
1857 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_rk)THEN
1858 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RK(kk)
1859 ENDIF
1860
1861 nn=4
1862 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_re)THEN
1863 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%RE(kk)
1864 ENDIF
1865
1866 nn=5
1867 IF(nn <= ale%GLOBAL%NVCONV .AND. segvar%has_uvar)THEN
1868 wa(ale%GLOBAL%NVCONV*(n-1)+nn) = segvar%UVAR(kk)
1869 ENDIF
1870
1871
1872 ENDDO
1873 CALL spmd_send(
1874 s wa ,len*ale%GLOBAL%NVCONV,it_spmd(i),msgtyp)
1875 ideb = ideb + len
1876 ENDIF
1877 ENDDO
1878 ENDIF
1879 ENDIF
1880C
1881
1882#endif
1883 RETURN
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
segvar_mod
Definition segvar_mod.F:61

◆ spmd_wvois()

subroutine spmd_wvois ( x,
d,
w,
integer, dimension(*) nbrcvois,
integer, dimension(*) nbsdvois,
integer, dimension(*) lnrcvois,
integer, dimension(*) lnsdvois,
integer lencom )

Definition at line 139 of file spmd_cfd.F.

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

◆ spmd_xvois()

subroutine spmd_xvois ( x,
integer, dimension(*) nbrcvois,
integer, dimension(*) nbsdvois,
integer, dimension(*) lnrcvois,
integer, dimension(*) lnsdvois,
integer lencom )

Definition at line 37 of file spmd_cfd.F.

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