MESH: Avoid very large MPI tags.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2022-02-15 19:21:20 -03:00
parent dbb4ad6c55
commit 2db9062683

View File

@ -636,6 +636,7 @@ module mesh
np = 0 np = 0
nl = 0 nl = 0
tag2 = 0
pmeta => list_meta pmeta => list_meta
do while (associated(pmeta)) do while (associated(pmeta))
@ -645,8 +646,8 @@ module mesh
if (pmeta%leaf) then if (pmeta%leaf) then
changed = .true. changed = .true.
tag1 = pmeta%id tag1 = tag2 + 1
tag2 = pmeta%id + get_last_id() tag2 = tag1 + 1
if (nproc == pmeta%process) then if (nproc == pmeta%process) then
@ -1439,7 +1440,7 @@ module mesh
integer(kind=4) :: l, p integer(kind=4) :: l, p
#ifdef MPI #ifdef MPI
integer(kind=4) :: itag integer(kind=4) :: tag
#endif /* MPI */ #endif /* MPI */
logical, dimension(nchildren) :: flag logical, dimension(nchildren) :: flag
@ -1492,8 +1493,8 @@ module mesh
! 2) bring all siblings to the same process, so we can merge them into a newly ! 2) bring all siblings to the same process, so we can merge them into a newly
! created data block of the parent; ! created data block of the parent;
! !
tag = 0
pmeta => list_meta pmeta => list_meta
do while (associated(pmeta)) do while (associated(pmeta))
if (.not. pmeta%leaf) then if (.not. pmeta%leaf) then
@ -1509,10 +1510,10 @@ module mesh
if (pchild%process /= pmeta%process) then if (pchild%process /= pmeta%process) then
itag = pchild%id tag = tag + 1
if (pchild%process == nproc) then if (pchild%process == nproc) then
call send_array(pmeta%process, itag, pchild%data%uu) call send_array(pmeta%process, tag, pchild%data%uu)
call remove_datablock(pchild%data, status) call remove_datablock(pchild%data, status)
if (status /= 0) then if (status /= 0) then
@ -1530,7 +1531,7 @@ module mesh
go to 100 go to 100
end if end if
call receive_array(pchild%process, itag, pdata%uu) call receive_array(pchild%process, tag, pdata%uu)
end if end if
pchild%process = pmeta%process pchild%process = pmeta%process