Skip to content

Commit

Permalink
Merge branch 'rljacob/cime/update2-mct-2.10.beta' into next (#1452)
Browse files Browse the repository at this point in the history
third merge of this branch with better fix for bug

* rljacob/cime/update2-mct-2.10.beta:
  Allocate send/recv buffs even if nprocs eq 0
  • Loading branch information
rljacob committed May 23, 2017
2 parents 1c24a95 + 8dd26b0 commit 33602f9
Showing 1 changed file with 4 additions and 41 deletions.
45 changes: 4 additions & 41 deletions cime/src/externals/mct/mct/m_Rearranger.F90
Original file line number Diff line number Diff line change
Expand Up @@ -792,9 +792,6 @@ subroutine rearrange_(SourceAVin,TargetAV,InRearranger,Tag,Sum,&

! ALLOCATE DATA STRUCTURES !

! IF SENDING DATA
if(SendRout%nprocs > 0) then

! IF SENDING INTEGER DATA
if(numi .ge. 1) then

Expand Down Expand Up @@ -825,17 +822,8 @@ subroutine rearrange_(SourceAVin,TargetAV,InRearranger,Tag,Sum,&


endif
else
! the m_swap call needs these allocated even if
! SendRout%nprocs = 0.
if (useswapm) then
if(numi .ge. 1) allocate(ISendBuf(1),stat=ier)
if(numr .ge. 1) allocate(RSendBuf(1),stat=ier)
endif
endif

! IF RECEVING DATA
if(RecvRout%nprocs > 0) then

! IF RECEIVING INTEGER DATA
if(numi .ge. 1) then
Expand Down Expand Up @@ -868,15 +856,6 @@ subroutine rearrange_(SourceAVin,TargetAV,InRearranger,Tag,Sum,&

endif

else
! the m_swap call needs these allocated even if
! RecvRout%nprocs = 0.
if (useswapm) then
if(numi .ge. 1) allocate(IRecvBuf(1),stat=ier)
if(numr .ge. 1) allocate(RRecvBuf(1),stat=ier)
endif
endif

!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

! INVERT PE LIST !
Expand Down Expand Up @@ -1346,30 +1325,12 @@ subroutine rearrange_(SourceAVin,TargetAV,InRearranger,Tag,Sum,&

! DEALLOCATE ALL STRUCTURES

if(SendRout%nprocs > 0) then

if(numi .ge. 1) then

! Deallocate the send buffer
deallocate(ISendBuf,stat=ier)
if(ier/=0) call die(myname_,'deallocate(ISendBuf)',ier)

endif

if(numr .ge. 1) then

! Deallocate the send buffer
deallocate(RSendBuf,stat=ier)
if(ier/=0) call die(myname_,'deallocate(RSendBuf)',ier)

endif

endif

if(RecvRout%nprocs > 0) then

if(numi .ge. 1) then

! Deallocate the receive buffer
deallocate(IRecvBuf,stat=ier)
if(ier/=0) call die(myname_,'deallocate(IRecvBuf)',ier)
Expand All @@ -1378,14 +1339,16 @@ subroutine rearrange_(SourceAVin,TargetAV,InRearranger,Tag,Sum,&

if(numr .ge. 1) then

! Deallocate the send buffer
deallocate(RSendBuf,stat=ier)
if(ier/=0) call die(myname_,'deallocate(RSendBuf)',ier)

! Deallocate the receive buffer
deallocate(RRecvBuf,stat=ier)
if(ier/=0) call die(myname_,'deallocate(RRecvBuf)',ier)

endif

endif

nullify(SendRout,RecvRout)

end subroutine rearrange_
Expand Down

0 comments on commit 33602f9

Please sign in to comment.