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
nl = 0
tag2 = 0
pmeta => list_meta
do while (associated(pmeta))
@ -645,8 +646,8 @@ module mesh
if (pmeta%leaf) then
changed = .true.
tag1 = pmeta%id
tag2 = pmeta%id + get_last_id()
tag1 = tag2 + 1
tag2 = tag1 + 1
if (nproc == pmeta%process) then
@ -1439,7 +1440,7 @@ module mesh
integer(kind=4) :: l, p
#ifdef MPI
integer(kind=4) :: itag
integer(kind=4) :: tag
#endif /* MPI */
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
! created data block of the parent;
!
tag = 0
pmeta => list_meta
do while (associated(pmeta))
if (.not. pmeta%leaf) then
@ -1509,10 +1510,10 @@ module mesh
if (pchild%process /= pmeta%process) then
itag = pchild%id
tag = tag + 1
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)
if (status /= 0) then
@ -1530,7 +1531,7 @@ module mesh
go to 100
end if
call receive_array(pchild%process, itag, pdata%uu)
call receive_array(pchild%process, tag, pdata%uu)
end if
pchild%process = pmeta%process