From cdafe97fe34c306a512d6edd5ba68fd0e6c5d21e Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 3 Aug 2015 17:40:27 -0400 Subject: [PATCH] Fix debug mode crash for new icebergs io - This fixes issue #7 on NOAA-GFDL/Icebergs https://github.com/NOAA-GFDL/icebergs/issues/7 forrtl: severe (408): fort: (2): Subscript #1 of the array SBUF has value 1 which is greater than the upper bound of 0 --- mpp/include/mpp_gather.h | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/mpp/include/mpp_gather.h b/mpp/include/mpp_gather.h index 1b8c9ed145..c2b0c73642 100644 --- a/mpp/include/mpp_gather.h +++ b/mpp/include/mpp_gather.h @@ -66,16 +66,13 @@ subroutine MPP_GATHER_1DV_(sbuf, ssize, rbuf, rsize, pelist) !--- pre-post receiving - if(pe == op_root) then - rbuf(1:ssize) = sbuf(:) - pos = ssize - do l = 2, nproc - call mpp_recv(rbuf(pos+1), glen=rsize(l), from_pe=pelist2(l), block=.FALSE., tag=COMM_TAG_2 ) - pos = pos + rsize(l) - enddo - else - call mpp_send(sbuf(1), plen=ssize, to_pe=op_root, tag=COMM_TAG_2) - endif + pos = 1 + do l = 1, nproc ! include op_root to simplify logic + if(rsize(l) == 0) cycle ! avoid ranks with no data + call mpp_recv(rbuf(pos), glen=rsize(l), from_pe=pelist2(l), block=.FALSE., tag=COMM_TAG_2 ) + pos = pos + rsize(l) + enddo + if(ssize>0) call mpp_send(sbuf(1), plen=ssize, to_pe=op_root, tag=COMM_TAG_2) ! avoid ranks with no data call mpp_sync_self(check=EVENT_RECV) call mpp_sync_self()