mpp_domains_define.inc

! -*-f90-*-
!***********************************************************************
!*                             Apache License 2.0
!*
!* This file is part of the GFDL Flexible Modeling System (FMS).
!*
!* Licensed under the Apache License, Version 2.0 (the "License");
!* you may not use this file except in compliance with the License.
!* You may obtain a copy of the License at
!*
!*     http://www.apache.org/licenses/LICENSE-2.0
!*
!* FMS is distributed in the hope that it will be useful, but WITHOUT
!* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
!* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
!* PARTICULAR PURPOSE. See the License for the specific language
!* governing permissions and limitations under the License.
!***********************************************************************
 
!> @file
!> @brief Various routines handling domains in @ref mpp_domains_mod
 
!> @addtogroup mpp_domains_mod
!> @{
  !> @brief Instantiates a layout with the given indices and divisions
  subroutine mpp_define_layout2d( global_indices, ndivs, layout )
    integer, intent(in) :: global_indices(:) !< (/ isg, ieg, jsg, jeg /); Defines the global domain.
    integer, intent(in) :: ndivs !< number of divisions to divide global domain
    integer, intent(out) :: layout(:)
 
    integer :: isg, ieg, jsg, jeg, isz, jsz, idiv, jdiv
 
    if(size(global_indices(:)) .NE. 4) call mpp_error(fatal,"mpp_define_layout2D: size of global_indices should be 4")
    if(size(layout(:)) .NE. 2) call mpp_error(fatal,"mpp_define_layout2D: size of layout should be 2")
 
    isg = global_indices(1)
    ieg = global_indices(2)
    jsg = global_indices(3)
    jeg = global_indices(4)
 
    isz = ieg - isg + 1
    jsz = jeg - jsg + 1
    !first try to divide ndivs in the domain aspect ratio: if imperfect aspect, reduce idiv till it divides ndivs
    idiv = nint( sqrt(float(ndivs*isz)/jsz) )
    idiv = max(idiv,1) !for isz=1 line above can give 0
    do while( mod(ndivs,idiv).NE.0 )
       idiv = idiv - 1
    end do                 !will terminate at idiv=1 if not before
    jdiv = ndivs/idiv
 
    layout = (/ idiv, jdiv /)
    return
  end subroutine mpp_define_layout2d
 
  !############################################################################
 
  !> Defines a pelist for use with mosaic tiles
  !! @note The following routine may need to revised to improve the capability.
  !!  It is very hard to make it balance for all the situation.
  !!  Hopefully some smart idea will come up someday.
  subroutine mpp_define_mosaic_pelist( sizes, pe_start, pe_end, pelist, costpertile)
    integer, dimension(:), intent(in)           :: sizes
    integer, dimension(:), intent(inout)        :: pe_start, pe_end
    integer, dimension(:), intent(in), optional :: pelist, costpertile
    integer, dimension(size(sizes(:)))          :: costs
    integer, dimension(:), allocatable          :: pes
    integer                                     :: ntiles, npes, totcosts, avgcost
    integer                                     :: ntiles_left, npes_left, pos, n, tile
    integer                                     :: cost_on_tile, cost_on_pe, npes_used, errunit
 
    ntiles = size(sizes(:))
    if(size(pe_start(:)) .NE. ntiles .OR. size(pe_end(:)) .NE. ntiles ) then
       call mpp_error(fatal, "mpp_define_mosaic_pelist: size mismatch between pe_start/pe_end and sizes")
    end if
 
    if(present(costpertile)) then
       if(size(costpertile(:)) .NE. ntiles ) then
          call mpp_error(fatal, "mpp_define_mosaic_pelist: size mismatch between costpertile and sizes")
       end if
       costs = sizes*costpertile
    else
       costs = sizes
    end if
 
    if( PRESENT(pelist) )then
       if( .NOT.any(pelist.EQ.mpp_pe()) )then
          errunit = stderr()
          write( errunit,* )'pe=', mpp_pe(), ' pelist=', pelist
          call mpp_error( fatal, 'mpp_define_mosaic_pelist: pe must be in pelist.' )
       end if
       npes = size(pelist(:))
       allocate( pes(0:npes-1) )
       pes(:) = pelist(:)
    else
       npes = mpp_npes()
       allocate( pes(0:npes-1) )
       call mpp_get_current_pelist(pes)
    end if
 
    ntiles_left = ntiles
    npes_left = npes
    pos = pes(0)
 
    do while( ntiles_left > 0 )
       if( npes_left == 1 ) then ! all left tiles will on the last processor, imbalance possibly.
          do n = 1, ntiles
             if(costs(n) > 0) then
                pe_start(n) = pos
                pe_end(n) = pos
                costs(n)  = 0
             end if
          end do
          ntiles_left = 0
          npes_left = 0
       else
          totcosts = sum(costs)
          avgcost  = ceiling(real(totcosts)/npes_left )
          tile = minval(maxloc(costs))
          cost_on_tile = costs(tile)
          pe_start(tile) = pos
          ntiles_left = ntiles_left - 1
          costs(tile) = 0
          totcosts = totcosts - cost_on_tile
          if(cost_on_tile .GE. avgcost ) then
             npes_used = min(ceiling(real(cost_on_tile)/avgcost), npes_left)
             if( ntiles_left > 0 .AND. npes_used == npes_left ) npes_used = npes_used - 1
             pe_end(tile) = pos + npes_used - 1
             npes_left = npes_left - npes_used
             pos = pos + npes_used
          else
             !--- find other tiles to share the pe
             pe_end(tile) = pos
             cost_on_pe = cost_on_tile
             do while(ntiles_left>npes_left)  ! make sure all the pes are used.
                tile = minval(minloc(costs, costs> 0 ))
                cost_on_tile = costs(tile)
                cost_on_pe = cost_on_pe + cost_on_tile
                if(cost_on_pe > avgcost ) exit
                pe_start(tile) = pos
                pe_end(tile) = pos
                ntiles_left = ntiles_left - 1
                costs(tile) = 0
                totcosts = totcosts - cost_on_tile
             end do
             npes_left = npes_left - 1
             pos = pos + 1
          end if
       end if
    end do
 
    if(npes_left .NE. 0 ) call mpp_error(fatal, "mpp_define_mosaic_pelist: the left npes should be zero")
    deallocate(pes)
 
  end subroutine mpp_define_mosaic_pelist
 
  !> Computes the extents of a grid block
  !!
  !> Tis implementation is different from mpp_compute_extents
  !! The last block might have most points
  subroutine mpp_compute_block_extent(isg,ieg,ndivs,ibegin,iend)
    integer,                 intent(in) :: isg, ieg, ndivs
    integer, dimension(:), intent(out)  :: ibegin, iend
 
    integer :: ndiv
    integer :: is, ie
 
    ie = ieg
    do ndiv=ndivs,1,-1
      !domain is sized by dividing remaining points by remaining domains
      is = ie - ceiling( real(ie-isg+1)/ndiv ) + 1
      ibegin(ndiv) = is
      iend(ndiv) = ie
 
      if( ie.LT.is )call mpp_error( fatal,  &
          'MPP_DEFINE_DOMAINS(mpp_compute_block_extent): domain extents must be positive definite.' )
      if( ndiv.EQ.1 .AND. ibegin(ndiv) .NE. isg ) &
          call mpp_error( fatal, 'mpp_compute_block_extent: domain extents do not span space completely.' )
      ie = is - 1
     end do
 
  end subroutine mpp_compute_block_extent
 
 
  !#####################################################################
  !> Computes extents for a grid decomposition with the given indices and divisions
  subroutine mpp_compute_extent(isg,ieg,ndivs,ibegin,iend, extent )
    integer,                 intent(in)          :: isg, ieg, ndivs
    integer, dimension(0:), intent(out)          :: ibegin, iend
    integer, dimension(0:), intent(in), optional :: extent
 
    integer :: ndiv, imax, ndmax, ndmirror
    integer :: is, ie, n
    logical :: symmetrize, use_extent
    !statement functions
    logical :: even, odd
    even(n) = (mod(n,2).EQ.0)
    odd(n) = (mod(n,2).EQ.1)
 
    use_extent = .false.
    if(PRESENT(extent)) then
       if( size(extent(:)).NE.ndivs ) &
            call mpp_error( fatal, 'mpp_compute_extent: extent array size must equal number of domain divisions.' )
       use_extent = .true.
       if(all(extent ==0)) use_extent = .false.
    endif
 
    is = isg
    if(use_extent) then
       ibegin(0) = isg
       do ndiv = 0, ndivs-2
          if(extent(ndiv) .LE. 0) call mpp_error( fatal, &
             &  'mpp_compute_extent: domain extents must be positive definite.' )
          iend(ndiv) = ibegin(ndiv) + extent(ndiv) - 1
          ibegin(ndiv+1) = iend(ndiv) + 1
       enddo
       iend(ndivs-1) = ibegin(ndivs-1) + extent(ndivs-1) - 1
       if(iend(ndivs-1) .NE. ieg) call mpp_error(fatal, &
          &  'mpp_compute_extent: extent array limits do not match global domain.' )
    else
       do ndiv=0,ndivs-1
          !modified for mirror-symmetry
          !original line
          !                 ie = is + CEILING( float(ieg-is+1)/(ndivs-ndiv) ) - 1
 
          !problem of dividing nx points into n domains maintaining symmetry
          !i.e nx=18 n=4 4554 and 5445 are solutions but 4455 is not.
          !this will always work for nx even n even or odd
          !this will always work for nx odd, n odd
          !this will never  work for nx odd, n even: for this case we supersede the mirror calculation
          !                 symmetrize = .NOT. ( mod(ndivs,2).EQ.0 .AND. mod(ieg-isg+1,2).EQ.1 )
          !nx even n odd fails if n>nx/2
          symmetrize = ( even(ndivs) .AND. even(ieg-isg+1) ) .OR. &
               (  odd(ndivs) .AND.  odd(ieg-isg+1) ) .OR. &
               (  odd(ndivs) .AND. even(ieg-isg+1) .AND. ndivs.LT.(ieg-isg+1)/2 )
 
          !mirror domains are stored in the list and retrieved if required.
          if( ndiv.EQ.0 )then
             !initialize max points and max domains
             imax = ieg
             ndmax = ndivs
          end if
          !do bottom half of decomposition, going over the midpoint for odd ndivs
          if( ndiv.LT.(ndivs-1)/2+1 )then
             !domain is sized by dividing remaining points by remaining domains
             ie = is + ceiling( real(imax-is+1)/(ndmax-ndiv) ) - 1
             ndmirror = (ndivs-1) - ndiv !mirror domain
             if( ndmirror.GT.ndiv .AND. symmetrize )then !only for domains over the midpoint
                !mirror extents, the max(,) is to eliminate overlaps
                ibegin(ndmirror) = max( isg+ieg-ie, ie+1 )
                iend(ndmirror)   = max( isg+ieg-is, ie+1 )
                imax = ibegin(ndmirror) - 1
                ndmax = ndmax - 1
             end if
          else
             if( symmetrize )then
                !do top half of decomposition by retrieving saved values
                is = ibegin(ndiv)
                ie = iend(ndiv)
             else
                ie = is + ceiling( real(imax-is+1)/(ndmax-ndiv) ) - 1
             end if
          end if
          ibegin(ndiv) = is
          iend(ndiv) = ie
          if( ie.LT.is )call mpp_error( fatal,  &
               'MPP_DEFINE_DOMAINS(mpp_compute_extent): domain extents must be positive definite.' )
          if( ndiv.EQ.ndivs-1 .AND. iend(ndiv).NE.ieg ) &
               call mpp_error( fatal, 'mpp_compute_extent: domain extents do not span space completely.' )
          is = ie + 1
       end do
    endif
 
 
  end subroutine mpp_compute_extent
 
  !#####################################################################
 
 
  !> Define data and computational domains on a 1D set of data (isg:ieg) and assign them to PEs
  subroutine mpp_define_domains1d( global_indices, ndivs, domain, pelist, flags, halo, extent, maskmap, &
                                   memory_size, begin_halo, end_halo )
    integer,           intent(in) :: global_indices(:) !< (/ isg, ieg /) gives the extent of global domain
    integer,           intent(in) :: ndivs !< number of divisions of domain: even divisions unless extent is present.
    type(domain1d), intent(inout) :: domain !< the returned domain1D; declared inout so that
                                            !! existing links, if any, can be nullified
    integer, intent(in), optional :: pelist(0:) !< list of PEs to which domains are to be assigned
                                                !! (default 0...npes-1); size of pelist must
                                                !! correspond to number of mask=.TRUE. divisions
    integer, intent(in), optional :: flags, halo !< flags define whether compute and data domains
                                                 !! are global (undecomposed) and whether the global
                                                 !! domain has periodic boundaries.
                                                 !! halo defines halo width (currently the same on both sides)
    integer, intent(in), optional :: extent(0:) !< array extent; defines width of each division
                                                !! (used for non-uniform domain decomp, for e.g load-balancing)
    logical, intent(in), optional :: maskmap(0:) !< a division whose maskmap=.FALSE. is not
                                                 !! assigned to any domain. By default we assume
                                                 !! decomposition of compute and data domains, non-periodic boundaries,
                                                 !! no halo, as close to uniform extents as the
                                                 !! input parameters permit
    integer, intent(in), optional :: memory_size
    integer, intent(in), optional :: begin_halo, end_halo
 
    logical              :: compute_domain_is_global, data_domain_is_global
    integer              :: ndiv, n, isg, ieg
    integer, allocatable :: pes(:)
    integer              :: ibegin(0:ndivs-1), iend(0:ndivs-1)
    logical              :: mask(0:ndivs-1)
    integer              :: halosz, halobegin, haloend
    integer              :: errunit
 
    if( .NOT.module_is_initialized )call mpp_error( fatal, &
       &  'MPP_DEFINE_DOMAINS1D: You must first call mpp_domains_init.' )
    if(size(global_indices(:)) .NE. 2) call mpp_error(fatal,"mpp_define_domains1D: size of global_indices should be 2")
    !get global indices
    isg = global_indices(1)
    ieg = global_indices(2)
    if( ndivs.GT.ieg-isg+1 )call mpp_error( fatal, &
       &  'MPP_DEFINE_DOMAINS1D: more divisions requested than rows available.' )
    !get the list of PEs on which to assign domains; if pelist is absent use 0..npes-1
    if( PRESENT(pelist) )then
       if( .NOT.any(pelist.EQ.mpp_pe()) )then
          errunit = stderr()
          write( errunit,* )'pe=', mpp_pe(), ' pelist=', pelist
          call mpp_error( fatal, 'MPP_DEFINE_DOMAINS1D: pe must be in pelist.' )
       end if
       allocate( pes(0:size(pelist(:))-1) )
       pes(:) = pelist(:)
    else
       allocate( pes(0:mpp_npes()-1) )
       call mpp_get_current_pelist(pes)
!       pes(:) = (/ (i,i=0,mpp_npes()-1) /)
    end if
 
    !get number of real domains: 1 mask domain per PE in pes
    mask = .true.                 !default mask
    if( PRESENT(maskmap) )then
       if( size(maskmap(:)).NE.ndivs ) &
            call mpp_error( fatal, 'MPP_DEFINE_DOMAINS1D: maskmap array size must equal number of domain divisions.' )
       mask(:) = maskmap(:)
    end if
    if( count(mask).NE.size(pes(:)) ) &
         call mpp_error( fatal, 'MPP_DEFINE_DOMAINS1D: number of TRUEs in maskmap array must match PE count.' )
 
    !get halosize
    halosz = 0
    if( PRESENT(halo) ) then
       halosz = halo
       !--- if halo is present, begin_halo and end_halo should not present
       if(present(begin_halo) .OR. present(end_halo) ) call mpp_error(fatal, &
            "mpp_domains_define.inc: when halo is present, begin_halo and end_halo should not present")
    end if
    halobegin = halosz; haloend = halosz
    if(present(begin_halo)) halobegin = begin_halo
    if(present(end_halo))   haloend   = end_halo
    halosz = max(halobegin, haloend)
    !get flags
    compute_domain_is_global = .false.
    data_domain_is_global    = .false.
    domain%cyclic = .false.
    domain%goffset = 1
    domain%loffset = 1
    if( PRESENT(flags) )then
       !NEW: obsolete flag global_compute_domain, since ndivs is non-optional and you cannot
       !have global compute and ndivs.NE.1
       compute_domain_is_global = ndivs.EQ.1
       !if compute domain is global, data domain must also be
       data_domain_is_global    = btest(flags,global) .OR. compute_domain_is_global
       domain%cyclic  = btest(flags,cyclic) .AND. halosz.NE.0
       if(btest(flags,cyclic)) domain%goffset = 0
    end if
 
    !set up links list
    allocate( domain%list(0:ndivs-1) )
 
    !set global domain
    domain%list(:)%global%begin     = isg
    domain%list(:)%global%end       = ieg
    domain%list(:)%global%size      = ieg-isg+1
    domain%list(:)%global%max_size  = ieg-isg+1
    domain%list(:)%global%is_global = .true. !always
 
    !get compute domain
    if( compute_domain_is_global )then
       domain%list(:)%compute%begin = isg
       domain%list(:)%compute%end   = ieg
       domain%list(:)%compute%is_global = .true.
       domain%list(:)%pe = pes(:)
       domain%pos = 0
    else
       domain%list(:)%compute%is_global = .false.
       n = 0
       call mpp_compute_extent(isg, ieg, ndivs, ibegin, iend, extent)
       do ndiv=0,ndivs-1
          domain%list(ndiv)%compute%begin = ibegin(ndiv)
          domain%list(ndiv)%compute%end   = iend(ndiv)
          if( mask(ndiv) )then
             domain%list(ndiv)%pe = pes(n)
             if( mpp_pe().EQ.pes(n) )domain%pos = ndiv
             n = n + 1
          else
             domain%list(ndiv)%pe = null_pe
          end if
       end do
    end if
 
    domain%list(:)%compute%size  = domain%list(:)%compute%end - domain%list(:)%compute%begin + 1
 
    !get data domain
    !data domain is at least equal to compute domain
    domain%list(:)%domain_data%begin = domain%list(:)%compute%begin
    domain%list(:)%domain_data%end   = domain%list(:)%compute%end
    domain%list(:)%domain_data%is_global = .false.
    !apply global flags
    if( data_domain_is_global )then
       domain%list(:)%domain_data%begin  = isg
       domain%list(:)%domain_data%end    = ieg
       domain%list(:)%domain_data%is_global = .true.
    end if
    !apply margins
    domain%list(:)%domain_data%begin = domain%list(:)%domain_data%begin - halobegin
    domain%list(:)%domain_data%end   = domain%list(:)%domain_data%end   + haloend
    domain%list(:)%domain_data%size  = domain%list(:)%domain_data%end - domain%list(:)%domain_data%begin + 1
 
    !--- define memory domain, if memory_size is not present or memory size is 0, memory domain size
    !--- will be the same as data domain size. if momory_size is present, memory_size should greater than
    !--- or equal to data size. The begin of memory domain will be always the same as data domain.
    domain%list(:)%memory%begin = domain%list(:)%domain_data%begin
    domain%list(:)%memory%end   = domain%list(:)%domain_data%end
    if( present(memory_size) ) then
       if(memory_size > 0) then
          if( domain%list(domain%pos)%domain_data%size > memory_size ) call mpp_error(fatal, &
               "mpp_domains_define.inc: data domain size is larger than memory domain size on this pe")
          domain%list(:)%memory%end   = domain%list(:)%memory%begin + memory_size - 1
       end if
    end if
    domain%list(:)%memory%size = domain%list(:)%memory%end - domain%list(:)%memory%begin + 1
    domain%list(:)%memory%is_global = domain%list(:)%domain_data%is_global
 
    domain%compute = domain%list(domain%pos)%compute
    domain%domain_data    = domain%list(domain%pos)%domain_data
    domain%global  = domain%list(domain%pos)%global
    domain%memory  = domain%list(domain%pos)%memory
    domain%compute%max_size = maxval( domain%list(:)%compute%size )
    domain%domain_data%max_size    = maxval( domain%list(:)%domain_data%size )
    domain%global%max_size  = domain%global%size
    domain%memory%max_size  = domain%memory%size
 
    !PV786667: the deallocate stmts can be removed when fixed (7.3.1.3m)
    deallocate( pes )
    return
 
  end subroutine mpp_define_domains1d
 
  !################################################################################
  !> Define the layout for IO pe's for the given domain
  subroutine mpp_define_io_domain(domain, io_layout)
    type(domain2d), intent(inout) :: domain !< Input 2D domain
    integer,        intent(in   ) :: io_layout(2) !< 2 value io pe layout to define
    integer                       :: layout(2)
    integer                       :: npes_in_group
    type(domain2d), pointer       :: io_domain=>null()
    integer                       :: i, j, n, m
    integer                       :: ipos, jpos, igroup, jgroup
    integer                       :: ipos_beg, ipos_end, jpos_beg, jpos_end
    integer                       :: whalo, ehalo, shalo, nhalo
    integer                       :: npes_x, npes_y, ndivx, ndivy
    integer, allocatable          :: posarray(:,:)
 
    if(io_layout(1) * io_layout(2) .LE. 0) then
       call mpp_error(note,  &
         "mpp_domains_define.inc(mpp_define_io_domain): io domain will not be defined for "//trim(domain%name)// &
         " when one or both entry of io_layout is not positive")
       return
    endif
 
    layout(1) = size(domain%x(1)%list(:))
    layout(2) = size(domain%y(1)%list(:))
 
    if(ASSOCIATED(domain%io_domain)) call mpp_error(fatal, &
       "mpp_domains_define.inc(mpp_define_io_domain): io_domain is already defined")
 
    if(mod(layout(1), io_layout(1)) .NE. 0) call mpp_error(fatal, &
       "mpp_domains_define.inc(mpp_define_io_domain): "//trim(domain%name)// &
                             & " domain layout(1) must be divided by io_layout(1)")
    if(mod(layout(2), io_layout(2)) .NE. 0) call mpp_error(fatal, &
       "mpp_domains_define.inc(mpp_define_io_domain): "//trim(domain%name)// &
                             & " domain layout(2) must be divided by io_layout(2)")
    if(size(domain%x(:)) > 1) call mpp_error(fatal, &
       "mpp_domains_define.inc(mpp_define_io_domain): "//trim(domain%name)// &
       ": multiple tile per pe is not supported yet for this routine")
 
    if (associated(domain%io_domain)) deallocate(domain%io_domain) !< Check if associated
    allocate(domain%io_domain)
    domain%io_layout = io_layout
    io_domain => domain%io_domain
    ! Find how many processors are in the group with the consideration that some of the region maybe masked out.
    npes_x = layout(1)/io_layout(1)
    npes_y = layout(2)/io_layout(2)
    ipos = mod(domain%x(1)%pos, npes_x)
    jpos = mod(domain%y(1)%pos, npes_y)
    igroup  = domain%x(1)%pos/npes_x
    jgroup  = domain%y(1)%pos/npes_y
    ipos_beg = igroup*npes_x; ipos_end = ipos_beg + npes_x - 1
    jpos_beg = jgroup*npes_y; jpos_end = jpos_beg + npes_y - 1
    npes_in_group = 0
    do j = jpos_beg, jpos_end
       do i = ipos_beg, ipos_end
          if(domain%pearray(i,j) .NE. null_pe) npes_in_group = npes_in_group+1
       enddo
    enddo
 
    io_domain%whalo    = domain%whalo
    io_domain%ehalo    = domain%ehalo
    io_domain%shalo    = domain%shalo
    io_domain%nhalo    = domain%nhalo
    io_domain%ntiles   = 1
    io_domain%pe       = domain%pe
    io_domain%symmetry = domain%symmetry
    if (associated(io_domain%list)) deallocate(io_domain%list) !< Check if associated
    allocate(io_domain%list(0:npes_in_group-1))
    do i = 0, npes_in_group-1
       allocate( io_domain%list(i)%x(1), io_domain%list(i)%y(1), io_domain%list(i)%tile_id(1) )
    enddo
 
    ndivx = size(domain%pearray,1)
    ndivy = size(domain%pearray,2)
    allocate(posarray(0:ndivx-1, 0:ndivy-1))
    n = domain%tile_root_pe - mpp_root_pe()
    posarray = -1
    do j = 0,ndivy-1
       do i = 0,ndivx-1
          if( domain%pearray(i,j) == null_pe) cycle
          posarray(i,j) = n
          n = n + 1
       enddo
    enddo
 
    n = 0
    do j = jpos_beg, jpos_end
       do i = ipos_beg, ipos_end
          if( domain%pearray(i,j) == null_pe) cycle
          io_domain%list(n)%pe = domain%pearray(i,j)
          m = posarray(i,j)
          io_domain%list(n)%x(1)%compute = domain%list(m)%x(1)%compute
          io_domain%list(n)%y(1)%compute = domain%list(m)%y(1)%compute
          igroup                         = domain%list(m)%x(1)%pos/npes_x
          jgroup                         = domain%list(m)%y(1)%pos/npes_y
          io_domain%list(n)%tile_id(1)   = jgroup*io_layout(1) + igroup
          n = n + 1
       enddo
    enddo
    deallocate(posarray)
 
    if (associated(io_domain%x)) deallocate(io_domain%x) !< Check if associated
    if (associated(io_domain%y)) deallocate(io_domain%y) !< Check if associated
    if (associated(io_domain%tile_id)) deallocate(io_domain%tile_id) !< Check if associated
    allocate(io_domain%x(1), io_domain%y(1), io_domain%tile_id(1) )
    allocate(io_domain%x(1)%list(0:npes_x-1), io_domain%y(1)%list(0:npes_y-1) )
    n = -1
    do j = jpos_beg, jpos_beg+jpos
       do i = ipos_beg, ipos_beg+ipos
          if(domain%pearray(i,j) .NE. null_pe) n = n + 1
       enddo
    enddo
    io_domain%pos          = n
    io_domain%x(1)%compute = domain%x(1)%compute
    io_domain%x(1)%domain_data    = domain%x(1)%domain_data
    io_domain%x(1)%memory  = domain%x(1)%memory
    io_domain%y(1)%compute = domain%y(1)%compute
    io_domain%y(1)%domain_data    = domain%y(1)%domain_data
    io_domain%y(1)%memory  = domain%y(1)%memory
    io_domain%x(1)%global%begin     = domain%x(1)%list(ipos_beg)%compute%begin
    io_domain%x(1)%global%end       = domain%x(1)%list(ipos_end)%compute%end
    io_domain%x(1)%global%size      = io_domain%x(1)%global%end - io_domain%x(1)%global%begin + 1
    io_domain%x(1)%global%max_size  = io_domain%x(1)%global%size
    io_domain%y(1)%global%begin     = domain%y(1)%list(jpos_beg)%compute%begin
    io_domain%y(1)%global%end       = domain%y(1)%list(jpos_end)%compute%end
    io_domain%y(1)%global%size      = io_domain%y(1)%global%end - io_domain%y(1)%global%begin + 1
    io_domain%y(1)%global%max_size  = io_domain%y(1)%global%size
    io_domain%x(1)%pos     = ipos
    io_domain%y(1)%pos     = jpos
    io_domain%tile_id(1)   = io_domain%list(n)%tile_id(1)
    io_domain%tile_root_pe = io_domain%list(0)%pe
 
    !z1l
!!$    do j = 0, npes_y - 1
!!$       n = j*npes_x + ipos
!!$       io_domain%y(1)%list(j) = io_domain%list(n)%y(1)
!!$    enddo
!!$    do i = 0, npes_x - 1
!!$       n = jpos*npes_x + i
!!$       io_domain%x(1)%list(i) = io_domain%list(n)%x(1)
!!$    enddo
 
    whalo = domain%whalo
    ehalo = domain%ehalo
    shalo = domain%shalo
    nhalo = domain%nhalo
 
    io_domain=>null()
 
 
  end subroutine mpp_define_io_domain
 
  !> Define 2D data and computational domain on global rectilinear cartesian domain
  !! (isg:ieg,jsg:jeg) and assign them to PEs
  subroutine mpp_define_domains2d( global_indices, layout, domain, pelist, xflags, yflags,    &
         xhalo, yhalo, xextent, yextent, maskmap, name, symmetry,  memory_size,               &
         whalo, ehalo, shalo, nhalo, is_mosaic, tile_count, tile_id, complete, x_cyclic_offset, y_cyclic_offset )
    integer,          intent(in)           :: global_indices(:) !<(/ isg, ieg, jsg, jeg /)
    integer,          intent(in)           :: layout(:) !< pe layout
    type(domain2d),   intent(inout)        :: domain !< 2D domain decomposition to define
    integer,          intent(in), optional :: pelist(0:) !< current pelist to run on
    integer,          intent(in), optional :: xflags, yflags !< directional flag
    integer,          intent(in), optional :: xhalo, yhalo !< halo sizes for x and y indices
    integer,          intent(in), optional :: xextent(0:), yextent(0:)
    logical,          intent(in), optional :: maskmap(0:,0:)
    character(len=*), intent(in), optional :: name
    logical,          intent(in), optional :: symmetry
    logical,          intent(in), optional :: is_mosaic                  !< indicate if calling mpp_define_domains
                                                                         !! from mpp_define_mosaic.
    integer,          intent(in), optional :: memory_size(:)
    integer,          intent(in), optional :: whalo, ehalo, shalo, nhalo !< halo size for West, East,
                                                                         !! South and North direction.
                                                                         !! if whalo and ehalo is not present,
                                                                         !! will take the value of xhalo
                                                                         !! if shalo and nhalo is not present,
                                                                         !! will take the value of yhalo
    integer, intent(in),          optional :: tile_count                 !< tile number on current pe,
                                                                         !! default value is 1.
                                                                         !! this is for the situation that
                                                                         !! multiple tiles on one processor
    integer, intent(in),          optional :: tile_id                    !< tile id
    logical, intent(in),          optional :: complete                   !< true indicate mpp_define_domain
                                                                         !! is completed for mosaic definition.
    integer, intent(in),          optional :: x_cyclic_offset            !< offset for x-cyclic boundary condition,
                                                                         !! (0,j) = (ni, mod(j+x_cyclic_offset,nj))
                                                                         !! (ni+1, j)=(1 ,mod(j+nj-x_cyclic_offset,nj))
    integer, intent(in),          optional :: y_cyclic_offset            !< offset for y-cyclic boundary condition
                                                                         !!(i,0)    = (mod(i+y_cyclic_offset,ni), nj))
                                                                         !!(i,nj+1) =(mod(mod(i+ni-y_cyclic_offset,ni),
                                                                         !! 1) )
 
    integer              :: i, j, m, n, xhalosz, yhalosz, memory_xsize, memory_ysize
    integer              :: whalosz, ehalosz, shalosz, nhalosz
    integer              :: ipos, jpos, pos, tile, nlist, cur_tile_id, cur_comm_id
    integer              :: ndivx, ndivy, isg, ieg, jsg, jeg, ishift, jshift, errunit, logunit
    integer              :: x_offset, y_offset, start_pos, nfold
    logical              :: from_mosaic, is_complete
    logical              :: mask(0:layout(1)-1,0:layout(2)-1)
    integer, allocatable :: pes(:), pesall(:)
    integer              :: pearray(0:layout(1)-1,0:layout(2)-1)
    integer              :: ibegin(0:layout(1)-1), iend(0:layout(1)-1)
    integer              :: jbegin(0:layout(2)-1), jend(0:layout(2)-1)
    character(len=8)     :: text
    type(overlapspec), pointer :: check_T => null()
    integer              :: outunit
    logical              :: send(8), recv(8)
 
    outunit = stdout()
    if( .NOT.module_is_initialized )call mpp_error( fatal, &
       &  'MPP_DEFINE_DOMAINS2D: You must first call mpp_domains_init.' )
    if(PRESENT(name)) then
       if(len_trim(name) > name_length) call mpp_error(fatal,  &
            "mpp_domains_define.inc(mpp_define_domains2D): the len_trim of optional argument name ="//trim(name)// &
            " is greater than NAME_LENGTH, change the argument name or increase NAME_LENGTH")
       domain%name = name
    endif
    if(size(global_indices(:)) .NE. 4) call mpp_error(fatal,   &
       "mpp_define_domains2D: size of global_indices should be 4 for "//trim(domain%name) )
    if(size(layout(:)) .NE. 2) call mpp_error(fatal,"mpp_define_domains2D: size of layout should be 2 for "// &
       & trim(domain%name) )
 
    ndivx = layout(1); ndivy = layout(2)
    isg = global_indices(1); ieg = global_indices(2); jsg = global_indices(3); jeg = global_indices(4)
 
    from_mosaic = .false.
    if(present(is_mosaic)) from_mosaic = is_mosaic
    is_complete = .true.
    if(present(complete)) is_complete = complete
    tile = 1
    if(present(tile_count)) tile = tile_count
    cur_tile_id = 1
    if(present(tile_id)) cur_tile_id = tile_id
 
    cur_comm_id=0
    if( PRESENT(pelist) )then
       allocate( pes(0:size(pelist(:))-1) )
       pes = pelist
       if(from_mosaic) then
          allocate( pesall(0:mpp_npes()-1) )
          call mpp_get_current_pelist(pesall, commid=cur_comm_id)
       else
          allocate( pesall(0:size(pes(:))-1) )
          pesall = pes
          call mpp_get_current_pelist(pesall, commid=cur_comm_id)
       end if
    else
       allocate( pes(0:mpp_npes()-1) )
       allocate( pesall(0:mpp_npes()-1) )
       call mpp_get_current_pelist(pes, commid=cur_comm_id)
       pesall = pes
    end if
 
    !--- at least of one of x_cyclic_offset and y_cyclic_offset must be zero
    !--- folded boundary condition is not supported when either x_cyclic_offset or  y_cyclic_offset is nonzero.
    !--- Since we only implemented Folded-north boundary condition currently, we only consider y-flags.
    x_offset = 0; y_offset = 0
    if(PRESENT(x_cyclic_offset)) x_offset = x_cyclic_offset
    if(PRESENT(y_cyclic_offset)) y_offset = y_cyclic_offset
    if(x_offset*y_offset .NE. 0) call mpp_error(fatal, &
       'MPP_DEFINE_DOMAINS2D: At least one of x_cyclic_offset and y_cyclic_offset must be zero for '// &
       & trim(domain%name))
 
    !--- x_cyclic_offset and y_cyclic_offset should no larger than the global grid size.
    if(abs(x_offset) > jeg-jsg+1) call mpp_error(fatal, &
         'MPP_DEFINE_DOMAINS2D: absolute value of x_cyclic_offset is greater than jeg-jsg+1 for '//trim(domain%name))
    if(abs(y_offset) > ieg-isg+1) call mpp_error(fatal, &
         'MPP_DEFINE_DOMAINS2D: absolute value of y_cyclic_offset is greater than ieg-isg+1 for '//trim(domain%name))
 
    !--- when there is more than one tile on one processor, all the tile will limited on this processor
    if( tile > 1 .AND. size(pes(:)) > 1) call mpp_error(fatal, &
         'MPP_DEFINE_DOMAINS2D: there are more than one tile on this pe, '// &
         'all the tile should be limited on this pe for '//trim(domain%name))
 
    !--- the position of current pe is changed due to mosaic, because  pes
    !--- is only part of the pelist in mosaic (pesall). We assume the pe
    !--- distribution are contious in mosaic.
    pos = -1
    do n = 0, size(pesall(:))-1
       if(pesall(n) == mpp_pe() ) then
          pos = n
          exit
       endif
    enddo
    if(pos<0) call  mpp_error(fatal, 'MPP_DEFINE_DOMAINS2D: mpp_pe() is not in the pesall list')
 
    domain%symmetry = .false.
    if(present(symmetry)) domain%symmetry = symmetry
    if(domain%symmetry) then
       ishift = 1; jshift = 1
    else
       ishift = 0; jshift = 0
    end if
 
    !--- first compute domain decomposition.
    call mpp_compute_extent(isg, ieg, ndivx, ibegin, iend, xextent)
    call mpp_compute_extent(jsg, jeg, ndivy, jbegin, jend, yextent)
 
    xhalosz = 0; yhalosz = 0
    if(present(xhalo)) xhalosz = xhalo
    if(present(yhalo)) yhalosz = yhalo
    whalosz = xhalosz; ehalosz = xhalosz
    shalosz = yhalosz; nhalosz = yhalosz
    if(present(whalo)) whalosz = whalo
    if(present(ehalo)) ehalosz = ehalo
    if(present(shalo)) shalosz = shalo
    if(present(nhalo)) nhalosz = nhalo
 
    !--- configure maskmap
    mask = .true.
    if( PRESENT(maskmap) )then
       if( size(maskmap,1).NE.ndivx .OR. size(maskmap,2).NE.ndivy ) &
            call mpp_error( fatal, 'MPP_DEFINE_DOMAINS2D: maskmap array does not match layout for '// &
                           & trim(domain%name) )
       mask(:,:) = maskmap(:,:)
    end if
    !number of unmask domains in layout must equal number of PEs assigned
    n = count(mask)
    if( n.NE.size(pes(:)) )then
       write( text,'(i8)' )n
       call mpp_error( fatal, 'MPP_DEFINE_DOMAINS2D: incorrect number of PEs assigned for ' // &
            'this layout and maskmap. Use '//text//' PEs for this domain decomposition for '//trim(domain%name) )
    end if
 
    memory_xsize = 0; memory_ysize = 0
    if(present(memory_size)) then
       if(size(memory_size(:)) .NE. 2) call mpp_error(fatal,  &
             "mpp_define_domains2D: size of memory_size should be 2 for "//trim(domain%name))
       memory_xsize = memory_size(1)
       memory_ysize = memory_size(2)
    end if
 
    !--- set up domain%list.
    !--- set up 2-D domain decomposition for T, E, C, N and computing overlapping
    !--- when current tile is the last tile in the mosaic.
    nlist = size(pesall(:))
    if( .NOT. Associated(domain%x) ) then
       allocate(domain%tileList(1))
       domain%tileList(1)%xbegin = global_indices(1)
       domain%tileList(1)%xend   = global_indices(2)
       domain%tileList(1)%ybegin = global_indices(3)
       domain%tileList(1)%yend   = global_indices(4)
       allocate(domain%x(1), domain%y(1) )
       allocate(domain%tile_id(1))
       allocate(domain%tile_id_all(1))
       domain%tile_id        = cur_tile_id
       domain%tile_id_all    = cur_tile_id
       domain%tile_comm_id   = cur_comm_id
       domain%ntiles         = 1
       domain%max_ntile_pe   = 1
       domain%ncontacts      = 0
       domain%rotated_ninety = .false.
       allocate( domain%list(0:nlist-1) )
       do i = 0, nlist-1
          allocate( domain%list(i)%x(1), domain%list(i)%y(1), domain%list(i)%tile_id(1))
       end do
    end if
 
    domain%initialized = .true.
 
    start_pos = 0
    do n = 0, nlist-1
       if(pesall(n) == pes(0)) then
          start_pos = n
          exit
       endif
    enddo
 
    !place on PE array; need flag to assign them to j first and then i
    pearray(:,:) = null_pe
    ipos = null_pe; jpos = null_pe
    n = 0
    m = start_pos
    do j = 0,ndivy-1
       do i = 0,ndivx-1
          if( mask(i,j) )then
             pearray(i,j) = pes(n)
             domain%list(m)%x(tile)%compute%begin = ibegin(i)
             domain%list(m)%x(tile)%compute%end   = iend(i)
             domain%list(m)%y(tile)%compute%begin = jbegin(j)
             domain%list(m)%y(tile)%compute%end   = jend(j)
             domain%list(m)%x(tile)%compute%size  = domain%list(m)%x(tile)%compute%end &
                                                  & - domain%list(m)%x(tile)%compute%begin + 1
             domain%list(m)%y(tile)%compute%size  = domain%list(m)%y(tile)%compute%end &
                                                  & - domain%list(m)%y(tile)%compute%begin + 1
             domain%list(m)%tile_id(tile)         = cur_tile_id
             domain%list(m)%x(tile)%pos           = i
             domain%list(m)%y(tile)%pos           = j
             domain%list(m)%tile_root_pe          = pes(0)
             domain%list(m)%pe                    = pesall(m)
 
             if( pes(n).EQ.mpp_pe() )then
                ipos = i
                jpos = j
             end if
             n = n + 1
             m = m + 1
          end if
       end do
    end do
 
    !Considering mosaic, the following will only be done on the pe in the pelist
    !when there is only one tile, all the current pe will be in the pelist.
    if( any(pes == mpp_pe()) ) then
       domain%io_layout = layout
       domain%tile_root_pe  = pes(0)
       domain%comm_id   = cur_comm_id
       if( ipos.EQ.null_pe .OR. jpos.EQ.null_pe ) &
            call mpp_error( fatal, 'MPP_DEFINE_DOMAINS2D: pelist must include this PE for '//trim(domain%name) )
       if( debug ) then
         errunit = stderr()
         write( errunit, * )'pe, tile, ipos, jpos=', mpp_pe(), tile, ipos, jpos, ' pearray(:,jpos)=', &
                  pearray(:,jpos), ' pearray(ipos,:)=', pearray(ipos,:)
       endif
 
       !--- when tile is not equal to 1, the layout for that tile always ( 1, 1), so no need for pearray in domain
       if( tile == 1 ) then
         if (associated(domain%pearray)) deallocate(domain%pearray) !< Check if allocated
          allocate( domain%pearray(0:ndivx-1,0:ndivy-1) )
          domain%pearray = pearray
       end if
 
       domain%pe  = mpp_pe()
       domain%pos  = pos
       domain_cnt = domain_cnt + int(1,kind=i8_kind)
       domain%id = domain_cnt*domain_id_base  ! Must be i8_kind arithmetic
 
       !do domain decomposition using 1D versions in X and Y,
       call mpp_define_domains( global_indices(1:2), ndivx, domain%x(tile), &
            pack(pearray(:,jpos),mask(:,jpos)), xflags, xhalo, xextent, mask(:,jpos), memory_xsize, whalo, ehalo )
       call mpp_define_domains( global_indices(3:4), ndivy, domain%y(tile), &
            pack(pearray(ipos,:),mask(ipos,:)), yflags, yhalo, yextent, mask(ipos,:), memory_ysize, shalo, nhalo )
       if( domain%x(tile)%list(ipos)%pe.NE.domain%y(tile)%list(jpos)%pe ) &
            call mpp_error( fatal, .NE.'MPP_DEFINE_DOMAINS2D: domain%x%list(ipos)%pedomain%y%list(jpos)%pe.' )
 
       !--- when x_cyclic_offset or y_cyclic_offset is set, no cross domain is allowed
       if(x_offset .NE. 0 .OR. y_offset .NE. 0) then
          if(whalosz .GT. domain%x(tile)%compute%size .OR. ehalosz .GT. domain%x(tile)%compute%size ) &
              call mpp_error(fatal, "mpp_define_domains_2d: when x_cyclic_offset/y_cyclic_offset is set, "// &
                 "whalo and ehalo must be no larger than the x-direction computation domain size")
          if(shalosz .GT. domain%y(tile)%compute%size .OR. nhalosz .GT. domain%y(tile)%compute%size ) &
              call mpp_error(fatal, "mpp_define_domains_2d: when x_cyclic_offset/y_cyclic_offset is set, "// &
                 "shalo and nhalo must be no larger than the y-direction computation domain size")
       endif
 
       !--- restrict the halo size is no larger than global domain size.
       if(whalosz .GT. domain%x(tile)%global%size) &
           call mpp_error(fatal, "MPP_DEFINE_DOMAINS2D: whalo is greather global domain size")
       if(ehalosz .GT. domain%x(tile)%global%size) &
           call mpp_error(fatal, "MPP_DEFINE_DOMAINS2D: ehalo is greather global domain size")
       if(shalosz .GT. domain%x(tile)%global%size) &
           call mpp_error(fatal, "MPP_DEFINE_DOMAINS2D: shalo is greather global domain size")
       if(nhalosz .GT. domain%x(tile)%global%size) &
           call mpp_error(fatal, "MPP_DEFINE_DOMAINS2D: nhalo is greather global domain size")
 
       !set up fold, when the boundary is folded, there is only one tile.
       domain%fold = 0
       nfold = 0
       if( PRESENT(xflags) )then
          if( btest(xflags,west) ) then
             !--- make sure no cross-domain in y-direction
             if(domain%x(tile)%domain_data%begin .LE. domain%x(tile)%global%begin .AND. &
                domain%x(tile)%compute%begin > domain%x(tile)%global%begin ) then
                call mpp_error(fatal, &
                 'MPP_DEFINE_DOMAINS: the domain could not be crossed when west is folded')
             endif
             if( domain%x(tile)%cyclic )call mpp_error( fatal, &
                   'MPP_DEFINE_DOMAINS: an axis cannot be both folded west and cyclic for '//trim(domain%name) )
             domain%fold = domain%fold + fold_west_edge
             nfold = nfold+1
          endif
          if( btest(xflags,east) ) then
             !--- make sure no cross-domain in y-direction
             if(domain%x(tile)%domain_data%end .GE. domain%x(tile)%global%end .AND. &
                domain%x(tile)%compute%end < domain%x(tile)%global%end ) then
                call mpp_error(fatal, &
                 'MPP_DEFINE_DOMAINS: the domain could not be crossed when north is folded')
             endif
             if( domain%x(tile)%cyclic )call mpp_error( fatal, &
                  'MPP_DEFINE_DOMAINS: an axis cannot be both folded east and cyclic for '//trim(domain%name) )
             domain%fold = domain%fold + fold_east_edge
             nfold = nfold+1
          endif
       endif
       if( PRESENT(yflags) )then
          if( btest(yflags,south) ) then
             !--- make sure no cross-domain in y-direction
             if(domain%y(tile)%domain_data%begin .LE. domain%y(tile)%global%begin .AND. &
                domain%y(tile)%compute%begin > domain%y(tile)%global%begin ) then
                call mpp_error(fatal, &
                 'MPP_DEFINE_DOMAINS: the domain could not be crossed when south is folded')
             endif
             if( domain%y(tile)%cyclic )call mpp_error( fatal, &
                 'MPP_DEFINE_DOMAINS: an axis cannot be both folded north and cyclic for '//trim(domain%name))
             domain%fold = domain%fold + fold_south_edge
             nfold = nfold+1
          endif
          if( btest(yflags,north) ) then
             !--- when the halo size is big and halo region is crossing neighbor domain, we
             !--- restrict the halo size is less than half of the global size.
             if(whalosz .GT. domain%x(tile)%compute%size .AND. whalosz .GE. domain%x(tile)%global%size/2 ) &
                  call mpp_error(fatal, .GT."MPP_DEFINE_DOMAINS2D: north is folded, whalo  compute domain size "// &
                  .GE."and whalo  half of global domain size")
             if(ehalosz .GT. domain%x(tile)%compute%size .AND. ehalosz .GE. domain%x(tile)%global%size/2 ) &
                  call mpp_error(fatal, .GT."MPP_DEFINE_DOMAINS2D: north is folded, ehalo is  compute domain size "// &
                  .GE."and ehalo  half of global domain size")
             if(shalosz .GT. domain%y(tile)%compute%size .AND. shalosz .GE. domain%x(tile)%global%size/2 ) &
                  call mpp_error(fatal, .GT."MPP_DEFINE_DOMAINS2D: north is folded, shalo  compute domain size "// &
                  .GE."and shalo  half of global domain size")
             if(nhalosz .GT. domain%y(tile)%compute%size .AND. nhalosz .GE. domain%x(tile)%global%size/2 ) &
                  call mpp_error(fatal, .GT."MPP_DEFINE_DOMAINS2D: north is folded, nhalo  compute domain size "// &
                  .GE."and nhalo  half of global domain size")
 
 
             if( domain%y(tile)%cyclic )call mpp_error( fatal, &
                'MPP_DEFINE_DOMAINS: an axis cannot be both folded south and cyclic for '//trim(domain%name) )
             domain%fold = domain%fold + fold_north_edge
             nfold = nfold+1
          endif
       endif
       if(nfold > 1) call mpp_error(fatal, &
           'MPP_DEFINE_DOMAINS2D: number of folded edge is greater than 1 for '//trim(domain%name) )
 
       if(nfold == 1) then
           if( x_offset .NE. 0 .OR. y_offset .NE. 0) call mpp_error(fatal, &
               'MPP_DEFINE_DOMAINS2D: For the foled_north/folded_south/fold_east/folded_west boundary condition,  '//&
               'x_cyclic_offset and y_cyclic_offset must be zero for '//trim(domain%name))
       endif
       if( btest(domain%fold,south) .OR. btest(domain%fold,north) )then
          if( domain%y(tile)%cyclic )call mpp_error( fatal, &
              'MPP_DEFINE_DOMAINS: an axis cannot be both folded and cyclic for '//trim(domain%name) )
          if( modulo(domain%x(tile)%global%size,2).NE.0 ) &
               call mpp_error( fatal, 'MPP_DEFINE_DOMAINS: number of points in X must be even ' // &
                  'when there is a fold in Y for '//trim(domain%name) )
          !check if folded domain boundaries line up in X: compute domains lining up is a sufficient
          !condition for symmetry
          n = ndivx - 1
          do i = 0,n/2
             if( domain%x(tile)%list(i)%compute%size.NE.domain%x(tile)%list(n-i)%compute%size ) &
                  call mpp_error( fatal, 'MPP_DEFINE_DOMAINS: Folded domain boundaries ' // &
                                         'must line up (mirror-symmetric extents) for '//trim(domain%name) )
          end do
       end if
       if( btest(domain%fold,west) .OR. btest(domain%fold,east) )then
          if( domain%x(tile)%cyclic )call mpp_error( fatal, &
             'MPP_DEFINE_DOMAINS: an axis cannot be both folded and cyclic for '//trim(domain%name) )
          if( modulo(domain%y(tile)%global%size,2).NE.0 ) &
               call mpp_error( fatal, 'MPP_DEFINE_DOMAINS: number of points in Y must be even '//&
                   'when there is a fold in X for '//trim(domain%name) )
          !check if folded domain boundaries line up in Y: compute domains lining up is a sufficient
          !condition for symmetry
          n = ndivy - 1
          do i = 0,n/2
             if( domain%y(tile)%list(i)%compute%size.NE.domain%y(tile)%list(n-i)%compute%size ) &
                  call mpp_error( fatal, 'MPP_DEFINE_DOMAINS: Folded domain boundaries must '//&
                        'line up (mirror-symmetric extents) for '//trim(domain%name) )
          end do
       end if
 
       !set up domain%list
       if( mpp_pe().EQ.pes(0) .AND. PRESENT(name) )then
          logunit = stdlog()
          write( logunit, '(/a,i5,a,i5)' )trim(name)//' domain decomposition: ', ndivx, ' X', ndivy
          write( logunit, '(3x,a)' )'pe,   is,  ie,  js,  je,    isd, ied, jsd, jed'
       end if
    end if   !     if( ANY(pes == mpp_pe()) )
 
    if(is_complete) then
       domain%whalo = whalosz; domain%ehalo = ehalosz
       domain%shalo = shalosz; domain%nhalo = nhalosz
       if (associated(domain%update_T)) deallocate(domain%update_T) !< Check if associated
       if (associated(domain%update_E)) deallocate(domain%update_E) !< Check if associated
       if (associated(domain%update_C)) deallocate(domain%update_C) !< Check if associated
       if (associated(domain%update_N)) deallocate(domain%update_N) !< Check if associated
       allocate(domain%update_T, domain%update_E, domain%update_C, domain%update_N)
       domain%update_T%next => null()
       domain%update_E%next => null()
       domain%update_C%next => null()
       domain%update_N%next => null()
       if (associated(domain%check_E)) deallocate(domain%check_E) !< Check if associated
       if (associated(domain%check_C)) deallocate(domain%check_C) !< Check if associated
       if (associated(domain%check_N)) deallocate(domain%check_N) !< Check if associated
       allocate(domain%check_E,  domain%check_C,  domain%check_N )
       domain%update_T%nsend = 0
       domain%update_T%nrecv = 0
       domain%update_C%nsend = 0
       domain%update_C%nrecv = 0
       domain%update_E%nsend = 0
       domain%update_E%nrecv = 0
       domain%update_N%nsend = 0
       domain%update_N%nrecv = 0
 
       if( btest(domain%fold,south) ) then
          call compute_overlaps_fold_south(domain, center,      0,      0)
          call compute_overlaps_fold_south(domain, corner, ishift, jshift)
          call compute_overlaps_fold_south(domain, east,   ishift,      0)
          call compute_overlaps_fold_south(domain, north,  0,      jshift)
       else if( btest(domain%fold,west) ) then
          call compute_overlaps_fold_west(domain, center,      0,      0)
          call compute_overlaps_fold_west(domain, corner, ishift, jshift)
          call compute_overlaps_fold_west(domain, east,   ishift,      0)
          call compute_overlaps_fold_west(domain, north,       0, jshift)
       else if( btest(domain%fold,east) ) then
          call compute_overlaps_fold_east(domain, center,      0,      0)
          call compute_overlaps_fold_east(domain, corner, ishift, jshift)
          call compute_overlaps_fold_east(domain, east,   ishift,      0)
          call compute_overlaps_fold_east(domain, north,       0, jshift)
       else
          call compute_overlaps(domain, center, domain%update_T, check_t,             0,      0, x_offset, y_offset, &
                                domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
          call compute_overlaps(domain, corner, domain%update_C, domain%check_C, ishift, jshift, x_offset, y_offset, &
                                domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
          call compute_overlaps(domain, east,   domain%update_E, domain%check_E,  ishift,     0, x_offset, y_offset, &
                                domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
          call compute_overlaps(domain, north,  domain%update_N, domain%check_N,      0, jshift, x_offset, y_offset, &
                                domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
       endif
       call check_overlap_pe_order(domain, domain%update_T, trim(domain%name)//" update_T in mpp_define_domains")
       call check_overlap_pe_order(domain, domain%update_C, trim(domain%name)//" update_C in mpp_define_domains")
       call check_overlap_pe_order(domain, domain%update_E, trim(domain%name)//" update_E in mpp_define_domains")
       call check_overlap_pe_order(domain, domain%update_N, trim(domain%name)//" update_N in mpp_define_domains")
 
 
       !--- when ncontacts is nonzero, set_check_overlap will be called in mpp_define
       if(domain%symmetry .AND. (domain%ncontacts == 0 .OR. domain%ntiles == 1) ) then
          call set_check_overlap( domain, corner )
          call set_check_overlap( domain, east   )
          call set_check_overlap( domain, north  )
          if (associated(domain%bound_E)) deallocate(domain%bound_E) !< Check if associated
          if (associated(domain%bound_C)) deallocate(domain%bound_C) !< Check if associated
          if (associated(domain%bound_N)) deallocate(domain%bound_N) !< Check if associated
          allocate(domain%bound_E,  domain%bound_C,  domain%bound_N )
          call set_bound_overlap( domain, corner )
          call set_bound_overlap( domain, east   )
          call set_bound_overlap( domain, north  )
       end if
       call set_domain_comm_inf(domain%update_T)
       call set_domain_comm_inf(domain%update_E)
       call set_domain_comm_inf(domain%update_C)
       call set_domain_comm_inf(domain%update_N)
    end if
 
    !--- check the send and recv size are matching.
    !--- or ntiles>1 mosaic,
    !--- the check will be done in mpp_define_mosaic
    if(debug_message_passing .and. (domain%ncontacts == 0 .OR. domain%ntiles == 1) ) then
       send = .true.
       recv = .true.
       call check_message_size(domain, domain%update_T, send, recv, 'T')
       call check_message_size(domain, domain%update_E, send, recv, 'E')
       call check_message_size(domain, domain%update_C, send, recv, 'C')
       call check_message_size(domain, domain%update_N, send, recv, 'N')
    endif
 
 
    !print out decomposition, this didn't consider maskmap.
    if( mpp_pe() .EQ. pes(0) .AND. PRESENT(name) )then
       write(*,*) trim(name)//' domain decomposition'
       write(*,'(a,i4,a,i4,a,i4,a,i4)')'whalo = ', whalosz, ", ehalo = ", ehalosz, ", shalo = ", shalosz, &
                                     & ", nhalo = ", nhalosz
       write (*,110) (domain%x(1)%list(i)%compute%size, i= 0, layout(1)-1)
       write (*,120) (domain%y(1)%list(i)%compute%size, i= 0, layout(2)-1)
110    format ('  X-AXIS = ',24i4,/,(11x,24i4))
120    format ('  Y-AXIS = ',24i4,/,(11x,24i4))
    endif
 
    deallocate( pes, pesall)
 
 
  return
end subroutine mpp_define_domains2d
 
 
!#####################################################################
subroutine check_message_size(domain, update, send, recv, position)
  type(domain2d),       intent(in) :: domain
  type(overlapspec),    intent(in) :: update
  logical,              intent(in) :: send(:)
  logical,              intent(in) :: recv(:)
  character,            intent(in) :: position
 
  integer, dimension(0:size(domain%list(:))-1) :: msg1, msg2, msg3
  integer :: m, n, l, dir, is, ie, js, je, from_pe, msgsize
  integer :: nlist
 
  nlist = size(domain%list(:))
 
 
  msg1 = 0
  msg2 = 0
  do m = 1, update%nrecv
     msgsize = 0
     do n = 1, update%recv(m)%count
        dir = update%recv(m)%dir(n)
        if( recv(dir) ) then
           is = update%recv(m)%is(n); ie = update%recv(m)%ie(n)
           js = update%recv(m)%js(n); je = update%recv(m)%je(n)
           msgsize = msgsize + (ie-is+1)*(je-js+1)
        endif
     end do
     from_pe = update%recv(m)%pe
     l = from_pe-mpp_root_pe()
     call mpp_recv( msg1(l), glen=1, from_pe=from_pe, block=.false., tag=comm_tag_1)
     msg2(l) = msgsize
  enddo
 
  do m = 1, update%nsend
     msgsize = 0
     do n = 1, update%send(m)%count
        dir = update%send(m)%dir(n)
        if(send(dir))then
           is = update%send(m)%is(n); ie = update%send(m)%ie(n)
           js = update%send(m)%js(n); je = update%send(m)%je(n)
           msgsize = msgsize + (ie-is+1)*(je-js+1)
        endif
     end do
     l = update%send(m)%pe-mpp_root_pe()
     msg3(l) = msgsize
     call mpp_send( msg3(l), plen=1, to_pe=update%send(m)%pe, tag=comm_tag_1)
  enddo
  call mpp_sync_self(check=event_recv)
 
  do m = 0, nlist-1
     if(msg1(m) .NE. msg2(m)) then
        print*, "My pe = ", mpp_pe(), ",domain name =", trim(domain%name), ",at position=",position,",from pe=", &
             domain%list(m)%pe, ":send size = ", msg1(m), ", recv size = ", msg2(m)
        call mpp_error(fatal, "mpp_define_domains2D: mismatch on send and recv size")
     endif
  enddo
  call mpp_sync_self()
 
 
end subroutine check_message_size
 
  !#####################################################################
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                             !
!              MPP_define_mosaic: define mosaic domain                        !
!  NOTE: xflags and yflags is not in mpp_define_mosaic, because such relation !
!        are already defined in the mosaic relation.                          !
!                                                                             !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!??? do we need optional argument xextent and yextent
!??? how to specify pelist, we may use two dimensional variable pelist to represent.
!z1l: We assume the tilelist are in always limited to 1, 2, ... num_tile. If we want
!     to remove this limitation, we need to add one more argument tilelist.
 
  !> Defines a domain for mosaic tile grids
  subroutine mpp_define_mosaic( global_indices, layout, domain, num_tile, num_contact, tile1, tile2,      &
                                istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, &
                                pe_end, pelist, whalo, ehalo, shalo, nhalo, xextent, yextent,             &
                                maskmap, name, memory_size, symmetry, xflags, yflags, tile_id )
    integer,          intent(in)           :: global_indices(:,:)  !>The size of first indice is 4,
                                                                   !! (/ isg, ieg, jsg, jeg /)
                                                                   !!The size of second indice
                                                                   !!is number of tiles in mosaic.
    integer,          intent(in)           :: layout(:,:)
    type(domain2d),   intent(inout)        :: domain
    integer,          intent(in)           :: num_tile             !< number of tiles in the mosaic
    integer,          intent(in)           :: num_contact          !< number of contact region between tiles.
    integer,          intent(in)           :: tile1(:), tile2(:)   !< tile number
    integer,          intent(in)           :: istart1(:), iend1(:) !< i-index in tile_1 of contact region
    integer,          intent(in)           :: jstart1(:), jend1(:) !< j-index in tile_1 of contact region
    integer,          intent(in)           :: istart2(:), iend2(:) !< i-index in tile_2 of contact region
    integer,          intent(in)           :: jstart2(:), jend2(:) !< j-index in tile_2 of contact region
    integer,          intent(in)           :: pe_start(:)          !< start pe of the pelist used in each tile
    integer,          intent(in)           :: pe_end(:)            !< end pe of the pelist used in each tile
    integer,          intent(in), optional :: pelist(:)            !< list of processors used in mosaic
    integer,          intent(in), optional :: whalo, ehalo, shalo, nhalo
    integer,          intent(in), optional :: xextent(:,:), yextent(:,:)
    logical,          intent(in), optional :: maskmap(:,:,:)
    character(len=*), intent(in), optional :: name
    integer,          intent(in), optional :: memory_size(2)
    logical,          intent(in), optional :: symmetry
    integer,          intent(in), optional :: xflags, yflags
    integer,          intent(in), optional :: tile_id(:)           !< tile_id of each tile in the mosaic
 
    integer              :: n, m, ndivx, ndivy, nc, nlist, nt, pos, n1, n2
    integer              :: whalosz, ehalosz, shalosz, nhalosz, xhalosz, yhalosz, t1, t2, tile
    integer              :: flags_x, flags_y
    logical, allocatable :: mask(:,:)
    integer, allocatable :: pes(:), xext(:), yext(:), pelist_tile(:), ntile_per_pe(:), tile_count(:)
    integer, allocatable :: tile_id_local(:)
    logical              :: is_symmetry
    integer, allocatable :: align1(:), align2(:), is1(:), ie1(:), js1(:), je1(:), is2(:), ie2(:), js2(:), je2(:)
    integer, allocatable :: isgList(:), iegList(:), jsgList(:), jegList(:)
    real,    allocatable :: refine1(:), refine2(:)
    integer              :: outunit
    logical              :: send(8), recv(8)
 
    outunit = stdout()
    mosaic_defined = .true.
    !--- the size of first indice of global_indices must be 4.
    if(size(global_indices, 1) .NE. 4) call mpp_error(fatal, &
         'mpp_domains_define.inc: The size of first dimension of global_indices is not 4')
    !--- the size of second indice of global_indices must be num_tile
    if(size(global_indices, 2) .NE. num_tile) call mpp_error(fatal, &
         'mpp_domains_define.inc: The size of second dimension of global_indices is not equal num_tile')
    !--- the size of first indice of layout must be 2. The second dimension size of layout must equal num_tile.
    if(size(layout, 1) .NE. 2) call mpp_error(fatal, &
         'mpp_domains_define.inc: The size of first dimension of layout is not 2')
    if(size(layout,2) .NE. num_tile)  call mpp_error(fatal, &
         'mpp_domains_define.inc: The size of second dimension of layout is not equal num_tile')
 
    !--- setup pelist for the mosaic ---------------------
    nlist = mpp_npes()
    allocate(pes(0:nlist-1))
    if(present(pelist)) then
       if( nlist .NE. size(pelist(:))) call mpp_error(fatal, &
            'mpp_domains_define.inc: size of pelist is not equal mpp_npes')
       pes = pelist
    end if
    call mpp_get_current_pelist(pes, commid=domain%comm_id)
    !--- pelist should be monotonic increasing by 1.
    do n = 1, nlist-1
       if(pes(n) - pes(n-1) .NE. 1) call mpp_error(fatal, &
           'mpp_domains_define.inc: pelist is not monotonic increasing by 1')
    end do
 
    is_symmetry        = .false.
    if(present(symmetry)) is_symmetry = symmetry
 
    if(size(pe_start(:)) .NE. num_tile .OR. size(pe_end(:)) .NE. num_tile ) call mpp_error(fatal, &
         'mpp_domains_define.inc: size of pe_start and/or pe_end is not equal num_tile')
    !--- make sure pe_start and pe_end is in the pelist.
    if( any( pe_start < pes(0) ) ) call mpp_error(fatal, &
       &  'mpp_domains_define.inc: not all the pe_start are in the pelist')
    if( any( pe_end > pes(nlist-1)) ) call mpp_error(fatal, &
       &  'mpp_domains_define.inc: not all the pe_end are in the pelist')
 
    !--- calculate number of tiles on each pe.
    allocate( ntile_per_pe(0:nlist-1) )
    ntile_per_pe = 0
    do n = 1, num_tile
       do m = pe_start(n) - mpp_root_pe(), pe_end(n) - mpp_root_pe()
          ntile_per_pe(m) = ntile_per_pe(m) + 1
       end do
    end do
    if(any(ntile_per_pe == 0)) call mpp_error(fatal, &
         'mpp_domains_define.inc: At least one pe in pelist is not used by any tile in the mosaic')
 
    !--- check the size comformable of xextent and yextent
    if( PRESENT(xextent) ) then
       if(size(xextent,1) .GT. maxval(layout(1,:)) ) call mpp_error(fatal, &
            'mpp_domains_define.inc: size mismatch between xextent and layout')
       if(size(xextent,2) .NE. num_tile) call mpp_error(fatal, &
            'mpp_domains_define.inc: size of xextent is not eqaul num_tile')
    end if
    if( PRESENT(yextent) ) then
       if(size(yextent,1) .GT. maxval(layout(2,:)) ) call mpp_error(fatal, &
            'mpp_domains_define.inc: size mismatch between yextent and layout')
       if(size(yextent,2) .NE. num_tile) call mpp_error(fatal, &
            'mpp_domains_define.inc: size of yextent is not eqaul num_tile')
    end if
 
    !--- check the size comformable of maskmap
    !--- since the layout is different between tiles, so the actual size of maskmap for each tile is
    !--- not diffrent. When define maskmap for multiple tiles, user can choose the maximum value
    !--- of layout of all tiles to the first and second dimension of maskmap.
    if(present(maskmap)) then
       if(size(maskmap,1) .GT. maxval(layout(1,:)) .or. size(maskmap,2) .GT. maxval(layout(2,:))) &
            call mpp_error(fatal, 'mpp_domains_define.inc: size mismatch between maskmap and layout')
       if(size(maskmap,3) .NE. num_tile) call mpp_error(fatal, &
            'mpp_domains_define.inc: the third dimension of maskmap is not equal num_tile')
    end if
 
    if (associated(domain%tileList)) deallocate(domain%tileList) !< Check if associated
    allocate(domain%tileList(num_tile))
    do n = 1, num_tile
       domain%tileList(n)%xbegin = global_indices(1,n)
       domain%tileList(n)%xend   = global_indices(2,n)
       domain%tileList(n)%ybegin = global_indices(3,n)
       domain%tileList(n)%yend   = global_indices(4,n)
    enddo
    !--- define some mosaic information in domain type
    nt = ntile_per_pe(mpp_pe()-mpp_root_pe())
    if (associated(domain%tile_id)) deallocate(domain%tile_id) !< Check if associated
    if (associated(domain%x)) deallocate(domain%x) !< Check if associated
    if (associated(domain%y)) deallocate(domain%y) !< Check if associated
    if (associated(domain%list)) deallocate(domain%list) !< Check if associated
    allocate(domain%tile_id(nt), domain%x(nt), domain%y(nt) )
    allocate(domain%list(0:nlist-1))
 
    do n = 0, nlist-1
       nt = ntile_per_pe(n)
       allocate(domain%list(n)%x(nt), domain%list(n)%y(nt), domain%list(n)%tile_id(nt))
    end do
 
    pos = 0
    pe = mpp_pe()
    if( PRESENT(tile_id) ) then
       if(size(tile_id(:)) .NE. num_tile) then
          call mpp_error(fatal, .NE."mpp_domains_define.inc: size(tile_id)  num_tile")
       endif
    endif
    allocate(tile_id_local(num_tile))
 
!These directives are a work-around for a bug in the CCE compiler, which
!causes a segmentation fault when the compiler attempts to vectorize a
!loop containing an optional argument (when -g is included).
 
!DIR$ NOVECTOR
    do n = 1, num_tile
       if(PRESENT(tile_id)) then
          tile_id_local(n) = tile_id(n)
       else
          tile_id_local(n) = n
       endif
    enddo
!DIR$ VECTOR
 
    do n = 1, num_tile
       if( pe .GE. pe_start(n) .AND. pe .LE. pe_end(n)) then
          pos = pos + 1
          domain%tile_id(pos) = tile_id_local(n)
       end if
    end do
 
    if (associated(domain%tile_id_all)) deallocate(domain%tile_id_all) !< Check if associated
    allocate(domain%tile_id_all(num_tile))
    domain%tile_id_all(:) = tile_id_local(:)
 
    domain%initialized    = .true.
    domain%rotated_ninety = .false.
    domain%ntiles         = num_tile
    domain%max_ntile_pe   = maxval(ntile_per_pe)
    domain%ncontacts      = num_contact
 
    deallocate(ntile_per_pe)
    !---call mpp_define_domain to define domain decomposition for each tile.
    allocate(tile_count(pes(0):pes(0)+nlist-1))
    tile_count = 0  ! tile number on current pe
 
    domain%tile_comm_id=0
    do n = 1, num_tile
       allocate(mask(layout(1,n), layout(2,n)))
       allocate(pelist_tile(pe_start(n):pe_end(n)) )
       tile_count(pe_start(n)) = tile_count(pe_start(n)) + 1
       do m = pe_start(n), pe_end(n)
          pelist_tile(m) = m
       end do
       !--- set the tile communicator
       if (any(pelist_tile == pe)) then
         call mpp_declare_pelist(pelist_tile, commid=domain%tile_comm_id)
       endif
       mask = .true.
       if(present(maskmap))  mask = maskmap(1:layout(1,n), 1:layout(2,n), n)
       ndivx = layout(1,n); ndivy = layout(2,n)
       allocate(xext(ndivx), yext(ndivy))
       xext = 0; yext = 0
       if(present(xextent)) xext = xextent(1:ndivx,n)
       if(present(yextent)) yext = yextent(1:ndivy,n)
       ! when num_tile is one, we assume only folded_north and cyclic_x, cyclic_y boundary condition is the possible
       ! z1l: when we decide to support multiple-tile tripolar grid, we will redesign the following part.
       if(num_tile == 1) then
          flags_x = 0
          flags_y = 0
          if(PRESENT(xflags)) flags_x = xflags
          if(PRESENT(yflags)) flags_y = yflags
          do m = 1, num_contact
             if(istart1(m) == iend1(m) ) then  ! x-direction contact, possible cyclic, folded-west or folded-east
                if(istart2(m) .NE. iend2(m) ) call mpp_error(fatal,  &
                   "mpp_domains_define: for one tile mosaic, when istart1=iend1, istart2 must equal iend2")
                if(istart1(m) == istart2(m) ) then ! folded west or folded east
                   if(istart1(m) == global_indices(1,n) ) then
                      if(.NOT. btest(flags_x,west) )  flags_x = flags_x + fold_west_edge
                   else if(istart1(m) == global_indices(2,n) ) then
                      if(.NOT. btest(flags_x,east) )  flags_x = flags_x + fold_east_edge
                   else
                       call mpp_error(fatal, "mpp_domains_define: when istart1=iend1,jstart1=jend1, "//&
                         "istart1 should equal global_indices(1) or global_indices(2)")
                   endif
                else
                if(.NOT. btest(flags_x,cyclic))  flags_x = flags_x + cyclic_global_domain
                endif
             else if( jstart1(m) == jend1(m) ) then  ! y-direction contact, cyclic, folded-south or folded-north
                if(jstart2(m) .NE. jend2(m) ) call mpp_error(fatal,  &
                   "mpp_domains_define: for one tile mosaic, when jstart1=jend1, jstart2 must equal jend2")
                if(jstart1(m) == jstart2(m) ) then ! folded south or folded north
                   if(jstart1(m) == global_indices(3,n) ) then
                      if(.NOT. btest(flags_y,south) )  flags_y = flags_y + fold_south_edge
                   else if(jstart1(m) == global_indices(4,n) ) then
                   if(.NOT. btest(flags_y,north) )  flags_y = flags_y + fold_north_edge
                else
                       call mpp_error(fatal, "mpp_domains_define: when istart1=iend1,jstart1=jend1, "//&
                         "istart1 should equal global_indices(1) or global_indices(2)")
                   endif
                else
                   if(.NOT. btest(flags_y,cyclic))  flags_y = flags_y + cyclic_global_domain
                end if
             else
               call mpp_error(fatal,  &
                   "mpp_domains_define: for one tile mosaic, invalid boundary contact")
             end if
          end do
          call mpp_define_domains(global_indices(:,n), layout(:,n), domain, pelist=pelist_tile, xflags = flags_x, &
                                  yflags = flags_y, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo,           &
                                  xextent=xext, yextent=yext, maskmap=mask, name=name, symmetry=is_symmetry,      &
                                  memory_size = memory_size, is_mosaic = .true., tile_id=tile_id_local(n))
       else
          call mpp_define_domains(global_indices(:,n), layout(:,n), domain, pelist=pelist_tile,                   &
                                  whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, xextent=xext, yextent=yext, &
                                  maskmap=mask, name=name, symmetry=is_symmetry, memory_size = memory_size,       &
                                  is_mosaic = .true., tile_count = tile_count(pe_start(n)), tile_id=tile_id_local(n), &
                                  complete = n==num_tile)
       end if
       deallocate(mask, xext, yext, pelist_tile)
    end do
 
    deallocate(pes, tile_count, tile_id_local)
 
    if(num_contact == 0 .OR. num_tile == 1) return
 
    !--- loop through each contact region and find the contact for each tile ( including alignment )
    !--- we assume the tiles list is continuous and starting from 1.
    allocate(is1(num_contact), ie1(num_contact), js1(num_contact), je1(num_contact) )
    allocate(is2(num_contact), ie2(num_contact), js2(num_contact), je2(num_contact) )
    allocate(isglist(num_tile), ieglist(num_tile), jsglist(num_tile), jeglist(num_tile) )
    allocate(align1(num_contact), align2(num_contact), refine1(num_contact), refine2(num_contact))
    !--- get the global domain for each tile
    do n = 1, num_tile
       isglist(n) = domain%tileList(n)%xbegin; ieglist(n) = domain%tileList(n)%xend
       jsglist(n) = domain%tileList(n)%ybegin; jeglist(n) = domain%tileList(n)%yend
    end do
 
    !--- transfer the contact index to domain index.
    nc = 0
    do n = 1, num_contact
       t1 = tile1(n)
       t2 = tile2(n)
       is1(n) = istart1(n) + isglist(t1) - 1; ie1(n) = iend1(n) + isglist(t1) - 1
       js1(n) = jstart1(n) + jsglist(t1) - 1; je1(n) = jend1(n) + jsglist(t1) - 1
       is2(n) = istart2(n) + isglist(t2) - 1; ie2(n) = iend2(n) + isglist(t2) - 1
       js2(n) = jstart2(n) + jsglist(t2) - 1; je2(n) = jend2(n) + jsglist(t2) - 1
       call check_alignment( is1(n), ie1(n), js1(n), je1(n), isglist(t1), ieglist(t1), jsglist(t1), &
                           &  jeglist(t1), align1(n))
       call check_alignment( is2(n), ie2(n), js2(n), je2(n), isglist(t2), ieglist(t2), jsglist(t2), &
                           &  jeglist(t2), align2(n))
       if( (align1(n) == west .or. align1(n) == east ) .NEQV. (align2(n) == west .or. align2(n) == east ) )&
             domain%rotated_ninety=.true.
    end do
 
    !--- calculate the refinement ratio between tiles
    do n = 1, num_contact
       n1 = max(abs(iend1(n) - istart1(n)), abs(jend1(n) - jstart1(n)) ) + 1
       n2 = max(abs(iend2(n) - istart2(n)), abs(jend2(n) - jstart2(n)) ) + 1
       refine1(n) = real(n2)/n1
       refine2(n) = real(n1)/n2
    end do
 
    whalosz = 0; ehalosz = 0; shalosz = 0; nhalosz = 0
    if(present(whalo)) whalosz = whalo
    if(present(ehalo)) ehalosz = ehalo
    if(present(shalo)) shalosz = shalo
    if(present(nhalo)) nhalosz = nhalo
    xhalosz = max(whalosz, ehalosz)
    yhalosz = max(shalosz, nhalosz)
 
    !--- computing the overlap for the contact region with halo size xhalosz and yhalosz
    call define_contact_point( domain, center, num_contact, tile1, tile2, align1, align2, refine1, refine2, &
                               is1, ie1, js1, je1, is2, ie2, js2, je2, isglist, ieglist, jsglist, jeglist )
 
    call set_contact_point( domain, corner )
    call set_contact_point( domain, east   )
    call set_contact_point( domain, north  )
 
    call set_domain_comm_inf(domain%update_T)
    call set_domain_comm_inf(domain%update_E)
    call set_domain_comm_inf(domain%update_C)
    call set_domain_comm_inf(domain%update_N)
 
 
    !--- goffset setting is needed for exact global sum
    do m = 1, size(domain%tile_id(:))
       tile = domain%tile_id(m)
       do n = 1, num_contact
          if( tile1(n) == tile ) then
             if(align1(n) == east ) domain%x(m)%goffset = 0
             if(align1(n) == north) domain%y(m)%goffset = 0
          end if
          if( tile2(n) == tile ) then
             if(align2(n) == east ) domain%x(m)%goffset = 0
             if(align2(n) == north) domain%y(m)%goffset = 0
          end if
       end do
    end do
    call check_overlap_pe_order(domain, domain%update_T, trim(domain%name)//" update_T in mpp_define_mosaic")
    call check_overlap_pe_order(domain, domain%update_C, trim(domain%name)//" update_C in mpp_define_mosaic")
    call check_overlap_pe_order(domain, domain%update_E, trim(domain%name)//" update_E in mpp_define_mosaic")
    call check_overlap_pe_order(domain, domain%update_N, trim(domain%name)//" update_N in mpp_define_mosaic")
 
    !--- set the overlapping for boundary check if domain is symmetry
    if(debug_update_level .NE. no_check) then
       call set_check_overlap( domain, corner )
       call set_check_overlap( domain, east   )
       call set_check_overlap( domain, north  )
    endif
    if(domain%symmetry) then
      if (associated(domain%bound_E)) deallocate(domain%bound_E) !< Check if associated
      if (associated(domain%bound_C)) deallocate(domain%bound_C) !< Check if associated
      if (associated(domain%bound_N)) deallocate(domain%bound_N) !< Check if associated
       allocate(domain%bound_E,  domain%bound_C,  domain%bound_N )
       call set_bound_overlap( domain, corner )
       call set_bound_overlap( domain, east   )
       call set_bound_overlap( domain, north  )
       call check_overlap_pe_order(domain, domain%bound_C, trim(domain%name)//" bound_C")
       call check_overlap_pe_order(domain, domain%bound_E, trim(domain%name)//" bound_E")
       call check_overlap_pe_order(domain, domain%bound_N, trim(domain%name)//" bound_N")
    end if
 
    !--- check the send and recv size are matching.
    !--- currently only check T and C-cell. For ntiles>1 mosaic,
    !--- the check will be done in mpp_define_mosaic
    if(debug_message_passing) then
       send = .true.
       recv = .true.
       call check_message_size(domain, domain%update_T, send, recv, 'T')
       call check_message_size(domain, domain%update_C, send, recv, 'C')
       call check_message_size(domain, domain%update_E, send, recv, 'E')
       call check_message_size(domain, domain%update_N, send, recv, 'N')
    endif
 
 
    !--- release memory
    deallocate(align1, align2, is1, ie1, js1, je1, is2, ie2, js2, je2  )
    deallocate(isglist, ieglist, jsglist, jeglist, refine1, refine2 )
 
 
  end subroutine mpp_define_mosaic
 
!#####################################################################
  !> Accessor function for value of mosaic_defined
  logical function mpp_mosaic_defined()
    mpp_mosaic_defined = mosaic_defined
  end function mpp_mosaic_defined
!#####################################################################
 
  !> @brief Computes remote domain overlaps
  !!
  !> Assumes only one in each direction
  !! will calculate the overlapping for T,E,C,N-cell separately.
  subroutine compute_overlaps( domain, position, update, check, ishift, jshift, x_cyclic_offset, y_cyclic_offset, &
                               whalo, ehalo, shalo, nhalo )
    type(domain2d), intent(inout) :: domain
    type(overlapspec), intent(inout), pointer :: update
    type(overlapspec), intent(inout), pointer :: check
    integer, intent(in)           :: position, ishift, jshift
    integer, intent(in)           :: x_cyclic_offset, y_cyclic_offset
    integer, intent(in)           :: whalo, ehalo, shalo, nhalo
 
    integer                          :: i, m, n, nlist, tMe, tNbr, dir
    integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd, jed
    integer                          :: isg, ieg, jsg, jeg, ioff, joff
    integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
    integer                          :: ism, iem, jsm, jem
    integer                          :: is2, ie2, js2, je2
    integer                          :: is3, ie3, js3, je3
    integer                          :: isd3, ied3, jsd3, jed3
    integer                          :: isd2, ied2, jsd2, jed2
    logical                          :: folded, need_adjust_1, need_adjust_2, need_adjust_3, folded_north
    type(overlap_type)               :: overlap
    type(overlap_type),  pointer     :: overlapList(:)=>null()
    type(overlap_type),  pointer     :: checkList(:)=>null()
    integer                          :: nsend, nrecv
    integer                          :: nsend_check, nrecv_check
    integer                          :: iunit
    logical                          :: set_check
 
    !--- since we restrict that if multiple tiles on one pe, all the tiles are limited to this pe.
    !--- In this case, if ntiles on this pe is greater than 1, no overlapping between processor within each tile
    !--- In this case the overlapping exist only for tMe=1 and tNbr=1
    if(size(domain%x(:)) > 1) return
 
    !--- if there is no halo, no need to compute overlaps.
    if(whalo==0 .AND. ehalo==0 .AND. shalo==0 .AND. nhalo==0) return
 
    !--- when there is only one tile, n will equal to np
    nlist = size(domain%list(:))
    set_check = .false.
    if(ASSOCIATED(check)) set_check = .true.
    allocate(overlaplist(maxlist) )
    if(set_check) allocate(checklist(maxlist)   )
 
    !--- overlap is used to store the overlapping temporarily.
    call allocate_update_overlap( overlap, maxoverlap)
    !send
    call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position )
    call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position ) !cyclic offsets
    call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
 
    update%xbegin = ism; update%xend = iem
    update%ybegin = jsm; update%yend = jem
    if(set_check) then
       check%xbegin  = ism; check%xend  = iem
       check%ybegin  = jsm; check%yend  = jem
    endif
    update%whalo  = whalo; update%ehalo = ehalo
    update%shalo  = shalo; update%nhalo = nhalo
 
    ioff = ni - ishift
    joff = nj - jshift
    middle = (isg+ieg)/2+1
    tme = 1; tnbr = 1
    folded_north = btest(domain%fold,north)
    if( btest(domain%fold,south) .OR. btest(domain%fold,east) .OR. btest(domain%fold,west) ) then
       call mpp_error(fatal,"mpp_domains_define.inc(compute_overlaps): folded south, east or west boundary condition "&
            &//"is not supported, please use other version of compute_overlaps for "//trim(domain%name))
    endif
 
    nsend = 0
    nsend_check = 0
 
    do list = 0,nlist-1
       m = mod( domain%pos+list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          !to_pe's eastern halo
          dir = 1
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
          !--- to make sure the consistence between pes
          if( domain%symmetry .AND. (position == north .OR. position == corner ) &
               .AND. ( jsc == je .or. jec == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             !--- when the north face is folded, the east halo point at right side domain will be folded.
             !--- the position should be on CORNER or NORTH
             if( je == jeg .AND. folded_north .AND. (position == corner .OR. position == north) ) then
                call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle)
             else
                if(x_cyclic_offset ==0 .AND. y_cyclic_offset == 0) then
                   call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
                else
                   if( ie.GT.ieg ) then
                      if( domain%x(tme)%cyclic .AND. iec.LT.is )then !try cyclic offset
                         is = is-ioff; ie = ie-ioff
                         call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                      end if
                   end if
                   call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                        isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
                endif
             endif
          end if
 
          !to_pe's SE halo
          dir = 2
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo;  je = domain%list(m)%y(tnbr)%compute%begin-1
          need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
          !--- divide into two parts, one part is x_cyclic_offset/y_cyclic_offset is non-zeor,
          !--- the other part is both are zero.
          is2 = 0; ie2 = -1; js2 = 0; je2 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             if(je .LT. jsg) then ! js .LT. jsg
                if( domain%y(tme)%cyclic ) then
                   js = js + joff; je = je + joff
                endif
             else if(js .Lt. jsg) then ! split into two parts
                if( domain%y(tme)%cyclic ) then
                   js2 = js + joff; je2 = jsg-1+joff
                   js = jsg;
                endif
             endif
             call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic)
             if(je2 .GE. js2) call fill_overlap_send_nofold(overlap, domain, m, is, ie, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic)
          else
             if( ie.GT.ieg )then
                if( domain%x(tme)%cyclic .AND. iec.LT.is )then !try cyclic offset
                   is = is-ioff; ie = ie-ioff
                   need_adjust_1 = .false.
                   if(jsg .GT. js) then
                      if( domain%y(tme)%cyclic .AND. je.LT.jsc )then !try cyclic offset
                         js = js+joff; je = je+joff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                      need_adjust_3 = .false.
                   end if
                end if
             end if
             if( need_adjust_3 .AND. jsg.GT.js )then
                if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. je.LT.jsc )then !try cyclic offset
                   js = js+joff; je = je+joff
                   if(need_adjust_1 .AND. ie.LE.ieg) then
                      call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                   end if
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, isg, ieg, jsg, jeg, dir)
          endif
 
          !to_pe's southern halo
          dir = 3
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          js2 = 0; je2 = -1
          if( jsg.GT.je )then ! jsg .GT. js
             if( domain%y(tme)%cyclic .AND. je.LT.jsc )then !try cyclic offset
                js = js+joff; je = je+joff
                call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
             end if
          else if (jsg .GT. js) then ! split into two parts
             if( domain%y(tme)%cyclic) then
                js2 = js + joff; je2 = jsg-1+joff
                js = jsg
             endif
          end if
 
          call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
          if(je2 .GE. js2) call fill_overlap(overlap, domain, m, is, ie, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
          !to_pe's SW halo
          dir = 4
          is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
          is2 = 0; ie2 = -1; js2 = 0; je2 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             if(je .LT. jsg) then ! js .LT. jsg
                if( domain%y(tme)%cyclic ) then
                   js = js + joff; je = je + joff
                endif
             else if(js .Lt. jsg) then ! split into two parts
                if( domain%y(tme)%cyclic ) then
                   js2 = js + joff; je2 = jsg-1+joff
                   js = jsg;
                endif
             endif
             call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic)
             if(je2 .GE. js2) call fill_overlap_send_nofold(overlap, domain, m, is, ie, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic)
          else
             if( isg.GT.is )then
                if( domain%x(tme)%cyclic .AND. ie.LT.isc )then !try cyclic offset
                   is = is+ioff; ie = ie+ioff
                   need_adjust_1 = .false.
                   if(jsg .GT. js) then
                      if( domain%y(tme)%cyclic .AND. je.LT.jsc )then !try cyclic offset
                         js = js+joff; je = je+joff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                      need_adjust_3 = .false.
                   end if
                end if
             end if
             if( need_adjust_3 .AND. jsg.GT.js )then
                if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. je.LT.jsc )then !try cyclic offset
                   js = js+joff; je = je+joff
                   if(need_adjust_1 .AND. isg.LE.is  )then
                      call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                   end if
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, isg, ieg, jsg, jeg, dir)
          endif
 
          !to_pe's western halo
          dir = 5
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
          !--- when the north face is folded, some point at j=nj will be folded.
          !--- the position should be on CORNER or NORTH
          if( je == jeg .AND. folded_north .AND. (position == corner .OR. position == north)) then
             call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle)
          else
             if(x_cyclic_offset ==0 .AND. y_cyclic_offset == 0) then
                call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
             else
                if( isg.GT.is )then
                   if( domain%x(tme)%cyclic .AND. ie.LT.isc )then !try cyclic offset
                      is = is+ioff; ie = ie+ioff
                      call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                   endif
                end if
                call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                     isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
             end if
          end if
 
          !to_pe's NW halo
          dir = 6
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;  ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          is2 = 0; ie2 = -1; js2 = 0; je2 = -1
          is3 = 0; ie3 = -1; js3 = 0; je3 = -1
          folded = .false.
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             if(js .GT. jeg) then ! je > jeg
                if( domain%y(tme)%cyclic ) then
                   js = js-joff; je = je-joff
                else if(folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                endif
             else if(je .GT. jeg) then ! split into two parts
                if( domain%y(tme)%cyclic ) then
                   is2 = is; ie2 = ie; js2 = js; je2 = jeg
                   js = jeg+1-joff; je = je -joff
                else if(folded_north) then
                   folded = .true.
                   is2 = is; ie2 = ie; js2 = js; je2 = jeg
                   js  = jeg+1
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                   if( is .GT. ieg) then
                     is = is - ioff; ie = ie - ioff
                   else if( ie .GT. ieg ) then
                     is3 = is; ie3 = ieg; js3 = js; je3 = je
                     is = ieg+1-ioff; ie = ie - ioff
                   endif
                endif
             endif
 
             if( je == jeg .AND. jec == jeg .AND. folded_north .AND. (position == corner .OR. position == north)) then
                call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle)
             else
                call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             endif
             if(ie3 .GE. is3) call fill_overlap_send_nofold(overlap, domain, m, is3, ie3, js3, je3, &
                                    isc, iec, jsc, jec, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             if(ie2 .GE. is2) then
                if(je2 == jeg .AND. jec == jeg .AND. folded_north.AND.(position == corner .OR. position == north))then
                   call fill_overlap_send_fold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle)
                else
                   call fill_overlap_send_nofold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic)
                endif
             endif
          else
             need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
             if( isg.GT.is )then
                if( domain%x(tme)%cyclic .AND. ie.LT.isc )then !try cyclic offset
                   is = is+ioff; ie = ie+ioff
                   need_adjust_1 = .false.
                   if(je .GT. jeg) then
                      if( domain%y(tme)%cyclic .AND. jec.LT.js )then !try cyclic offset
                         js = js-joff; je = je-joff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                      need_adjust_3 = .false.
                   end if
                end if
             end if
             folded = .false.
             if( need_adjust_3 .AND. je.GT.jeg )then
                if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. jec.LT.js )then !try cyclic offset
                   js = js-joff; je = je-joff
                   if( need_adjust_1  .AND. isg.LE.is)then
                      call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                   end if
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                  isg, ieg, jsg, jeg, dir)
          endif
 
 
          !to_pe's northern halo
          dir = 7
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
          !--- when domain symmetry and position is EAST or CORNER, the point when isc == ie,
          !--- no need to send, because the data on that point will come from other pe.
          !--- come from two pe ( there will be only one point on one pe. ).
          if( domain%symmetry .AND. (position == east .OR. position == corner ) &
               .AND. ( isc == ie .or. iec == is ) .AND. (.not. folded_north) ) then
             !--- do nothing, this point will come from other pe
          else
             js2 = -1; je2 = 0
             if( js .GT. jeg) then ! je .GT. jeg
                if( domain%y(tme)%cyclic .AND. jec.LT.js )then !try cyclic offset
                   js = js-joff; je = je-joff
                   call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             else if( je.GT.jeg )then ! split into two parts
                if( domain%y(tme)%cyclic)then !try cyclic offset
                   is2 = is; ie2 = ie; js2 = js;         je2 = jeg
                   js = jeg+1-joff; je = je - joff
                else if( folded_north )then
                   folded = .true.
                   is2 = is; ie2 = ie; js2 = js; je2 = jeg
                   js  = jeg+1;
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             end if
             if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
                if( je == jeg .AND. jec == jeg .AND. folded_north .AND.(position == corner .OR. position == north))then
                   call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                        isg, ieg, dir, ishift, position, ioff, middle, domain%symmetry)
                else
                   call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded, domain%symmetry)
                endif
             else
                call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                  isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
             endif
 
             if(ie2 .GE. is2) then
                if(je2 == jeg .AND. jec == jeg .AND. folded_north .AND.(position == corner .OR. position == north))then
                   call fill_overlap_send_fold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle, domain%symmetry)
                else
                   call fill_overlap_send_nofold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
                endif
             endif
          end if
 
          !--- when north edge is folded, ie will be less than isg when position is EAST and CORNER
          if(is .LT. isg .AND. domain%x(tme)%cyclic) then
!             is = is + ioff
!             call insert_update_overlap( overlap, domain%list(m)%pe, &
!                                         is, is, js, je, isc, iec, jsc, jec, dir, folded)
!???             if(je2 .GE. js2)call insert_update_overlap( overlap, domain%list(m)%pe, &
!                                         is, is, js2, je2, isc, iec, jsc, jec, dir, folded)
          endif
 
          !--- Now calculate the overlapping for fold-edge. Currently we only consider about folded-north
          !--- for folded-north-edge, only need to consider to_pe's north(7) direction
          !--- only position at NORTH and CORNER need to be considered
          if( folded_north .AND. (position == north .OR. position == corner) &
              .AND. domain%x(tme)%pos .LT. (size(domain%x(tme)%list(:))+1)/2 ) then
             if( domain%list(m)%y(tnbr)%compute%end+nhalo+jshift .GE. jeg .AND. isc .LE. middle)then
                js = jeg; je = jeg
                is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
                is = max(is, middle)
                select case (position)
                case(north)
                   i=is; is = isg+ieg-ie; ie = isg+ieg-i
                case(corner)
                   i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                end select
                call insert_update_overlap(overlap, domain%list(m)%pe, &
                     is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             endif
             if(debug_update_level .NE. no_check .AND. set_check) then
                je = domain%list(m)%y(tnbr)%compute%end+jshift;
                if(je == jeg) then
                   is = max(is, isc); ie = min(ie, iec)
                   js = max(js, jsc); je = min(je, jec)
                   if(ie.GE.is .AND. je.GE.js )then
                      nsend_check = nsend_check+1
                      if(nsend_check > size(checklist(:)) ) then
                         call expand_check_overlap_list(checklist, nlist)
                      endif
                      call allocate_check_overlap(checklist(nsend_check), 1)
                      call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
                           tme, 4, one_hundred_eighty, is, ie, js, je)
                   end if
                end if
             endif
          endif
 
          !to_pe's NE halo
          dir = 8
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          is2 = 0; ie2=-1; js2=0; je2=-1
          is3 = 0; ie3 = -1; js3 = 0; je3 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             folded = .false.
             if(js .GT. jeg) then ! je > jeg
                if( domain%y(tme)%cyclic ) then
                   js = js-joff; je = je-joff
                else if(folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                endif
             else if(je .GT. jeg) then ! split into two parts
                if( domain%y(tme)%cyclic ) then
                   is2 = is; ie2 = ie; js2 = js; je2 = jeg
                   js = jeg+1-joff; je = je -joff
                else if(folded_north) then
                   folded = .true.
                   is2 = is; ie2 = ie; js2 = js; je2 = jeg
                   js  = jeg+1
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
                   if( ie .LT. isg )then
                      is = is+ioff; ie = ie+ioff
                   else if( is .LT. isg) then
                      is3 = isg; ie3 = ie; js3 = js; je3 = je
                      is = is+ioff; ie = isg-1+ioff;
                   endif
                endif
             endif
             if( je == jeg .AND. jec == jeg .AND. folded_north .AND. (position == corner .OR. position == north)) then
                call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                     isg, ieg, dir, ishift, position, ioff, middle)
             else
                call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             endif
             if(ie3 .GE. is3) call fill_overlap_send_nofold(overlap, domain, m, is3, ie3, js3, je3, &
                                    isc, iec, jsc, jec, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             if(ie2 .GE. is2) then
                if(je2 == jeg .AND. jec == jeg .AND. folded_north .AND.(position == corner .OR. position == north))then
                   call fill_overlap_send_fold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle)
                else
                   call fill_overlap_send_nofold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, domain%x(tme)%cyclic)
                endif
             endif
          else
             need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
             if( ie.GT.ieg )then
                if( domain%x(tme)%cyclic .AND. iec.LT.is )then !try cyclic offset
                   is = is-ioff; ie = ie-ioff
                   need_adjust_1 = .false.
                   if(je .GT. jeg) then
                      if( domain%y(tme)%cyclic .AND. jec.LT.js )then !try cyclic offset
                         js = js-joff; je = je-joff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                      need_adjust_3 = .false.
                   end if
                end if
             end if
             folded = .false.
             if( need_adjust_3 .AND. je.GT.jeg )then
                if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. jec.LT.js )then !try cyclic offset
                   js = js-joff; je = je-joff
                   if( need_adjust_1 .AND. ie.LE.ieg)then
                      call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                   end if
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                  isg, ieg, jsg, jeg, dir)
          endif
       endif
 
       !--- copy the overlapping information
       if( overlap%count > 0) then
         nsend = nsend + 1
         if(nsend > size(overlaplist(:)) ) then
            call mpp_error(note, 'mpp_domains_define.inc(compute_overlaps): overlapList for send is expanded')
            call expand_update_overlap_list(overlaplist, nlist)
         endif
         call add_update_overlap( overlaplist(nsend), overlap)
         call init_overlap_type(overlap)
       endif
    end do  ! end of send set up.
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do m =1,nsend
          write(iunit, *) "********to_pe = " ,overlaplist(m)%pe, " count = ",overlaplist(m)%count
          do n = 1, overlaplist(m)%count
             write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
                  overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
          enddo
       enddo
       if(nsend >0) flush(iunit)
    endif
 
    ! copy the overlapping information into domain data structure
    if(nsend>0) then
      if (associated(update%send)) deallocate(update%send) !< Check if associated
       allocate(update%send(nsend))
       update%nsend = nsend
       do m = 1, nsend
          call add_update_overlap( update%send(m), overlaplist(m) )
       enddo
    endif
 
    if(nsend_check>0) then
       check%nsend = nsend_check
       if (associated(check%send)) deallocate(check%send) !< Check if associated
       allocate(check%send(nsend_check))
       do m = 1, nsend_check
          call add_check_overlap( check%send(m), checklist(m) )
       enddo
    endif
 
    do m = 1,size(overlaplist(:))
       call deallocate_overlap_type(overlaplist(m))
    enddo
 
    if(debug_update_level .NE. no_check .AND. set_check) then
       do m = 1,size(checklist(:))
          call deallocate_overlap_type(checklist(m))
       enddo
    endif
 
    isgd = isg - domain%whalo
    iegd = ieg + domain%ehalo
    jsgd = jsg - domain%shalo
    jegd = jeg + domain%nhalo
 
    ! begin setting up recv
    nrecv = 0
    nrecv_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+nlist-list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
          jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
          !recv_e
          dir = 1
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%compute%end+ehalo+ishift
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( domain%symmetry .AND. (position == north .OR. position == corner ) &
               .AND. ( jsd == je .or. jed == js ) ) then
             ! --- do nothing, this point will come from other pe
          else
             !--- when the north face is folded, the east halo point at right side domain will be folded.
             !--- the position should be on CORNER or NORTH
             if( jed == jeg .AND. folded_north .AND. (position == corner .OR. position == north) ) then
                call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ishift, position, ioff, middle)
             else
                if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
                   call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic)
                else
                   if( ied.GT.ieg )then
                      if( domain%x(tme)%cyclic .AND. ie.LT.isd )then !try cyclic offset
                         is = is+ioff; ie = ie+ioff
                         call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                      end if
                   end if
                   call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                      isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
                endif
             endif
          endif
 
          !recv_se
          dir = 2
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%compute%end+ehalo+ishift
          jsd = domain%y(tme)%compute%begin-shalo;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          !--- divide into two parts, one part is x_cyclic_offset/y_cyclic_offset is non-zeor,
          !--- the other part is both are zero.
          is2 = 0; ie2 = -1; js2 = 0; je2 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             if(jed .LT. jsg) then ! then jsd < jsg
                if( domain%y(tme)%cyclic ) then
                   js = js-joff; je = je-joff
                endif
             else if(jsd .LT. jsg) then !split into two parts
                if( domain%y(tme)%cyclic ) then
                   js2 = js-joff; je2 = je-joff
                endif
             endif
             call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
             if(je2 .GE. js2) call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js2, je2, isd, ied, jsd, jed, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
          else
             need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
             if( jsd.LT.jsg )then
                if( domain%y(tme)%cyclic .AND. js.GT.jed )then !try cyclic offset
                   js = js-joff; je = je-joff
                   need_adjust_1 = .false.
                   if( ied.GT.ieg )then
                      if( domain%x(tme)%cyclic .AND. ie.LT.isd )then !try cyclic offset
                         is = is+ioff; ie = ie+ioff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, x_cyclic_offset, jsgd, jeg, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, iegd, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                      need_adjust_3 = .false.
                   end if
                end if
             end if
             if( need_adjust_3 .AND. ied.GT.ieg )then
                if( need_adjust_2 .AND. domain%x(tme)%cyclic .AND. ie.LT.isd )then !try cyclic offset
                   is = is+ioff; ie = ie+ioff
                   if( need_adjust_1 .AND. jsd.GE.jsg )then
                      call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                   end if
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                 isg, ieg, jsg, jeg, dir)
          endif
 
          !recv_s
          dir = 3
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%compute%begin-shalo;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          js2 = 0; je2 = -1
          if( jed .LT. jsg) then ! jsd < jsg
             if( domain%y(tme)%cyclic ) then
                js = js-joff; je = je-joff
                call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
             endif
          else if( jsd.LT.jsg )then ! split into two parts
             if( domain%y(tme)%cyclic)then !try cyclic offset
                js2 = js-joff; je2 = je-joff
             end if
          end if
          call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
               isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
          if(je2 .GE. js2) call fill_overlap(overlap, domain, m, is, ie, js2, je2, isd, ied, jsd, jed, &
               isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
          !recv_sw
          dir = 4
          isd = domain%x(tme)%compute%begin-whalo; ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%begin-shalo; jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          is2 = 0; ie2 = -1; js2 = 0; je2 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             if( ied.LT.isg )then ! isd < isg
                if( domain%x(tme)%cyclic ) then
                   is = is-ioff; ie = ie-ioff
                endif
             else if (isd.LT.isg )then ! split into two parts
                if( domain%x(tme)%cyclic ) then
                   is2 = is-ioff; ie2 = ie-ioff
                endif
             endif
             if( jed.LT.jsg )then  ! jsd < jsg
                if( domain%y(tme)%cyclic ) then
                   js = js-joff; je = je-joff
                endif
             else if( jsd.LT.jsg )then ! split into two parts
                if( domain%y(tme)%cyclic ) then
                   js2 = js-joff; je2 = je-joff
                endif
             endif
          else
             need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
             if( jsd.LT.jsg )then
                if( domain%y(tme)%cyclic .AND. js.GT.jed )then !try cyclic offset
                   js = js-joff; je = je-joff
                   need_adjust_1 = .false.
                   if( isd.LT.isg )then
                      if( domain%x(tme)%cyclic .AND. is.GT.ied )then !try cyclic offset
                         is = is-ioff; ie = ie-ioff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, -x_cyclic_offset, jsgd, jeg, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, -y_cyclic_offset, isgd, ieg, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(is, ie, -y_cyclic_offset, isg, ieg, ni)
                      need_adjust_3 = .false.
                   end if
                end if
             end if
             if( need_adjust_3 .AND. isd.LT.isg )then
                if( need_adjust_2 .AND. domain%x(tme)%cyclic .AND. is.GT.ied )then !try cyclic offset
                   is = is-ioff; ie = ie-ioff
                   if(need_adjust_1 .AND. jsd.GE.jsg) then
                      call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                   end if
                end if
             end if
          endif
          call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
               isg, ieg, jsg, jeg, dir)
 
          if(ie2 .GE. is2)call fill_overlap(overlap, domain, m, is2, ie2, js, je, isd, ied, jsd, jed, &
               isg, ieg, jsg, jeg, dir)
          if(je2 .GE. js2)call fill_overlap(overlap, domain, m, is, ie, js2, je2, isd, ied, jsd, jed, &
               isg, ieg, jsg, jeg, dir)
 
          if(ie2 .GE. is2 .AND. je2 .GE. js2)call fill_overlap(overlap, domain, m, is2, ie2, js2, je2, isd, ied, jsd, &
               & jed, isg, ieg, jsg, jeg, dir)
 
 
          !recv_w
          dir = 5
          isd = domain%x(tme)%compute%begin-whalo;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
 
          !--- when the north face is folded, some point at j=nj will be folded.
          !--- the position should be on CORNER or NORTH
          if( jed == jeg .AND. folded_north .AND. (position == corner .OR. position == north) ) then
             call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                  isg, ieg, dir, ishift, position, ioff, middle)
          else
             if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
                call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
             else
                if( isd.LT.isg )then
                   if( domain%x(tme)%cyclic .AND. is.GT.ied )then !try cyclic offset
                      is = is-ioff; ie = ie-ioff
                      call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                   end if
                end if
                call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
             endif
          endif
 
          !recv_nw
          dir = 6
          folded = .false.
          isd = domain%x(tme)%compute%begin-whalo;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%compute%end+nhalo+jshift
          is=isc; ie=iec; js=jsc; je=jec
          is2 = 0; ie2 = -1; js2 = 0; je2 = -1
          is3 = 0; ie3 = -1; js3 = 0; je3 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             js2 = -1; je2 = 0
             if( jsd .GT. jeg ) then ! jed > jeg
                if( domain%y(tme)%cyclic .AND. je.LT.jsd )then !try cyclic offset
                   js = js+joff; je = je+joff
                   call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             else if( jed.GT.jeg )then ! split into two parts
                if( domain%y(tme)%cyclic)then !try cyclic offset
                   is2 = is; ie2 = ie; js2 = js; je2 = je
                   isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
                   js = js + joff; je = je + joff
                   jsd = jeg+1
                else if( folded_north )then
                   folded = .true.
                   is2 = is; ie2 = ie; js2 = js; je2 = je
                   isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
                   jsd = jeg+1
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                   if(isd < isg .and. ied .GE. isg .and. domain%symmetry) then
                      isd3 = isd; ied3 = isg-1
                      jsd3 = jsd; jed3 = jed
                      is3 = is-ioff; ie3=ie-ioff
                      js3 = js; je3 = je
                      isd = isg;
                   endif
                end if
             endif
 
             if( jeg .GE. js .AND. jeg .LE. je .AND. jed == jeg .AND. folded_north &
                  .AND. (position == corner .OR. position == north)) then
                call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ishift, position, ioff, middle)
             else
                call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             endif
 
             if(ie3 .GE. is3) call fill_overlap_recv_nofold(overlap, domain, m, is3, ie3, js3, je3, isd3, ied3, jsd3, &
                     & jed3, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
             if(ie2 .GE. is2) then
                if( jeg .GE. js2 .AND. jeg .LE. je2 .AND. jed2 == jeg .AND. folded_north &
                    .AND. (position == corner .OR. position == north)) then
                   call fill_overlap_recv_fold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
                        isg, ieg, dir, ishift, position, ioff, middle)
                else
                   call fill_overlap_recv_nofold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic)
                endif
             endif
          else
             need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
             if( jed.GT.jeg )then
                if( domain%y(tme)%cyclic .AND. je.LT.jsd )then !try cyclic offset
                   js = js+joff; je = je+joff
                   need_adjust_1 = .false.
                   if( isd.LT.isg )then
                      if( domain%x(tme)%cyclic .AND. is.GE.ied )then !try cyclic offset
                         is = is-ioff; ie = ie-ioff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jegd, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, y_cyclic_offset, isgd, ieg, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                      need_adjust_3 = .false.
                   end if
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             end if
             if( need_adjust_3 .AND. isd.LT.isg )then
                if( need_adjust_2 .AND. domain%x(tme)%cyclic .AND. is.GE.ied )then !try cyclic offset
                   is = is-ioff; ie = ie-ioff
                   if( need_adjust_1 .AND. jed.LE.jeg )then
                      call apply_cyclic_offset(js, je, -x_cyclic_offset, jsg, jeg, nj)
                   end if
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                  isg, ieg, jsg, jeg, dir)
          endif
 
          !--- when north edge is folded, is will be less than isg when position is EAST and CORNER
          if(is .LT. isg .AND. domain%x(tme)%cyclic) then
             is = is + ioff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, is, js, je, isd, ied, jsd, jed, dir, folded )
          endif
 
          !recv_n
          dir = 7
          folded = .false.
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%compute%end+nhalo+jshift
          is=isc; ie=iec; js=jsc; je=jec
 
          !--- when domain symmetry and position is EAST or CORNER, the point at i=isd will
          !--- come from two pe ( there will be only one point on one pe. ).
          if( domain%symmetry .AND. (position == east .OR. position == corner ) &
               .AND. (isd == ie .or. ied == is ) .AND. (.not. folded_north) ) then
             !--- do nothing, this point will come from other pe
          else
             js2 = -1; je2 = 0
             if( jsd .GT. jeg ) then ! jed > jeg
                if( domain%y(tme)%cyclic .AND. je.LT.jsd )then !try cyclic offset
                   js = js+joff; je = je+joff
                   call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             else if( jed.GT.jeg )then ! split into two parts
                if( domain%y(tme)%cyclic)then !try cyclic offset
                   is2 = is; ie2 = ie; js2 = js; je2 = je
                   isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
                   js = js + joff; je = je + joff
                   jsd = jeg+1
                else if( folded_north )then
                   folded = .true.
                   is2 = is; ie2 = ie; js2 = js; je2 = je
                   isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
                   jsd = jeg+1
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             end if
             if(x_cyclic_offset == 0 .and. y_cyclic_offset == 0) then
                if( jeg .GE. js .AND. jeg .LE. je .AND. jed == jeg .AND. folded_north &
                     .AND. (position == corner .OR. position == north)) then
                   call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                        isg, ieg, dir, ishift, position, ioff, middle, symmetry=domain%symmetry)
                else
                   call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded, symmetry=domain%symmetry)
                endif
             else
                call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
             endif
             if(ie2 .GE. is2) then
                if(jeg .GE. js2 .AND. jeg .LE. je2 .AND. jed2 == jeg .AND. folded_north &
                   .AND. (position == corner .OR. position == north)) then
                   call fill_overlap_recv_fold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
                        isg, ieg, dir, ishift, position, ioff, middle, symmetry=domain%symmetry)
                else
                   call fill_overlap_recv_nofold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded, symmetry=domain%symmetry)
                endif
             endif
          endif
 
          !--- when north edge is folded, ie will be less than isg when position is EAST and CORNER
          if(is .LT. isg .AND. domain%x(tme)%cyclic) then
!             is = is + ioff
!             call insert_update_overlap( overlap, domain%list(m)%pe, &
!                  is, is, js, je, isd, ied, jsd, jed, dir, folded)
          endif
 
          !--- Now calculate the overlapping for fold-edge. Currently we only consider about folded-north
          !--- for folded-north-edge, only need to consider to_pe's north(7) direction
          !--- only position at NORTH and CORNER need to be considered
 
          if( folded_north .AND. (position == north .OR. position == corner) &
               .AND. domain%x(tme)%pos .GE. size(domain%x(tme)%list(:))/2) then
             if( jed .GE. jeg .AND. ied .GE. middle)then
                jsd = jeg; jed = jeg
                is=isc; ie=iec; js = jsc; je = jec
                isd = max(isd, middle)
                select case (position)
                case(north)
                   i=is; is = isg+ieg-ie; ie = isg+ieg-i
                case(corner)
                   i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                end select
                call insert_update_overlap(overlap, domain%list(m)%pe, &
                     is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
             endif
             if(debug_update_level .NE. no_check .AND. set_check) then
                jsd = domain%y(tme)%compute%end+jshift;   jed = jsd
                if(jed == jeg) then
                   is = max(is, isd); ie = min(ie, ied)
                   js = max(js, jsd); je = min(je, jed)
                   if(ie.GE.is .AND. je.GE.js )then
                      nrecv_check = nrecv_check+1
                      if(nrecv_check > size(checklist(:)) ) then
                         call expand_check_overlap_list(checklist, nlist)
                      endif
                      call allocate_check_overlap(checklist(nrecv_check), 1)
                      call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
                           tme, 4, one_hundred_eighty, is, ie, js, je)
                   end if
                end if
             endif
 
          endif
 
          !recv_ne
          dir = 8
          folded = .false.
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%compute%end+ehalo+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%compute%end+nhalo+jshift
          is=isc; ie=iec; js=jsc; je=jec
          is2 = 0; ie2=-1; js2=0; je2=-1
          is3 = 0; ie3 = -1; js3 = 0; je3 = -1
          if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) then
             js2 = -1; je2 = 0
             if( jsd .GT. jeg ) then ! jed > jeg
                if( domain%y(tme)%cyclic .AND. je.LT.jsd )then !try cyclic offset
                   js = js+joff; je = je+joff
                   call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             else if( jed.GT.jeg )then ! split into two parts
                if( domain%y(tme)%cyclic)then !try cyclic offset
                   is2 = is; ie2 = ie; js2 = js; je2 = je
                   isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
                   js = js + joff; je = je + joff
                   jsd = jeg+1
                else if( folded_north )then
                   folded = .true.
                   is2 = is; ie2 = ie; js2 = js; je2 = je
                   isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
                   jsd = jeg+1
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                   if(ied > ieg .and. isd .LE. ieg .and. domain%symmetry) then
                      isd3 = ieg+1; ied3 = ied
                      jsd3 = jsd; jed3 = jed
                      is3 = is+ioff; ie3=ie+ioff
                      js3 = js; je3 = je
                      ied = ieg;
                   endif
                end if
             endif
             if( jeg .GE. js .AND. jeg .LE. je .AND. jed == jeg .AND. folded_north &
                  .AND. (position == corner .OR. position == north)) then
                call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ishift, position, ioff, middle)
             else
                call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             endif
             if(ie3 .GE. is3) call fill_overlap_recv_nofold(overlap, domain, m, is3, ie3, js3, je3, isd3, ied3, jsd3, &
                     & jed3, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
             if(ie2 .GE. is2) then
                if(jeg .GE. js2 .AND. jeg .LE. je2 .AND. jed2 == jeg .AND. folded_north &
                     .AND. (position == corner .OR. position == north)) then
                   call fill_overlap_recv_fold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
                        isg, ieg, dir, ishift, position, ioff, middle)
                else
                   call fill_overlap_recv_nofold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
                        isg, ieg, dir, ioff, domain%x(tme)%cyclic)
                endif
             endif
          else
             need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
             if( jed.GT.jeg )then
                if( domain%y(tme)%cyclic .AND. je.LT.jsd )then !try cyclic offset
                   js = js+joff; je = je+joff
                   need_adjust_1 = .false.
                   if( ied.GT.ieg )then
                      if( domain%x(tme)%cyclic .AND. ie.LT.isd )then !try cyclic offset
                         is = is+ioff; ie = ie+ioff
                         need_adjust_2 = .false.
                         if(x_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jegd, nj)
                         else if(y_cyclic_offset .NE. 0) then
                            call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, iegd, ni)
                         end if
                      end if
                   else
                      call apply_cyclic_offset(is, ie, y_cyclic_offset, isg, ieg, ni)
                      need_adjust_3 = .false.
                   end if
                else if( folded_north )then
                   folded = .true.
                   call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
                end if
             end if
             if(  need_adjust_3 .AND. ied.GT.ieg )then
                if(  need_adjust_2 .AND. domain%x(tme)%cyclic .AND. ie.LT.isd )then !try cyclic offset
                   is = is+ioff; ie = ie+ioff
                   if( need_adjust_1 .AND. jed.LE.jeg)then
                      call apply_cyclic_offset(js, je, x_cyclic_offset, jsg, jeg, nj)
                   end if
                end if
             end if
             call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                  isg, ieg, jsg, jeg, dir)
          endif
       endif
 
       !--- copy the overlapping information
       if( overlap%count > 0) then
          nrecv = nrecv + 1
          if(nrecv > size(overlaplist(:)) )then
            call mpp_error(note, 'mpp_domains_define.inc(compute_overlaps): overlapList for recv is expanded')
            call expand_update_overlap_list(overlaplist, nlist)
          endif
          call add_update_overlap( overlaplist(nrecv), overlap)
          call init_overlap_type(overlap)
       endif
    enddo ! end of recv do loop
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do m =1,nrecv
          write(iunit, *) "********from_pe = " ,overlaplist(m)%pe, " count = ",overlaplist(m)%count
          do n = 1, overlaplist(m)%count
             write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
                  overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
          enddo
       enddo
       if(nrecv >0) flush(iunit)
    endif
 
    ! copy the overlapping information into domain
    if(nrecv>0) then
      if (associated(update%recv)) deallocate(update%recv) !< Check if associated
       allocate(update%recv(nrecv))
       update%nrecv = nrecv
       do m = 1, nrecv
          call add_update_overlap( update%recv(m), overlaplist(m) )
          do n = 1, update%recv(m)%count
             if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) then
                if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
                if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
             endif
          enddo
       enddo
    endif
 
    if(nrecv_check>0) then
       check%nrecv = nrecv_check
       if (associated(check%recv)) deallocate(check%recv) !< Check if associated
       allocate(check%recv(nrecv_check))
       do m = 1, nrecv_check
          call add_check_overlap( check%recv(m), checklist(m) )
       enddo
    endif
 
    call deallocate_overlap_type(overlap)
    do m = 1,size(overlaplist(:))
       call deallocate_overlap_type(overlaplist(m))
    enddo
 
    if(debug_update_level .NE. no_check .AND. set_check) then
       do m = 1,size(checklist(:))
          call deallocate_overlap_type(checklist(m))
       enddo
    endif
 
    deallocate(overlaplist)
    if(set_check) deallocate(checklist)
    domain%initialized = .true.
 
  end subroutine compute_overlaps
 
 
  subroutine fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ioff, is_cyclic, folded, symmetry)
    type(overlap_type), intent(inout) :: overlap
    type(domain2d),     intent(inout) :: domain
    integer,            intent(in   ) :: m, is, ie, js, je
    integer,            intent(in   ) :: isc, iec, jsc, jec
    integer,            intent(in   ) :: isg, ieg, dir, ioff
    logical,            intent(in   ) :: is_cyclic
    logical, optional,  intent(in   ) :: folded, symmetry
 
    call insert_update_overlap( overlap, domain%list(m)%pe,              &
            is, ie, js, je, isc, iec, jsc, jec, dir, reverse=folded, symmetry=symmetry)
    if(is_cyclic) then
       if(ie .GT. ieg) then
          call insert_update_overlap( overlap, domain%list(m)%pe,              &
               is-ioff, ie-ioff, js, je, isc, iec, jsc, jec, dir, reverse=folded, symmetry=symmetry)
       else if( is .LT. isg ) then
          call insert_update_overlap( overlap, domain%list(m)%pe,              &
               is+ioff, ie+ioff, js, je, isc, iec, jsc, jec, dir, reverse=folded, symmetry=symmetry)
       endif
    endif
 
  end subroutine fill_overlap_send_nofold
  !##################################################################################
  subroutine fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                    isg, ieg, dir, ishift, position, ioff, middle, symmetry)
    type(overlap_type), intent(inout) :: overlap
    type(domain2d),     intent(inout) :: domain
    integer,            intent(in   ) :: m, is, ie, js, je
    integer,            intent(in   ) :: isc, iec, jsc, jec
    integer,            intent(in   ) :: isg, ieg, dir, ishift, position, ioff, middle
    logical, optional,  intent(in   ) :: symmetry
    integer                           :: is1, ie1, is2, ie2, i
 
    !--- consider at j = jeg for west edge.
    !--- when the data is at corner and not symmetry, i = isg -1 will get from cyclic condition
    if(position == corner .AND. .NOT. domain%symmetry .AND. is .LE. isg-1 .AND. ie .GE. isg-1) then
       call insert_update_overlap(overlap, domain%list(m)%pe, &
            isg-1+ioff, isg-1+ioff, je, je, isc, iec, jsc, jec, dir, .true.)
    end if
 
    is1 = 0; ie1 = -1; is2 = 0; ie2 = -1
    !--- east edge
    if( is > ieg ) then
       is2 = is-ioff; ie2 = ie-ioff
    else if( ie > ieg ) then ! split into two parts
       is1 = is; ie1 = ieg
       is2 = ieg+1-ioff; ie2 = ie-ioff
    else if( is .GE. middle ) then
       is1 = is; ie1 = ie
    else if( ie .GE. middle ) then ! split into two parts
       is1 = middle; ie1 = ie
       is2 = is;     ie2 = middle-1
    else if( ie < isg ) then ! west boundary
       is1 = is+ieg-isg+1-ishift; ie1 = ie+ieg-isg+1-ishift
    else if( is < isg ) then ! split into two parts
       is1 = is+ieg-isg+1-ishift; ie1 = isg-1+ieg-isg+1-ishift
       is2 = isg; ie2 = ie
    else
       is2 = is; ie2 = ie
    endif
 
    if( ie1 .GE. is1) then
       call insert_update_overlap( overlap, domain%list(m)%pe,              &
            is1, ie1, js, je-1, isc, iec, jsc, jec, dir, symmetry=symmetry)
 
       select case (position)
       case(north)
          i=is1; is1 = isg+ieg-ie1; ie1 = isg+ieg-i
       case(corner)
          i=is1; is1 = isg+ieg-ie1-1+ishift; ie1 = isg+ieg-i-1+ishift
       end select
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            is1, ie1, je, je, isc, iec, jsc, jec, dir, .true., symmetry=symmetry)
    endif
 
    if(ie2 .GE. is2) then
       call insert_update_overlap( overlap, domain%list(m)%pe,              &
            is2, ie2, js, je, isc, iec, jsc, jec, dir)
    endif
 
  end subroutine fill_overlap_send_fold
 
 
  !#############################################################################
  subroutine fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                                    isg, ieg, dir, ioff, is_cyclic, folded, symmetry)
    type(overlap_type), intent(inout) :: overlap
    type(domain2d),     intent(inout) :: domain
    integer,            intent(in   ) :: m, is, ie, js, je
    integer,            intent(in   ) :: isd, ied, jsd, jed
    integer,            intent(in   ) :: isg, ieg, dir, ioff
    logical,            intent(in   ) :: is_cyclic
    logical, optional,  intent(in   ) :: folded, symmetry
    integer                           :: is1, ie1, is2, ie2
    integer                           :: isd1, ied1, isd2, ied2
 
    is1 = 0; ie1 = -1; is2 = 0; ie2 = -1
    isd1=isd; ied1=ied
    isd2=isd; ied2=ied
 
    call insert_update_overlap( overlap, domain%list(m)%pe,              &
            is, ie, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
    if(is_cyclic) then
       if(ied .GT. ieg) then
          call insert_update_overlap( overlap, domain%list(m)%pe,              &
               is+ioff, ie+ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
       else if( isd .LT. isg ) then
          call insert_update_overlap( overlap, domain%list(m)%pe,              &
               is-ioff, ie-ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
       else if ( is .LT. isg ) then
          call insert_update_overlap( overlap, domain%list(m)%pe,              &
               is+ioff, ie+ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
       else if ( ie .GT. ieg ) then
          call insert_update_overlap( overlap, domain%list(m)%pe,              &
               is-ioff, ie-ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
       endif
    endif
 
  end subroutine fill_overlap_recv_nofold
  !#################################################################################
  subroutine fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
                                    isg, ieg, dir, ishift, position, ioff, middle, symmetry)
    type(overlap_type), intent(inout) :: overlap
    type(domain2d),     intent(inout) :: domain
    integer,            intent(in   ) :: m, is, ie, js, je
    integer,            intent(in   ) :: isd, ied, jsd, jed
    integer,            intent(in   ) :: isg, ieg, dir, ishift, position, ioff, middle
    logical, optional,  intent(in   ) :: symmetry
    integer                           :: is1, ie1, is2, ie2, is3, ie3
    integer                           :: isd1, ied1, isd2, ied2
 
    !--- consider at j = jeg for west edge.
    !--- when the data is at corner and not symmetry, i = isg -1 will get from cyclic condition
    if( position == corner .AND. .NOT. domain%symmetry .AND. isd .LE. isg-1 .AND. ied .GE. isg-1 ) then
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            is-ioff, ie-ioff, js, je, isg-1, isg-1, jed, jed, dir, .true.)
    end if
 
    is1 = 0;  ie1 = -1; is2 = 0;  ie2 = -1
    isd1=isd; ied1=ied
    isd2=isd; ied2=ied
    select case (position)
    case(north)
       is3 = isg+ieg-ie; ie3 = isg+ieg-is
    case(corner)
       is3 = isg+ieg-ie-1+ishift; ie3 = isg+ieg-is-1+ishift
    end select
 
    if(isd .GT. ieg) then ! east
       is2 = is + ioff; ie2 = ie + ioff;
    else if(ied .GT. ieg) then ! split into two parts
       is1 = is; ie1 = ie;
       isd1 = isd; ied1 = ieg;
       is2 = is + ioff; ie2 = ie + ioff
       isd2 = ieg + 1; ied2 = ied
    else if(isd .GE. middle) then
       is1 = is; ie1 = ie
    else if(ied .GE. middle) then ! split into two parts
       is1 = is; ie1 = ie
       isd1 = middle; ied1 = ied
       is2 = is; ie2 = ie
       isd2 = isd; ied2 = middle-1
    else if(ied .LT. isg) then
       is1 = is - ioff; ie1 = ie - ioff;
       is3 = is3 - ioff; ie3 = ie3 - ioff;
    else if(isd .LT. isg) then ! split into two parts
       is1 = is - ioff; ie1 = ie - ioff;
       is3 = is3 - ioff; ie3 = ie3 - ioff;
       isd1 = isd; ied1 = isg-1
       is2 = is;        ie2 = ie
       isd2 = isg;      ied2 = ied
   else
       is2 = is  ; ie2 =ie
       isd2 = isd; ied2 = ied
   endif
 
   if( ie1 .GE. is1) then
      call insert_update_overlap( overlap, domain%list(m)%pe,              &
           is1, ie1, js, je, isd1, ied1, jsd, jed-1, dir, symmetry=symmetry)
 
      call insert_update_overlap( overlap, domain%list(m)%pe, &
           is3, ie3, js, je, isd1, ied1, jed, jed, dir, .true., symmetry=symmetry)
   endif
 
   if(ie2 .GE. is2) then
      call insert_update_overlap( overlap, domain%list(m)%pe,              &
           is2, ie2, js, je, isd2, ied2, jsd, jed, dir)
   endif
 
  end subroutine fill_overlap_recv_fold
 
!#####################################################################################
  subroutine fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
                                  isg, ieg, jsg, jeg, dir, reverse, symmetry)
    type(overlap_type), intent(inout) :: overlap
    type(domain2d),     intent(inout) :: domain
    integer,            intent(in   ) :: m, is, ie, js, je
    integer,            intent(in   ) :: isc, iec, jsc, jec
    integer,            intent(in   ) :: isg, ieg, jsg, jeg
    integer,            intent(in   ) :: dir
    logical, optional,  intent(in   ) :: reverse, symmetry
 
    if(js > je) then ! separate into two regions due to x_cyclic_offset is nonzero, the two region are
       ! (js, jeg) and (jsg, je).
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            is, ie, jsg, je, isc, iec, jsc, jec, dir, reverse, symmetry)
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            is, ie, js, jeg, isc, iec, jsc, jec, dir, reverse, symmetry)
    else if(is > ie) then ! separate into two regions due to y_cyclic_offset is nonzero, the two region are
       ! (is, ieg) and (isg, ie).
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            is, ieg, js, je, isc, iec, jsc, jec, dir, reverse, symmetry)
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            isg, ie, js, je, isc, iec, jsc, jec, dir, reverse, symmetry)
    else
       call insert_update_overlap( overlap, domain%list(m)%pe, &
            is, ie, js, je, isc, iec, jsc, jec, dir, reverse, symmetry)
    end if
 
 
  end subroutine fill_overlap
 
  !####################################################################################
  !> Computes remote domain overlaps
  !! assumes only one in each direction
  !! will calculate the overlapping for T,E,C,N-cell separately.
  subroutine compute_overlaps_fold_south( domain, position, ishift, jshift)
    type(domain2d), intent(inout) :: domain
    integer, intent(in)           :: position, ishift, jshift
 
    integer                          :: i, m, n, nlist, tMe, tNbr, dir
    integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd, jed
    integer                          :: isg, ieg, jsg, jeg, ioff, joff
    integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
    integer                          :: ism, iem, jsm, jem, whalo, ehalo, shalo, nhalo
    logical                          :: folded
    type(overlap_type)               :: overlap
    type(overlapspec),   pointer     :: update=>null()
    type(overlap_type),  pointer     :: overlapList(:)=>null()
    type(overlap_type),  pointer     :: checkList(:)=>null()
    type(overlapspec),   pointer     :: check =>null()
    integer                          :: nsend, nrecv
    integer                          :: nsend_check, nrecv_check
    integer                          :: iunit
 
    !--- since we restrict that if multiple tiles on one pe, all the tiles are limited to this pe.
    !--- In this case, if ntiles on this pe is greater than 1, no overlapping between processor within each tile
    !--- In this case the overlapping exist only for tMe=1 and tNbr=1
    if(size(domain%x(:)) > 1) return
 
    !--- if there is no halo, no need to compute overlaps.
    if(domain%whalo==0 .AND. domain%ehalo==0 .AND. domain%shalo==0 .AND. domain%nhalo==0) return
 
    !--- when there is only one tile, n will equal to np
    nlist = size(domain%list(:))
 
    select case(position)
    case (center)
       update => domain%update_T
       check  => null()
    case (corner)
       update => domain%update_C
       check  => domain%check_C
    case (east)
       update => domain%update_E
       check  => domain%check_E
    case (north)
       update => domain%update_N
       check  => domain%check_N
    case default
       call mpp_error(fatal, &
        "mpp_domains_define.inc(compute_overlaps_fold_south): the value of position should be CENTER, EAST, &
                               &  CORNER or NORTH")
    end select
 
    allocate(overlaplist(maxlist) )
    allocate(checklist(maxlist)   )
 
    !--- overlap is used to store the overlapping temporarily.
    call allocate_update_overlap( overlap, maxoverlap)
 
    !send
    call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position  )
    call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position  ) !cyclic offsets
    call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
    update%xbegin = ism; update%xend = iem
    update%ybegin = jsm; update%yend = jem
    if(ASSOCIATED(check)) then
       check%xbegin  = ism; check%xend  = iem
       check%ybegin  = jsm; check%yend  = jem
    endif
    update%whalo  = domain%whalo; update%ehalo = domain%ehalo
    update%shalo  = domain%shalo; update%nhalo = domain%nhalo
    whalo         = domain%whalo; ehalo        = domain%ehalo
    shalo         = domain%shalo; nhalo        = domain%nhalo
 
 
    ioff = ni - ishift
    joff = nj - jshift
    middle = (isg+ieg)/2+1
    tme = 1; tnbr = 1
 
    if(.NOT. btest(domain%fold,south)) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_south): "//&
            "boundary condition in y-direction should be folded-south for "//trim(domain%name))
    endif
    if(.NOT. domain%x(tme)%cyclic) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_south): "//&
            "boundary condition in x-direction should be cyclic for "//trim(domain%name))
    endif
 
    if(.not. domain%symmetry) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_south): "//&
            "when south boundary is folded, the domain must be symmetry for "//trim(domain%name))
    endif
 
    nsend = 0
    nsend_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          !to_pe's eastern halo
          dir = 1
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
          !--- to make sure the consistence between pes
          if( (position == north .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( ie.GT.ieg .AND. iec.LT.is )then ! cyclic is assumed
                is = is-ioff; ie = ie-ioff
             end if
             !--- when the south face is folded, the east halo point at right side domain will be folded.
             !--- the position should be on CORNER or NORTH
             if( js == jsg .AND. (position == corner .OR. position == north) &
                  .AND. is .GE. middle .AND. domain%list(m)%x(tnbr)%compute%end+ehalo+jshift .LE. ieg ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js+1, je, isc, iec, jsc, jec, dir)
                is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
                je = js
                select case (position)
                case(north)
                   i=is; is = isg+ieg-ie; ie = isg+ieg-i
                case(corner)
                   i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                end select
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
             end if
          end if
 
          !to_pe's SE halo
          dir = 2
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
          if( ie.GT.ieg .AND. iec.LT.is )then ! cyclic is assumed
             is = is-ioff; ie = ie-ioff
          end if
          if( js.LT.jsg )then
             folded = .true.
             call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
          end if
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
          !to_pe's southern halo
          dir = 3
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          folded = .false.
          if( js.LT.jsg )then
             folded = .true.
             call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
          end if
          !--- when domain symmetry and position is EAST or CORNER, the point when isc == ie,
          !--- no need to send, because the data on that point will come from other pe.
          !--- come from two pe ( there will be only one point on one pe. ).
          if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, je, isc, iec, jsc, jec, dir, folded, symmetry=domain%symmetry)
          endif
          !--- when south edge is folded, ie will be less than isg when position is EAST and CORNER
          if(is .LT. isg) then
             is = is + ioff
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, is, js, je, isc, iec, jsc, jec, dir, folded)
          endif
 
          !to_pe's SW halo
          dir = 4
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          if( isg.GT.is .AND. ie.LT.isc )then !cyclic offset
             is = is+ioff; ie = ie+ioff
          end if
          if( js.LT.jsg )then
             folded = .true.
             call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, folded)
          !--- when south edge is folded, is will be less than isg when position is EAST and CORNER
          if(is .LT. isg) then
             is = is + ioff
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, is, js, je, isc, iec, jsc, jec, dir, folded)
          endif
 
          !to_pe's western halo
          dir = 5
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
          !--- to make sure the consistence between pes
          if( (position == north .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( isg.GT.is .AND. ie.LT.isc )then ! cyclic offset
                is = is+ioff; ie = ie+ioff
             end if
             !--- when the south face is folded, some point at j=nj will be folded.
             !--- the position should be on CORNER or NORTH
             if( js == jsg .AND. (position == corner .OR. position == north) &
                  .AND. ( domain%list(m)%x(tnbr)%compute%begin == isg .OR. &
                        & domain%list(m)%x(tnbr)%compute%begin-1 .GE. middle)) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js+1, je, isc, iec, jsc, jec, dir)
                is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
                js = domain%list(m)%y(tnbr)%compute%begin;   je = js
                if ( domain%list(m)%x(tnbr)%compute%begin == isg ) then
                   select case (position)
                   case(north)
                      i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
                   case(corner)
                      i=is; is = 2*isg-ie-2+2*ishift; ie = 2*isg-i-2+2*ishift
                   end select
                   if(ie .GT. domain%x(tme)%compute%end+ishift) call mpp_error( fatal, &
                        'mpp_domains_define.inc(compute_overlaps_fold_south): west edge ubound error send.' )
                else
                   select case (position)
                   case(north)
                      i=is; is = isg+ieg-ie; ie = isg+ieg-i
                   case(corner)
                      i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                   end select
                end if
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !to_pe's NW halo
          dir = 6
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          if( isg.GT.is .AND. ie.LT.isc )then ! cyclic offset
             is = is+ioff; ie = ie+ioff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir)
 
          !to_pe's northern halo
          dir = 7
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
          !to_pe's NE halo
          dir = 8
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          if( ie.GT.ieg .AND. iec.LT.is )then !cyclic offset
             is = is-ioff; ie = ie-ioff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir)
 
          !--- Now calculate the overlapping for fold-edge.
          !--- only position at NORTH and CORNER need to be considered
          if( ( position == north .OR. position == corner) ) then
             !fold is within domain
             if( domain%y(tme)%domain_data%begin .LE. jsg .AND. jsg .LE. domain%y(tme)%domain_data%end+jshift )then
                dir = 3
                !--- calculate the overlapping for sending
                if( domain%x(tme)%pos .LT. (size(domain%x(tme)%list(:))+1)/2 )then
                   js = domain%list(m)%y(tnbr)%compute%begin;   je = js
                   if( js == jsg )then   ! fold is within domain.
                      is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
                      select case (position)
                      case(north)
                         is = max(is, middle)
                         i=is; is = isg+ieg-ie; ie = isg+ieg-i
                      case(corner)
                         is = max(is, middle)
                         i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                      end select
                      call insert_update_overlap(overlap, domain%list(m)%pe, &
                                                 is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
                      is = max(is, isc); ie = min(ie, iec)
                      js = max(js, jsc); je = min(je, jec)
                      if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )then
                         nsend_check = nsend_check+1
                         call allocate_check_overlap(checklist(nsend_check), 1)
                         call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
                                                   tme, 2, one_hundred_eighty, is, ie, js, je)
                      end if
                   end if
                end if
             end if
          end if
       end if
       !--- copy the overlapping information
       if( overlap%count > 0) then
         nsend = nsend + 1
         if(nsend > size(overlaplist(:)) ) then
            call mpp_error(note, 'mpp_domains_define.inc(compute_overlaps_south): overlapList for send is expanded')
            call expand_update_overlap_list(overlaplist, nlist)
         endif
         call add_update_overlap(overlaplist(nsend), overlap)
         call init_overlap_type(overlap)
       endif
    end do  ! end of send set up.
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do m =1,nsend
          write(iunit, *) "********to_pe = " ,overlaplist(m)%pe, " count = ",overlaplist(m)%count
          do n = 1, overlaplist(m)%count
             write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
                  overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
          enddo
       enddo
       if( nsend > 0) flush(iunit)
    endif
 
    ! copy the overlapping information into domain data structure
    if(nsend>0) then
      if (associated(update%send)) deallocate(update%send) !< Check if associated
       allocate(update%send(nsend))
       update%nsend = nsend
       do m = 1, nsend
          call add_update_overlap( update%send(m), overlaplist(m) )
       enddo
    endif
 
    if(nsend_check>0) then
      if (associated(check%send)) deallocate(check%send) !< Check if associated
       allocate(check%send(nsend_check))
       check%nsend = nsend_check
       do m = 1, nsend_check
          call add_check_overlap( check%send(m), checklist(m) )
       enddo
    endif
 
    do m = 1,size(overlaplist(:))
       call deallocate_overlap_type(overlaplist(m))
    enddo
 
    if(debug_update_level .NE. no_check) then
       do m = 1,size(checklist(:))
          call deallocate_overlap_type(checklist(m))
       enddo
    endif
 
    isgd = isg - domain%whalo
    iegd = ieg + domain%ehalo
    jsgd = jsg - domain%shalo
    jegd = jeg + domain%nhalo
 
    ! begin setting up recv
    nrecv = 0
    nrecv_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+nlist-list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
          jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
          !recv_e
          dir = 1
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( (position == north .OR. position == corner ) .AND. ( jsd == je .or. jed == js ) ) then
             ! --- do nothing, this point will come from other pe
          else
             if( ied.GT.ieg .AND. ie.LT.isd )then !cyclic offset
                is = is+ioff; ie = ie+ioff
             end if
 
             !--- when the south face is folded, the east halo point at right side domain will be folded.
             !--- the position should be on CORNER or NORTH
             if( jsd == jsg .AND. (position == corner .OR. position == north) &
                  .AND. isd .GE. middle .AND. ied .LE. ieg ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd+1, jed, dir)
                is=isc; ie=iec; js=jsc; je=jec
                jed = jsd
                select case (position)
                case(north)
                   i=is; is = isg+ieg-ie; ie = isg+ieg-i
                case(corner)
                   i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                end select
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
             end if
          end if
 
          !recv_se
          dir = 2
          folded = .false.
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( jsd.LT.jsg )then
             folded = .true.
             call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
          end if
          if( ied.GT.ieg .AND. ie.LT.isd )then !cyclic offset
             is = is+ioff; ie = ie+ioff
          endif
          call insert_update_overlap(overlap, domain%list(m)%pe, &
                                     is, ie, js, je, isd, ied, jsd, jed, dir, folded)
 
          !recv_s
          dir = 3
          folded = .false.
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( jsd.LT.jsg )then
             folded = .true.
             call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
          end if
          if( (position == east .OR. position == corner ) .AND. (isd == ie .or. ied == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, je, isd, ied, jsd, jed, dir, folded, symmetry=domain%symmetry)
          end if
          !--- when south edge is folded, is will be less than isg when position is EAST and CORNER
          if(is .LT. isg ) then
             is = is + ioff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, is, js, je, isd, ied, jsd, jed, dir, folded)
          endif
 
          !recv_sw
          dir = 4
          folded = .false.
          isd = domain%x(tme)%domain_data%begin; ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%domain_data%begin; jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( jsd.LT.jsg )then
             folded = .true.
             call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
          end if
          if( isd.LT.isg .AND. is.GT.ied ) then ! cyclic offset
             is = is-ioff; ie = ie-ioff
          end if
          call insert_update_overlap(overlap, domain%list(m)%pe, &
                                     is, ie, js, je, isd, ied, jsd, jed, dir, folded)
          !--- when southth edge is folded, is will be less than isg when position is EAST and CORNER
          if(is .LT. isg ) then
             is = is + ioff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, is, js, je, isd, ied, jsd, jed, dir, folded )
          endif
 
          !recv_w
          dir = 5
          isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( (position == north .OR. position == corner ) .AND. ( jsd == je .or. jed == js ) ) then
             ! --- do nothing, this point will come from other pe
          else
             if( isd.LT.isg .AND. is.GT.ied )then ! cyclic offset
                is = is-ioff; ie = ie-ioff
             end if
             !--- when the south face is folded, some point at j=nj will be folded.
             !--- the position should be on CORNER or NORTH
             if( jsd == jsg .AND. (position == corner .OR. position == north) &
                  .AND. ( isd < isg  .OR. ied .GE. middle ) )  then
                call insert_update_overlap(overlap, domain%list(m)%pe, &
                                           is, ie, js, je, isd, ied, jsd+1, jed, dir)
                is=isc; ie=iec; js=jsc; je=jec
                if(isd < isg) then
                   select case (position)
                   case(north)
                      i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
                   case(corner)
                      ied = ied -1 + ishift
                      i=is; is = 2*isg-ie-2+2*ishift; ie = 2*isg-i-2+2*ishift
                   end select
                   if(ie .GT. domain%x(tme)%compute%end+ishift) call mpp_error( fatal, &
                        'mpp_domains_define.inc(compute_overlaps): west edge ubound error recv.' )
                else
                   select case (position)
                   case(north)
                      i=is; is = isg+ieg-ie; ie = isg+ieg-i
                   case(corner)
                      i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                   end select
                end if
                call insert_update_overlap(overlap, domain%list(m)%pe, &
                                           is, ie, js, je, isd, ied, jsd, jsd, dir, .true.)
             else
                call insert_update_overlap(overlap, domain%list(m)%pe, &
                                           is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !recv_nw
          dir = 6
          isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( isd.LT.isg .AND. is.GE.ied )then !cyclic offset
             is = is-ioff; ie = ie-ioff
          endif
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !recv_n
          dir = 7
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
          !recv_ne
          dir = 8
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if(  ied.GT.ieg .AND. ie.LT.isd )then ! cyclic offset
             is = is+ioff; ie = ie+ioff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !--- Now calculate the overlapping for fold-edge.
          !--- for folded-south-edge, only need to consider to_pe's south(3) direction
          !--- only position at NORTH and CORNER need to be considered
          if( ( position == north .OR. position == corner) ) then
            !fold is within domain
             if( domain%y(tme)%domain_data%begin .LE. jsg .AND. jsg .LE. domain%y(tme)%domain_data%end+jshift )then
                dir = 3
                !--- calculating overlapping for receving on north
                if( domain%x(tme)%pos .GE. size(domain%x(tme)%list(:))/2 )then
                   jsd = domain%y(tme)%compute%begin;   jed = jsd
                   if( jsd == jsg )then   ! fold is within domain.
                      isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
                      is=isc; ie=iec; js = jsc; je = jec
                      select case (position)
                      case(north)
                         isd = max(isd, middle)
                         i=is; is = isg+ieg-ie; ie = isg+ieg-i
                      case(corner)
                         isd = max(isd, middle)
                         i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
                      end select
                      call insert_update_overlap(overlap, domain%list(m)%pe, &
                                                 is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
                      is = max(is, isd); ie = min(ie, ied)
                      js = max(js, jsd); je = min(je, jed)
                      if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )then
                         nrecv_check = nrecv_check+1
                         call allocate_check_overlap(checklist(nrecv_check), 1)
                         call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
                                                   tme, 2, one_hundred_eighty, is, ie, js, je)
                      endif
                   endif
                endif
             endif
          endif
       endif
       !--- copy the overlapping information
       if( overlap%count > 0) then
          nrecv = nrecv + 1
          if(nrecv > size(overlaplist(:)) )then
            call mpp_error(note, 'mpp_domains_define.inc(compute_overlaps_south): overlapList for recv is expanded')
            call expand_update_overlap_list(overlaplist, nlist)
          endif
          call add_update_overlap( overlaplist(nrecv), overlap)
          call init_overlap_type(overlap)
       endif
    enddo ! end of recv do loop
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do m =1,nrecv
          write(iunit, *) "********from_pe = " ,overlaplist(m)%pe, " count = ",overlaplist(m)%count
          do n = 1, overlaplist(m)%count
             write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
                  overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
          enddo
       enddo
       if(nrecv >0) flush(iunit)
    endif
 
    ! copy the overlapping information into domain
    if(nrecv>0) then
       update%nrecv = nrecv
       if (associated(update%recv)) deallocate(update%recv) !< Check if associated
       allocate(update%recv(nrecv))
       do m = 1, nrecv
          call add_update_overlap( update%recv(m), overlaplist(m) )
          do n = 1, update%recv(m)%count
             if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) then
                if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
                if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
             endif
          enddo
       enddo
    endif
 
    if(nrecv_check>0) then
       check%nrecv = nrecv_check
       if (associated(check%recv)) deallocate(check%recv) !< Check if associated
       allocate(check%recv(nrecv_check))
       do m = 1, nrecv_check
          call add_check_overlap( check%recv(m), checklist(m) )
       enddo
    endif
 
    call deallocate_overlap_type(overlap)
 
    do m = 1,size(overlaplist(:))
       call deallocate_overlap_type(overlaplist(m))
    enddo
 
    if(debug_update_level .NE. no_check) then
       do m = 1,size(checklist(:))
          call deallocate_overlap_type(checklist(m))
       enddo
    endif
 
    deallocate(overlaplist)
    deallocate(checklist)
    update => null()
    check=>null()
    domain%initialized = .true.
 
  end subroutine compute_overlaps_fold_south
 
  !####################################################################################
  !> Computes remote domain overlaps
  !! assumes only one in each direction
  !! will calculate the overlapping for T,E,C,N-cell separately.
  subroutine compute_overlaps_fold_west( domain, position, ishift, jshift)
    type(domain2d), intent(inout) :: domain
    integer, intent(in)           :: position, ishift, jshift
 
    integer                          :: j, m, n, nlist, tMe, tNbr, dir
    integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd, jed
    integer                          :: isg, ieg, jsg, jeg, ioff, joff
    integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
    integer                          :: ism, iem, jsm, jem, whalo, ehalo, shalo, nhalo
    logical                          :: folded
    type(overlap_type)               :: overlap
    type(overlapspec),   pointer     :: update=>null()
    type(overlap_type)               :: overlapList(MAXLIST)
    type(overlap_type)               :: checkList(MAXLIST)
    type(overlapspec),   pointer     :: check =>null()
    integer                          :: nsend, nrecv
    integer                          :: nsend_check, nrecv_check
    integer                          :: iunit
 
    !--- since we restrict that if multiple tiles on one pe, all the tiles are limited to this pe.
    !--- In this case, if ntiles on this pe is greater than 1, no overlapping between processor within each tile
    !--- In this case the overlapping exist only for tMe=1 and tNbr=1
    if(size(domain%x(:)) > 1) return
 
    !--- if there is no halo, no need to compute overlaps.
    if(domain%whalo==0 .AND. domain%ehalo==0 .AND. domain%shalo==0 .AND. domain%nhalo==0) return
 
    !--- when there is only one tile, n will equal to np
    nlist = size(domain%list(:))
 
    select case(position)
    case (center)
       update => domain%update_T
       check  => null()
    case (corner)
       update => domain%update_C
       check  => domain%check_C
    case (east)
       update => domain%update_E
       check  => domain%check_E
    case (north)
       update => domain%update_N
       check  => domain%check_N
    case default
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_west):"//&
                           & " the value of position should be CENTER, EAST, CORNER or NORTH")
    end select
 
    !--- overlap is used to store the overlapping temporarily.
    call allocate_update_overlap( overlap, maxoverlap)
 
    !send
    call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position )
    call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position ) !cyclic offsets
    call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
    update%xbegin = ism; update%xend = iem
    update%ybegin = jsm; update%yend = jem
    if(ASSOCIATED(check)) then
       check%xbegin  = ism; check%xend  = iem
       check%ybegin  = jsm; check%yend  = jem
    endif
    update%whalo  = domain%whalo; update%ehalo = domain%ehalo
    update%shalo  = domain%shalo; update%nhalo = domain%nhalo
    whalo         = domain%whalo; ehalo        = domain%ehalo
    shalo         = domain%shalo; nhalo        = domain%nhalo
 
    ioff = ni - ishift
    joff = nj - jshift
    middle = (jsg+jeg)/2+1
    tme = 1; tnbr = 1
 
    if(.NOT. btest(domain%fold,west)) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_west): "//&
            "boundary condition in y-direction should be folded-west for "//trim(domain%name))
    endif
    if(.NOT. domain%y(tme)%cyclic) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_west): "//&
            "boundary condition in y-direction should be cyclic for "//trim(domain%name))
    endif
 
    if(.not. domain%symmetry) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_west): "//&
            "when west boundary is folded, the domain must be symmetry for "//trim(domain%name))
    endif
 
    nsend = 0
    nsend_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          !to_pe's eastern halo
          dir = 1
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
          !to_pe's SE halo
          dir = 2
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
          if( js.LT.jsg .AND. jsc.GT.je )then ! cyclic is assumed
             js = js+joff; je = je+joff
          end if
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                       is, ie, js, je, isc, iec, jsc, jec, dir)
 
          !to_pe's southern halo
          dir = 3
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          !--- to make sure the consistence between pes
          if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( js.LT.jsg .AND. jsc.GT.je) then ! cyclic offset
                js = js+joff; je = je+joff
             endif
 
             !--- when the west face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( is == isg .AND. (position == corner .OR. position == east) &
                  .AND. ( domain%list(m)%y(tnbr)%compute%begin == jsg .OR. &
                  & domain%list(m)%y(tnbr)%compute%begin-1 .GE. middle)) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is+1, ie, js, je, isc, iec, jsc, jec, dir)
                is = domain%list(m)%x(tnbr)%compute%begin; ie = is
                js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
                if ( domain%list(m)%y(tnbr)%compute%begin == jsg ) then
                   select case (position)
                   case(east)
                      j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
                   case(corner)
                      j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
                   end select
                   if(je .GT. domain%y(tme)%compute%end+jshift) call mpp_error( fatal, &
                        'mpp_domains_define.inc(compute_overlaps_fold_west: south edge ubound error send.' )
                else
                   select case (position)
                   case(east)
                      j=js; js = jsg+jeg-je; je = jsg+jeg-j
                   case(corner)
                      j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                   end select
                end if
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !to_pe's SW halo
          dir = 4
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          if( jsg.GT.js .AND. je.LT.jsc )then !cyclic offset
             js = js+joff; je = je+joff
          end if
          if( is.LT.isg )then
             folded = .true.
             call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, folded)
          !--- when south edge is folded, js will be less than jsg when position is EAST and CORNER
          if(js .LT. jsg) then
             js = js + joff
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, js, isc, iec, jsc, jec, dir, folded)
          endif
 
          !to_pe's western halo
          dir = 5
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
          if( isg.GT.is )then
             folded = .true.
             call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
          end if
          !--- when domain symmetry and position is EAST or CORNER, the point when isc == ie,
          !--- no need to send, because the data on that point will come from other pe.
          !--- come from two pe ( there will be only one point on one pe. ).
          if( (position == east .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, je, isc, iec, jsc, jec, dir, folded, symmetry=domain%symmetry)
          endif
          !--- when south edge is folded, ie will be less than isg when position is EAST and CORNER
          if(js .LT. jsg) then
             js = js + ioff
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, js, isc, iec, jsc, jec, dir, folded)
          endif
 
          !to_pe's NW halo
          dir = 6
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          if( je.GT.jeg .AND. jec.LT.js )then ! cyclic offset
             js = js-joff; je = je-joff
          end if
          if( is.LT.isg )then
             folded = .true.
             call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
          end if
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
          !to_pe's northern halo
          dir = 7
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          !--- to make sure the consistence between pes
          if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( je.GT.jeg .AND. jec.LT.js) then ! cyclic offset
                js = js-joff; je = je-joff
             endif
             !--- when the west face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( is == isg .AND. (position == corner .OR. position == east) &
                  .AND. ( js .GE. middle .AND. domain%list(m)%y(tnbr)%compute%end+nhalo+jshift .LE. jeg ) ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is+1, ie, js, je, isc, iec, jsc, jec, dir)
                is = domain%list(m)%x(tnbr)%compute%begin; ie = is
                js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
                select case (position)
                case(east)
                   j=js; js = jsg+jeg-je; je = jsg+jeg-j
                case(corner)
                   j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                end select
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !to_pe's NE halo
          dir = 8
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          if( je.GT.jeg .AND. jec.LT.js )then !cyclic offset
             js = js-joff; je = je-joff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir)
 
          !--- Now calculate the overlapping for fold-edge.
          !--- only position at EAST and CORNER need to be considered
          if( ( position == east .OR. position == corner) ) then
            !fold is within domain
             if( domain%x(tme)%compute%begin-whalo .LE. isg .AND. isg .LE. domain%x(tme)%domain_data%end+ishift )then
                dir = 5
                !--- calculate the overlapping for sending
                if( domain%y(tme)%pos .LT. (size(domain%y(tme)%list(:))+1)/2 )then
                   is = domain%list(m)%x(tnbr)%compute%begin;   ie = is
                   if( is == isg )then   ! fold is within domain.
                      js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
                      select case (position)
                      case(east)
                         js = max(js, middle)
                         j=js; js = jsg+jeg-je; je = jsg+jeg-j
                      case(corner)
                         js = max(js, middle)
                         j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                      end select
                      call insert_update_overlap(overlap, domain%list(m)%pe, &
                                                 is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
                      is = max(is, isc); ie = min(ie, iec)
                      js = max(js, jsc); je = min(je, jec)
                      if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )then
                         nsend_check = nsend_check+1
                         call allocate_check_overlap(checklist(nsend_check), 1)
                         call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
                                                   tme, 3, one_hundred_eighty, is, ie, js, je)
                      end if
                   end if
                end if
             end if
          end if
       end if
       !--- copy the overlapping information
       if( overlap%count > 0) then
         nsend = nsend + 1
         if(nsend > maxlist) call mpp_error(fatal,  &
             "mpp_domains_define.inc(compute_overlaps_west): nsend is greater than MAXLIST, increase MAXLIST")
         call add_update_overlap(overlaplist(nsend), overlap)
         call init_overlap_type(overlap)
       endif
    end do  ! end of send set up.
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do m =1,nsend
          write(iunit, *) "********to_pe = " ,overlaplist(m)%pe, " count = ",overlaplist(m)%count
          do n = 1, overlaplist(m)%count
             write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
                  overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
          enddo
       enddo
       if(nsend >0) flush(iunit)
    endif
 
   ! copy the overlapping information into domain data structure
    if(nsend>0) then
       update%nsend = nsend
       if (associated(update%send)) deallocate(update%send) !< Check if associated
       allocate(update%send(nsend))
       do m = 1, nsend
          call add_update_overlap( update%send(m), overlaplist(m) )
       enddo
    endif
 
    if(nsend_check>0) then
       check%nsend = nsend_check
       if (associated(check%send)) deallocate(check%send) !< Check if associated
       allocate(check%send(nsend_check))
       do m = 1, nsend_check
          call add_check_overlap( check%send(m), checklist(m) )
       enddo
    endif
 
    do m = 1, maxlist
       call deallocate_overlap_type(overlaplist(m))
       if(debug_update_level .NE. no_check) call deallocate_overlap_type(checklist(m))
    enddo
 
    isgd = isg - domain%whalo
    iegd = ieg + domain%ehalo
    jsgd = jsg - domain%shalo
    jegd = jeg + domain%nhalo
 
    ! begin setting up recv
    nrecv = 0
    nrecv_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+nlist-list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
          jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
          !recv_e
          dir = 1
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
          !recv_se
          dir = 2
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( jsd.LT.jsg .AND. js.GE.jed )then ! cyclic is assumed
             js = js-joff; je = je-joff
          end if
          call insert_update_overlap(overlap, domain%list(m)%pe, &
                                     is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !recv_s
          dir = 3
          folded = .false.
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
 
          if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( jsd.LT.jsg .AND. js .GT. jed)then
                js = js-joff; je = je-joff
             end if
             !--- when the west face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( isd == isg .AND. (position == corner .OR. position == east) &
                  .AND. ( jsd < jsg .OR. jed .GE. middle ) ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd+1, ied, jsd, jed, dir)
                is=isc; ie=iec; js=jsc; je=jec
                if(jsd<jsg) then
                   select case (position)
                   case(east)
                      j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
                   case(corner)
                      j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
                   end select
                   if(je .GT. domain%y(tme)%compute%end+jshift) call mpp_error( fatal, &
                        'mpp_domains_define.inc(compute_overlaps_fold_west: south edge ubound error recv.' )
                else
                   select case (position)
                   case(east)
                      j=js; js = jsg+jeg-je; je = jsg+jeg-j
                   case(corner)
                      j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                   end select
                end if
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, isd, jsd, jed, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !recv_sw
          dir = 4
          folded = .false.
          isd = domain%x(tme)%domain_data%begin; ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%domain_data%begin; jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( isd.LT.isg )then
             folded = .true.
             call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
          end if
          if( jsd.LT.jsg .AND. js.GT.jed ) then ! cyclic offset
             js = js-joff; je = je-joff
          end if
          call insert_update_overlap(overlap, domain%list(m)%pe, &
                                     is, ie, js, je, isd, ied, jsd, jed, dir, folded)
          !--- when west edge is folded, js will be less than jsg when position is EAST and CORNER
          if(js .LT. jsg ) then
             js = js + joff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, js, isd, ied, jsd, jed, dir, folded )
          endif
 
          !recv_w
          dir = 5
          folded = .false.
          isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( isd.LT.isg )then
             folded = .true.
             call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
          end if
          if( (position == east .OR. position == corner ) .AND. (jsd == je .or. jed == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, je, isd, ied, jsd, jed, dir, folded, symmetry=domain%symmetry)
          end if
          !--- when west edge is folded, js will be less than jsg when position is EAST and CORNER
          if(js .LT. jsg ) then
             js = js + joff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, js, isd, ied, jsd, jed, dir, folded)
          endif
 
          !recv_nw
          dir = 6
          folded = .false.
          isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( isd.LT.isg) then
             folded = .true.
             call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
          end if
          if( jed.GT.jeg .AND. je.LT.jsd )then !cyclic offset
             js = js+joff; je = je+joff
          endif
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !recv_n
          dir = 7
          folded = .false.
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( jed.GT.jeg .AND. je.LT.jsd)then
                js = js+joff; je = je+joff
             end if
             !--- when the west face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( isd == isg .AND. (position == corner .OR. position == east) &
                  .AND. jsd .GE. middle .AND. jed .LE. jeg ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd+1, ied, jsd, jed, dir)
                is=isc; ie=iec; js=jsc; je=jec
                select case (position)
                case(east)
                   j=js; js = jsg+jeg-je; je = jsg+jeg-j
                case(corner)
                   j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                end select
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, isd, jsd, jed, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !recv_ne
          dir = 8
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if(  jed.GT.jeg .AND. je.LT.jsd )then ! cyclic offset
             js = js+joff; je = je+joff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !--- Now calculate the overlapping for fold-edge.
          !--- for folded-south-edge, only need to consider to_pe's south(3) direction
          !--- only position at EAST and CORNER need to be considered
          if( ( position == east .OR. position == corner) ) then
            !fold is within domain
             if( domain%x(tme)%domain_data%begin .LE. isg .AND. isg .LE. domain%x(tme)%domain_data%end+ishift )then
                dir = 5
                !--- calculating overlapping for receving on north
                if( domain%y(tme)%pos .GE. size(domain%y(tme)%list(:))/2 )then
                   isd = domain%x(tme)%compute%begin;   ied = isd
                   if( isd == isg )then   ! fold is within domain.
                      jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
                      is=isc; ie=iec; js = jsc; je = jec
                      select case (position)
                      case(east)
                         jsd = max(jsd, middle)
                         j=js; js = jsg+jeg-je; je = jsg+jeg-j
                      case(corner)
                         jsd = max(jsd, middle)
                         j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                      end select
                      call insert_update_overlap(overlap, domain%list(m)%pe, &
                                                 is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
                      is = max(is, isd); ie = min(ie, ied)
                      js = max(js, jsd); je = min(je, jed)
                      if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )then
                         nrecv_check = nrecv_check+1
                         call allocate_check_overlap(checklist(nrecv_check), 1)
                         call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
                                                   tme, 3, one_hundred_eighty, is, ie, js, je)
                      endif
                   endif
                endif
             endif
          endif
       endif
       !--- copy the overlapping information
       if( overlap%count > 0) then
          nrecv = nrecv + 1
         if(nrecv > maxlist) call mpp_error(fatal,  &
             "mpp_domains_define.inc(compute_overlaps_west): nrecv is greater than MAXLIST, increase MAXLIST")
          call add_update_overlap( overlaplist(nrecv), overlap)
          call init_overlap_type(overlap)
       endif
    enddo ! end of recv do loop
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do m =1,nrecv
          write(iunit, *) "********from_pe = " ,overlaplist(m)%pe, " count = ",overlaplist(m)%count
          do n = 1, overlaplist(m)%count
             write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
                  overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
          enddo
       enddo
       if(nrecv >0) flush(iunit)
    endif
 
    ! copy the overlapping information into domain
    if(nrecv>0) then
       update%nrecv = nrecv
       if (associated(update%recv)) deallocate(update%recv) !< Check if associated
       allocate(update%recv(nrecv))
       do m = 1, nrecv
          call add_update_overlap( update%recv(m), overlaplist(m) )
          do n = 1, update%recv(m)%count
             if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) then
                if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
                if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
             endif
          enddo
       enddo
    endif
 
    if(nrecv_check>0) then
       check%nrecv = nrecv_check
       if (associated(check%recv)) deallocate(check%recv) !< Check if associated
       allocate(check%recv(nrecv_check))
       do m = 1, nrecv_check
          call add_check_overlap( check%recv(m), checklist(m) )
       enddo
    endif
 
    call deallocate_overlap_type(overlap)
    do m = 1, maxlist
       call deallocate_overlap_type(overlaplist(m))
       if(debug_update_level .NE. no_check) call deallocate_overlap_type(checklist(m))
    enddo
 
    update=>null()
    check=>null()
    domain%initialized = .true.
 
  end subroutine compute_overlaps_fold_west
 
  !###############################################################################
  !> computes remote domain overlaps
  !! assumes only one in each direction
  !! will calculate the overlapping for T,E,C,N-cell separately.
  !! here assume fold-east and y-cyclic boundary condition
  subroutine compute_overlaps_fold_east( domain, position, ishift, jshift )
    type(domain2d), intent(inout) :: domain
    integer, intent(in)           :: position, ishift, jshift
 
    integer                          :: j, m, n, nlist, tMe, tNbr, dir
    integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd
    integer                          :: jed, isg, ieg, jsg, jeg, ioff, joff
    integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
    integer                          :: ism, iem, jsm, jem, whalo, ehalo, shalo, nhalo
    logical                          :: folded
    type(overlap_type)               :: overlap
    type(overlapspec),   pointer     :: update=>null()
    type(overlap_type)               :: overlapList(MAXLIST)
    type(overlap_type)               :: checkList(MAXLIST)
    type(overlapspec),   pointer     :: check =>null()
    integer                          :: nsend, nrecv
    integer                          :: nsend_check, nrecv_check
 
    !--- since we restrict that if multiple tiles on one pe, all the tiles are limited to this pe.
    !--- In this case, if ntiles on this pe is greater than 1, no overlapping between processor within each tile
    !--- In this case the overlapping exist only for tMe=1 and tNbr=1
    if(size(domain%x(:)) > 1) return
 
    !--- if there is no halo, no need to compute overlaps.
    if(domain%whalo==0 .AND. domain%ehalo==0 .AND. domain%shalo==0 .AND. domain%nhalo==0) return
 
    !--- when there is only one tile, n will equal to np
    nlist = size(domain%list(:))
 
    select case(position)
    case (center)
       update => domain%update_T
    case (corner)
       update => domain%update_C
       check  => domain%check_C
    case (east)
       update => domain%update_E
       check  => domain%check_E
    case (north)
       update => domain%update_N
       check  => domain%check_N
    case default
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_east):"// &
                           & " the value of position should be CENTER, EAST, CORNER or NORTH")
    end select
 
    !--- overlap is used to store the overlapping temporarily.
    call allocate_update_overlap( overlap, maxoverlap)
 
    !send
    call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position )
    call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position ) !cyclic offsets
    call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
    update%xbegin = ism; update%xend = iem
    update%ybegin = jsm; update%yend = jem
    if(ASSOCIATED(check)) then
       check%xbegin  = ism; check%xend  = iem
       check%ybegin  = jsm; check%yend  = jem
    endif
    update%whalo  = domain%whalo; update%ehalo = domain%ehalo
    update%shalo  = domain%shalo; update%nhalo = domain%nhalo
    whalo         = domain%whalo; ehalo        = domain%ehalo
    shalo         = domain%shalo; nhalo        = domain%nhalo
 
    ioff = ni - ishift
    joff = nj - jshift
    middle = (jsg+jeg)/2+1
    tme = 1; tnbr = 1
 
    if(.NOT. btest(domain%fold,east)) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_east): "//&
            "boundary condition in y-direction should be folded-east for "//trim(domain%name))
    endif
    if(.NOT. domain%y(tme)%cyclic) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_east): "//&
            "boundary condition in y-direction should be cyclic for "//trim(domain%name))
    endif
    if(.not. domain%symmetry) then
       call mpp_error(fatal, "mpp_domains_define.inc(compute_overlaps_fold_east): "//&
            "when east boundary is folded, the domain must be symmetry for "//trim(domain%name))
    endif
 
    nsend = 0
    nsend_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          !to_pe's eastern halo
          dir = 1
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
          if( ie.GT.ieg )then
             folded = .true.
             call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
          end if
          !--- when domain symmetry and position is EAST or CORNER, the point when jsc == je,
          !--- no need to send, because the data on that point will come from other pe.
          !--- come from two pe ( there will be only one point on one pe. ).
          if( (position == east .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, je, isc, iec, jsc, jec, dir, folded, symmetry=domain%symmetry)
          endif
          !--- when east edge is folded, js .LT. jsg
          if(js .LT. jsg) then
             js = js + ioff
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, js, isc, iec, jsc, jec, dir, folded)
          endif
 
          !to_pe's SE halo
          dir = 2
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
          if( jsg.GT.js .AND. je.LT.jsc )then !try cyclic offset
             js = js+joff; je = je+joff
          end if
 
          if( ie.GT.ieg )then
             folded = .true.
             call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
          end if
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, folded)
          !--- when east edge is folded,
          if(js .LT. jsg) then
             js = js + joff
             call insert_update_overlap( overlap, domain%list(m)%pe, &
                                         is, ie, js, js, isc, iec, jsc, jec, dir, folded)
          endif
 
          !to_pe's southern halo
          dir = 3
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          !--- to make sure the consistence between pes
          if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( js.LT.jsg .AND. jsc.GT.je) then ! cyclic offset
                js = js+joff; je = je+joff
             endif
             !--- when the east face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( ie == ieg .AND. (position == corner .OR. position == east) &
                  .AND. ( domain%list(m)%y(tnbr)%compute%begin == jsg .OR. &
                        domain%list(m)%y(tnbr)%compute%begin-1 .GE. middle  ) ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie-1, js, je, isc, iec, jsc, jec, dir)
                !--- consider at i = ieg for east edge.
                !--- when the data is at corner and not symmetry, j = jsg -1 will get from cyclic condition
                if(position == corner .AND. .NOT. domain%symmetry .AND. domain%list(m)%y(tnbr)%compute%begin==jsg)then
                   call insert_update_overlap(overlap, domain%list(m)%pe, &
                                              ie, ie, je, je, isc, iec, jsc, jec, dir, .true.)
                end if
 
                ie = domain%list(m)%x(tnbr)%compute%end+ishift; is = ie
                js = domain%list(m)%y(tnbr)%compute%begin-shalo;  je = domain%list(m)%y(tnbr)%compute%begin-1
                if ( domain%list(m)%y(tnbr)%compute%begin == jsg ) then
                   select case (position)
                   case(east)
                      j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
                   case(corner)
                      j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
                   end select
                   if(je .GT. domain%y(tme)%compute%end+jshift) call mpp_error( fatal, &
                        'mpp_domains_define.inc(compute_overlaps_fold_east: south edge ubound error send.' )
                else
                   select case (position)
                   case(east)
                      j=js; js = jsg+jeg-je; je = jsg+jeg-j
                   case(corner)
                      j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                   end select
                end if
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !to_pe's SW halo
          dir = 4
          is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
          if( js.LT.jsg .AND. jsc.GT.je )then ! cyclic is assumed
             js = js+joff; je = je+joff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir)
 
          !to_pe's western halo
          dir = 5
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
          !to_pe's NW halo
          dir = 6
          is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          if( je.GT.jeg .AND. jec.LT.js )then !cyclic offset
             js = js-joff; je = je-joff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir)
 
          !to_pe's northern halo
          dir = 7
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          !--- to make sure the consistence between pes
          if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( je.GT.jeg .AND. jec.LT.js) then ! cyclic offset
                js = js-joff; je = je-joff
             endif
             !--- when the east face is folded, the north halo points at
             !--- the position should be on CORNER or EAST
             if( ie == ieg .AND. (position == corner .OR. position == east) &
                  .AND. ( js .GE. middle .AND. domain%list(m)%y(tnbr)%compute%end+nhalo+jshift .LE. jeg ) ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie-1, js, je, isc, iec, jsc, jec, dir)
                ie = domain%list(m)%x(tnbr)%compute%end+ishift; is = ie
                js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
                select case (position)
                case(east)
                   j=js; js = jsg+jeg-je; je = jsg+jeg-j
                case(corner)
                   j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                end select
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !to_pe's NE halo
          dir = 8
          folded = .false.
          is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
          js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
          if( je.GT.jeg .AND. jec.LT.js )then ! cyclic offset
             js = js-joff; je = je-joff
          end if
          if( ie.GT.ieg )then
             folded = .true.
             call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
          end if
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
          !--- Now calculate the overlapping for fold-edge.
          !--- only position at EAST and CORNER need to be considered
          if( ( position == east .OR. position == corner) ) then
            !fold is within domain
             if( domain%x(tme)%domain_data%begin .LE. ieg .AND. ieg .LE. domain%x(tme)%domain_data%end+ishift )then
                dir = 1
                !--- calculate the overlapping for sending
                if( domain%y(tme)%pos .LT. (size(domain%y(tme)%list(:))+1)/2 )then
                   ie = domain%list(m)%x(tnbr)%compute%end+ishift;   is = ie
                   if( ie == ieg )then   ! fold is within domain.
                      js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
                      select case (position)
                      case(east)
                         js = max(js, middle)
                         j=js; js = jsg+jeg-je; je = jsg+jeg-j
                      case(corner)
                         js = max(js, middle)
                         j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                      end select
                      call insert_update_overlap(overlap, domain%list(m)%pe, &
                                                 is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
                      is = max(is, isc); ie = min(ie, iec)
                      js = max(js, jsc); je = min(je, jec)
                      if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )then
                         nsend_check = nsend_check+1
                         call allocate_check_overlap(checklist(nsend_check), 1)
                         call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
                                                   tme, 1, one_hundred_eighty, is, ie, js, je)
                      end if
                   end if
                end if
             end if
          end if
       end if
       !--- copy the overlapping information
       if( overlap%count > 0) then
         nsend = nsend + 1
         if(nsend > maxlist) call mpp_error(fatal,  &
             "mpp_domains_define.inc(compute_overlaps_east): nsend is greater than MAXLIST, increase MAXLIST")
         call add_update_overlap(overlaplist(nsend), overlap)
         call init_overlap_type(overlap)
       endif
    end do  ! end of send set up.
 
    ! copy the overlapping information into domain data structure
    if(nsend>0) then
       update%nsend = nsend
       if (associated(update%send)) deallocate(update%send) !< Check if associated
       allocate(update%send(nsend))
       do m = 1, nsend
          call add_update_overlap( update%send(m), overlaplist(m) )
       enddo
    endif
 
   if(nsend_check>0) then
       check%nsend = nsend_check
       if (associated(check%send)) deallocate(check%send) !< Check if associated
       allocate(check%send(nsend_check))
       do m = 1, nsend_check
          call add_check_overlap( check%send(m), checklist(m) )
       enddo
    endif
 
    do m = 1, maxlist
       call deallocate_overlap_type(overlaplist(m))
       if(debug_update_level .NE. no_check) call deallocate_overlap_type(checklist(m))
    enddo
 
    isgd = isg - domain%whalo
    iegd = ieg + domain%ehalo
    jsgd = jsg - domain%shalo
    jegd = jeg + domain%nhalo
 
    ! begin setting up recv
    nrecv = 0
    nrecv_check = 0
    do list = 0,nlist-1
       m = mod( domain%pos+nlist-list, nlist )
       if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) then  ! only compute the overlapping within tile.
          isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
          jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
          !recv_e
          dir = 1
          folded = .false.
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( ied.GT.ieg )then
             folded = .true.
             call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
          end if
          if( (position == east .OR. position == corner ) .AND. (jsd == je .or. jed == js ) ) then
             !--- do nothing, this point will come from other pe
          else
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, je, isd, ied, jsd, jed, dir, folded, symmetry=domain%symmetry)
          end if
          !--- when west edge is folded, js will be less than jsg when position is EAST and CORNER
          if(js .LT. jsg ) then
             js = js + joff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, js, isd, ied, jsd, jed, dir, folded)
          endif
 
          !recv_se
          dir = 2
          folded = .false.
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( ied.GT.ieg )then
             folded = .true.
             call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
          end if
          if( jsd.LT.jsg .AND. js.GT.jed ) then ! cyclic offset
             js = js-joff; je = je-joff
          end if
          call insert_update_overlap(overlap, domain%list(m)%pe, &
                                     is, ie, js, je, isd, ied, jsd, jed, dir, folded)
          !--- when west edge is folded, js will be less than jsg when position is EAST and CORNER
          if(js .LT. jsg ) then
             js = js + joff
             call insert_update_overlap(overlap, domain%list(m)%pe, &
                                        is, ie, js, js, isd, ied, jsd, jed, dir, folded )
          endif
 
          !recv_s
          dir = 3
          folded = .false.
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
 
          if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( jsd.LT.jsg .AND. js .GT. jed)then
                js = js-joff; je = je-joff
             end if
             !--- when the east face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( ied == ieg .AND. (position == corner .OR. position == east) &
                  .AND. ( jsd < jsg .OR. jed .GE. middle ) ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied-1, jsd, jed, dir)
                is=isc; ie=iec; js=jsc; je=jec
                if(jsd<jsg) then
                   select case (position)
                   case(east)
                      j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
                   case(corner)
                      j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
                   end select
                   if(je .GT. domain%y(tme)%compute%end+jshift) call mpp_error( fatal, &
                        'mpp_domains_define.inc(compute_overlaps_fold_west: south edge ubound error recv.' )
                else
                   select case (position)
                   case(east)
                      j=js; js = jsg+jeg-je; je = jsg+jeg-j
                   case(corner)
                      j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                   end select
                end if
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, ied, ied, jsd, jed, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !recv_sw
          dir = 4
          isd = domain%x(tme)%domain_data%begin; ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%domain_data%begin; jed = domain%y(tme)%compute%begin-1
          is=isc; ie=iec; js=jsc; je=jec
          if( jsd.LT.jsg .AND. js.GE.jed )then ! cyclic is assumed
             js = js-joff; je = je-joff
          end if
          call insert_update_overlap(overlap, domain%list(m)%pe, &
                                     is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !recv_w
          dir = 5
          isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
          !recv_nw
          dir = 6
          folded = .false.
          isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if(  jed.GT.jeg .AND. je.LT.jsd )then ! cyclic offset
             js = js+joff; je = je+joff
          end if
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
          !recv_n
          dir = 7
          folded = .false.
          isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) then
             !--- do nothing, this point will come from other pe
          else
             if( jed.GT.jeg .AND. je.LT.jsd)then
                js = js+joff; je = je+joff
             end if
             !--- when the east face is folded, the south halo points at
             !--- the position should be on CORNER or EAST
             if( ied == ieg .AND. (position == corner .OR. position == east) &
                  .AND. jsd .GE. middle .AND. jed .LE. jeg ) then
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied-1, jsd, jed, dir)
                is=isc; ie=iec; js=jsc; je=jec
                select case (position)
                case(east)
                   j=js; js = jsg+jeg-je; je = jsg+jeg-j
                case(corner)
                   j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                end select
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, ied, ied, jsd, jed, dir, .true.)
             else
                call insert_update_overlap( overlap, domain%list(m)%pe, &
                                            is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
             end if
          endif
 
          !recv_ne
          dir = 8
          folded = .false.
          isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
          jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
          is=isc; ie=iec; js=jsc; je=jec
          if( ied.GT.ieg) then
             folded = .true.
             call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
          end if
          if( jed.GT.jeg .AND. je.LT.jsd )then !cyclic offset
             js = js+joff; je = je+joff
          endif
 
          call insert_update_overlap( overlap, domain%list(m)%pe, &
                                      is, ie, js, je, isd, ied, jsd, jed, dir)
          !--- Now calculate the overlapping for fold-edge.
          !--- for folded-south-edge, only need to consider to_pe's south(3) direction
          !--- only position at EAST and CORNER need to be considered
          if( ( position == east .OR. position == corner) ) then
            !fold is within domain
             if( domain%x(tme)%domain_data%begin .LE. ieg .AND. ieg .LE. domain%x(tme)%domain_data%end+ishift )then
                dir = 1
                !--- calculating overlapping for receving on north
                if( domain%y(tme)%pos .GE. size(domain%y(tme)%list(:))/2 )then
                   ied = domain%x(tme)%compute%end+ishift;   isd = ied
                   if( ied == ieg )then   ! fold is within domain.
                      jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
                      is=isc; ie=iec; js = jsc; je = jec
                      select case (position)
                      case(east)
                         jsd = max(jsd, middle)
                         j=js; js = jsg+jeg-je; je = jsg+jeg-j
                      case(corner)
                         jsd = max(jsd, middle)
                         j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
                      end select
                      call insert_update_overlap(overlap, domain%list(m)%pe, &
                                                 is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
                      is = max(is, isd); ie = min(ie, ied)
                      js = max(js, jsd); je = min(je, jed)
                      if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )then
                         nrecv_check = nrecv_check+1
                         call allocate_check_overlap(checklist(nrecv_check), 1)
                         call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
                                                   tme, 3, one_hundred_eighty, is, ie, js, je)
                      endif
                   endif
                endif
             endif
          endif
       endif
       !--- copy the overlapping information
       if( overlap%count > 0) then
          nrecv = nrecv + 1
         if(nrecv > maxlist) call mpp_error(fatal,  &
             "mpp_domains_define.inc(compute_overlaps_east): nrecv is greater than MAXLIST, increase MAXLIST")
          call add_update_overlap( overlaplist(nrecv), overlap)
          call init_overlap_type(overlap)
       endif
    enddo ! end of recv do loop
 
    ! copy the overlapping information into domain
    if(nrecv>0) then
       update%nrecv = nrecv
       if (associated(update%recv)) deallocate(update%recv) !< Check if associated
       allocate(update%recv(nrecv))
       do m = 1, nrecv
          call add_update_overlap( update%recv(m), overlaplist(m) )
          do n = 1, update%recv(m)%count
             if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) then
                if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
                if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
             endif
          enddo
       enddo
    endif
 
    if(nrecv_check>0) then
       check%nrecv = nrecv_check
       if (associated(check%recv)) deallocate(check%recv) !< Check if associated
       allocate(check%recv(nrecv_check))
       do m = 1, nrecv_check
          call add_check_overlap( check%recv(m), checklist(m) )
       enddo
    endif
 
    call deallocate_overlap_type(overlap)
    do m = 1, maxlist
       call deallocate_overlap_type(overlaplist(m))
       if(debug_update_level .NE. no_check) call deallocate_overlap_type(checklist(m))
    enddo
 
    update=>null()
    check=>null()
 
    domain%initialized = .true.
 
  end subroutine compute_overlaps_fold_east
 
  !#####################################################################################
  subroutine get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
    integer,    intent(in) :: jsg, jeg, isg, jshift, position
    integer, intent(inout) :: is, ie, js, je
    integer                :: i, j
 
    select case(position)
    case(center)
       j=js; js = jsg+jeg-je; je = jsg+jeg-j
       i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
    case(east)
       j=js; js = jsg+jeg-je; je = jsg+jeg-j
       i=is; is = 2*isg-ie; ie = 2*isg-i
    case(north)
       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
       i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
    case(corner)
       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
       i=is; is = 2*isg-ie; ie = 2*isg-i
    end select
 
  end subroutine get_fold_index_west
 
  !#####################################################################################
  subroutine get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
    integer,    intent(in) :: jsg, jeg, ieg, jshift, position
    integer, intent(inout) :: is, ie, js, je
    integer                :: i, j
 
    select case(position)
    case(center)
       j=js; js = jsg+jeg-je; je = jsg+jeg-j
       i=is; is = 2*ieg-ie+1; ie = 2*ieg-i+1
    case(east)
       j=js; js = jsg+jeg-je; je = jsg+jeg-j
       i=is; is = 2*ieg-ie; ie = 2*ieg-i
    case(north)
       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
       i=is; is = 2*ieg-ie+1; ie = 2*ieg-i+1
    case(corner)
       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
       i=is; is = 2*ieg-ie; ie = 2*ieg-i
    end select
 
  end subroutine get_fold_index_east
 
  !#####################################################################################
  subroutine get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
    integer,    intent(in) :: isg, ieg, jsg, ishift, position
    integer, intent(inout) :: is, ie, js, je
    integer                :: i, j
 
    select case(position)
    case(center)
       i=is; is = isg+ieg-ie; ie = isg+ieg-i
       j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
    case(east)
       i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
       j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
    case(north)
       i=is; is = isg+ieg-ie; ie = isg+ieg-i
       j=js; js = 2*jsg-je; je = 2*jsg-j
    case(corner)
       i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
       j=js; js = 2*jsg-je; je = 2*jsg-j
    end select
 
  end subroutine get_fold_index_south
  !#####################################################################################
  subroutine get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
    integer,    intent(in) :: isg, ieg, jeg, ishift, position
    integer, intent(inout) :: is, ie, js, je
    integer                :: i, j
 
    select case(position)
    case(center)
       i=is; is = isg+ieg-ie; ie = isg+ieg-i
       j=js; js = 2*jeg-je+1; je = 2*jeg-j+1
    case(east)
       i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
       j=js; js = 2*jeg-je+1; je = 2*jeg-j+1
    case(north)
       i=is; is = isg+ieg-ie; ie = isg+ieg-i
       j=js; js = 2*jeg-je; je = 2*jeg-j
    case(corner)
       i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
       j=js; js = 2*jeg-je; je = 2*jeg-j
    end select
 
  end subroutine get_fold_index_north
 
 
  !#####################################################################################
  !> add offset to the index
  subroutine apply_cyclic_offset(lstart, lend, offset, gstart, gend, gsize)
    integer, intent(inout) :: lstart, lend
    integer, intent(in   ) :: offset, gstart, gend, gsize
 
    lstart = lstart + offset
    if(lstart > gend)   lstart = lstart - gsize
    if(lstart < gstart) lstart = lstart + gsize
    lend = lend + offset
    if(lend > gend)     lend   = lend   - gsize
    if(lend < gstart)   lend   = lend   + gsize
 
    return
 
  end subroutine apply_cyclic_offset
 
  !###################################################################################
  !> this routine sets up the overlapping for mpp_update_domains for arbitrary halo update.
  !! should be the halo size defined in mpp_define_domains.
  !! xhalo_out, yhalo_out should not be exactly the same as xhalo_in, yhalo_in
  !! currently we didn't consider about tripolar grid situation, because in the folded north
  !! region, the overlapping is specified through list of points, not through rectangular.
  !! But will return back to solve this problem in the future.
  subroutine set_overlaps(domain, overlap_in, overlap_out, whalo_out, ehalo_out, shalo_out, nhalo_out)
    type(domain2d),    intent(in)    :: domain
    type(overlapspec), intent(in)    :: overlap_in
    type(overlapspec), intent(inout) :: overlap_out
    integer,           intent(in)    :: whalo_out, ehalo_out, shalo_out, nhalo_out
    integer                          :: nlist, m, n, isoff, ieoff, jsoff, jeoff, rotation
    integer                          :: whalo_in, ehalo_in, shalo_in, nhalo_in
    integer                          :: dir
    type(overlap_type)               :: overlap
    type(overlap_type), allocatable  :: send(:), recv(:)
    type(overlap_type), pointer      :: ptrIn  => null()
    integer                          :: nsend, nrecv, nsend_in, nrecv_in
 
    if( domain%fold .NE. 0) call mpp_error(fatal, "mpp_domains_define.inc(set_overlaps):"// &
                               & " folded domain is not implemented for arbitrary halo update, contact developer")
 
    whalo_in = domain%whalo
    ehalo_in = domain%ehalo
    shalo_in = domain%shalo
    nhalo_in = domain%nhalo
 
    if( .NOT. domain%initialized) call mpp_error(fatal, &
         "mpp_domains_define.inc: domain is not defined yet")
 
    nlist = size(domain%list(:))
    isoff = whalo_in - abs(whalo_out)
    ieoff = ehalo_in - abs(ehalo_out)
    jsoff = shalo_in - abs(shalo_out)
    jeoff = nhalo_in - abs(nhalo_out)
 
    nsend = 0
    nsend_in = overlap_in%nsend
    nrecv_in = overlap_in%nrecv
    if(nsend_in>0) allocate(send(nsend_in))
    if(nrecv_in>0) allocate(recv(nrecv_in))
    call allocate_update_overlap(overlap, maxoverlap)
 
    overlap_out%whalo  = whalo_out
    overlap_out%ehalo  = ehalo_out
    overlap_out%shalo  = shalo_out
    overlap_out%nhalo  = nhalo_out
    overlap_out%xbegin = overlap_in%xbegin
    overlap_out%xend   = overlap_in%xend
    overlap_out%ybegin = overlap_in%ybegin
    overlap_out%yend   = overlap_in%yend
 
    !--- setting up overlap.
    do m = 1, nsend_in
       ptrin  => overlap_in%send(m)
       if(ptrin%count .LE. 0) call mpp_error(fatal, "mpp_domains_define.inc(set_overlaps):"// &
                              " number of overlap for send should be a positive number for"//trim(domain%name) )
       do n = 1, ptrin%count
          dir = ptrin%dir(n)
          rotation = ptrin%rotation(n)
          select case(dir)
          case(1) ! to_pe's eastern halo
             if(ehalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, 0, n, dir, rotation)
             else if(ehalo_out<0) then
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, 0, n, dir, rotation)
             end if
          case(2) ! to_pe's southeast halo
             if(ehalo_out>0 .AND. shalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, -ieoff, jsoff, 0, n, dir, rotation)
             else if(ehalo_out<0 .AND. shalo_out < 0) then ! three parts: southeast, south and east.
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, shalo_out, n, dir, rotation)
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, jsoff, 0, n, dir-1, rotation)
                call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, shalo_out, n, dir+1, rotation)
             end if
          case(3) ! to_pe's southern halo
             if(shalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, 0, jsoff, 0, n, dir, rotation)
             else if(shalo_out<0) then
                call set_single_overlap(ptrin, overlap, 0, 0, 0, shalo_out, n, dir, rotation)
             end if
          case(4) ! to_pe's southwest halo
             if(whalo_out>0 .AND. shalo_out > 0) then
                call set_single_overlap(ptrin, overlap, isoff, 0, jsoff, 0, n, dir, rotation)
             else if(whalo_out<0 .AND. shalo_out < 0) then
                call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, shalo_out, n, dir, rotation)
                call set_single_overlap(ptrin, overlap, isoff, 0, 0, shalo_out, n, dir-1, rotation)
                call set_single_overlap(ptrin, overlap, 0, whalo_out, jsoff, 0, n, dir+1, rotation)
             end if
          case(5) ! to_pe's western halo
             if(whalo_out > 0) then
                call set_single_overlap(ptrin, overlap, isoff, 0, 0, 0, n, dir, rotation)
             else if(whalo_out<0) then
                call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, 0, n, dir, rotation)
             end if
          case(6) ! to_pe's northwest halo
             if(whalo_out>0 .AND. nhalo_out > 0) then
                call set_single_overlap(ptrin, overlap, isoff, 0, 0, -jeoff, n, dir, rotation)
             else if(whalo_out<0 .AND. nhalo_out < 0) then
                call set_single_overlap(ptrin, overlap, 0, whalo_out, -nhalo_out, 0, n, dir, rotation)
                call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, -jeoff, n, dir-1, rotation)
                call set_single_overlap(ptrin, overlap, isoff, 0, -nhalo_out, 0, n, dir+1, rotation)
             end if
          case(7) ! to_pe's northern halo
             if(nhalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, 0, 0, -jeoff, n, dir, rotation)
             else if(nhalo_out<0) then
                call set_single_overlap(ptrin, overlap, 0, 0, -nhalo_out, 0, n, dir, rotation)
             end if
          case(8) ! to_pe's northeast halo
             if(ehalo_out>0 .AND. nhalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, -jeoff, n, dir, rotation)
             else if(ehalo_out<0 .AND. nhalo_out < 0) then
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, -nhalo_out, 0, n, dir, rotation)
                call set_single_overlap(ptrin, overlap, 0, -ieoff, -nhalo_out, 0, n, dir-1, rotation)
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, -jeoff, n, 1, rotation)
             end if
          end select
       end do ! do n = 1, ptrIn%count
       if(overlap%count>0) then
          nsend = nsend+1
          call add_update_overlap(send(nsend), overlap)
          call init_overlap_type(overlap)
       endif
    end do ! end do list = 0, nlist-1
 
    if(nsend>0) then
       overlap_out%nsend = nsend
       if (associated(overlap_out%send)) deallocate(overlap_out%send) !< Check if associated
       allocate(overlap_out%send(nsend));
       do n = 1, nsend
          call add_update_overlap(overlap_out%send(n), send(n) )
       enddo
    else
       overlap_out%nsend = 0
    endif
 
    !--------------------------------------------------
    !                     recving
    !---------------------------------------------------
    overlap%count = 0
    nrecv = 0
    do m = 1, nrecv_in
       ptrin  => overlap_in%recv(m)
       if(ptrin%count .LE. 0) call mpp_error(fatal, &
          "mpp_domains_define.inc(set_overlaps): number of overlap for recv should be a positive number")
       overlap%count = 0
       do n = 1, ptrin%count
          dir = ptrin%dir(n)
          rotation = ptrin%rotation(n)
          select case(dir)
          case(1) ! eastern halo
             if(ehalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, 0, n, dir)
             else if(ehalo_out<0) then
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, 0, n, dir)
             end if
          case(2) ! southeast halo
             if(ehalo_out>0 .AND. shalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, -ieoff, jsoff, 0, n, dir)
             else if(ehalo_out<0 .AND. shalo_out < 0) then
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, shalo_out, n, dir)
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, jsoff, 0, n, dir-1)
                call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, shalo_out, n, dir+1)
             end if
          case(3) ! southern halo
             if(shalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, 0, jsoff, 0, n, dir)
             else if(shalo_out<0) then
                call set_single_overlap(ptrin, overlap, 0, 0, 0, shalo_out, n, dir)
             end if
          case(4) ! southwest halo
             if(whalo_out>0 .AND. shalo_out > 0) then
                call set_single_overlap(ptrin, overlap, isoff, 0, jsoff, 0, n, dir)
             else if(whalo_out<0 .AND. shalo_out < 0) then
                call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, shalo_out, n, dir)
                call set_single_overlap(ptrin, overlap, isoff, 0, 0, shalo_out, n, dir-1)
                call set_single_overlap(ptrin, overlap, 0, whalo_out, jsoff, 0, n, dir+1)
             end if
          case(5) ! western halo
             if(whalo_out > 0) then
                call set_single_overlap(ptrin, overlap, isoff, 0, 0, 0, n, dir)
             else if(whalo_out<0) then
                call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, 0, n, dir)
             end if
          case(6) ! northwest halo
             if(whalo_out>0 .AND. nhalo_out > 0) then
                call set_single_overlap(ptrin, overlap, isoff, 0, 0, -jeoff, n, dir)
             else if(whalo_out<0 .AND. nhalo_out < 0) then
                call set_single_overlap(ptrin, overlap, 0, whalo_out, -nhalo_out, 0, n, dir)
                call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, -jeoff, n, dir-1)
                call set_single_overlap(ptrin, overlap, isoff, 0, -nhalo_out, 0, n, dir+1)
             end if
          case(7) ! northern halo
             if(nhalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, 0, 0, -jeoff, n, dir)
             else if(nhalo_out<0) then
                call set_single_overlap(ptrin, overlap, 0, 0, -nhalo_out, 0, n, dir)
             end if
          case(8) ! northeast halo
             if(ehalo_out>0 .AND. nhalo_out > 0) then
                call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, -jeoff, n, dir)
             else if(ehalo_out<0 .AND. nhalo_out < 0) then
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, -nhalo_out, 0, n, dir)
                call set_single_overlap(ptrin, overlap, 0, -ieoff, -nhalo_out, 0, n, dir-1)
                call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, -jeoff, n, 1)
             end if
          end select
       end do ! do n = 1, ptrIn%count
       if(overlap%count>0) then
          nrecv = nrecv+1
          call add_update_overlap(recv(nrecv), overlap)
          call init_overlap_type(overlap)
       endif
    end do ! end do list = 0, nlist-1
 
    if(nrecv>0) then
       overlap_out%nrecv = nrecv
       if (associated(overlap_out%recv)) deallocate(overlap_out%recv) !< Check if associated
       allocate(overlap_out%recv(nrecv));
       do n = 1, nrecv
          call add_update_overlap(overlap_out%recv(n), recv(n) )
       enddo
    else
       overlap_out%nrecv = 0
    endif
 
    call deallocate_overlap_type(overlap)
    do n = 1, nsend_in
       call deallocate_overlap_type(send(n))
    enddo
    do n = 1, nrecv_in
       call deallocate_overlap_type(recv(n))
    enddo
    if(allocated(send)) deallocate(send)
    if(allocated(recv)) deallocate(recv)
    ptrin => null()
 
    call  set_domain_comm_inf(overlap_out)
 
 
  end subroutine set_overlaps
 
 !##############################################################################
  subroutine set_single_overlap(overlap_in, overlap_out, isoff, ieoff, jsoff, jeoff, index, dir, rotation)
    type(overlap_type),    intent(in) :: overlap_in
    type(overlap_type), intent(inout) :: overlap_out
    integer,               intent(in) :: isoff, jsoff, ieoff, jeoff
    integer,               intent(in) :: index
    integer,               intent(in) :: dir
    integer, optional,     intent(in) :: rotation
    integer                           :: rotate
    integer                           :: count
 
    if( overlap_out%pe == null_pe ) then
       overlap_out%pe  = overlap_in%pe
    else
       if(overlap_out%pe .NE. overlap_in%pe) call mpp_error(fatal,  &
            "mpp_domains_define.inc(set_single_overlap): mismatch of pe between overlap_in and overlap_out")
    endif
 
    if(isoff .NE. 0 .and. ieoff .NE. 0) call mpp_error(fatal,  &
          "mpp_domains_define.inc(set_single_overlap): both isoff and ieoff are non-zero")
    if(jsoff .NE. 0 .and. jeoff .NE. 0) call mpp_error(fatal,  &
          "mpp_domains_define.inc(set_single_overlap): both jsoff and jeoff are non-zero")
 
 
    overlap_out%count = overlap_out%count + 1
    count = overlap_out%count
    if(count > maxoverlap) call mpp_error(fatal, &
         "set_single_overlap: number of overlap is greater than MAXOVERLAP, increase MAXOVERLAP")
    rotate = zero
    if(present(rotation)) rotate = rotation
    overlap_out%rotation  (count) = overlap_in%rotation(index)
    overlap_out%dir       (count) = dir
    overlap_out%tileMe    (count) = overlap_in%tileMe(index)
    overlap_out%tileNbr   (count) = overlap_in%tileNbr(index)
 
    select case(rotate)
    case(zero)
       overlap_out%is(count)      = overlap_in%is(index) + isoff
       overlap_out%ie(count)      = overlap_in%ie(index) + ieoff
       overlap_out%js(count)      = overlap_in%js(index) + jsoff
       overlap_out%je(count)      = overlap_in%je(index) + jeoff
    case(ninety)
       overlap_out%is(count)      = overlap_in%is(index) - jeoff
       overlap_out%ie(count)      = overlap_in%ie(index) - jsoff
       overlap_out%js(count)      = overlap_in%js(index) + isoff
       overlap_out%je(count)      = overlap_in%je(index) + ieoff
    case(minus_ninety)
       overlap_out%is(count)      = overlap_in%is(index) + jsoff
       overlap_out%ie(count)      = overlap_in%ie(index) + jeoff
       overlap_out%js(count)      = overlap_in%js(index) - ieoff
       overlap_out%je(count)      = overlap_in%je(index) - isoff
    case default
       call mpp_error(fatal, "mpp_domains_define.inc: the value of rotation should be ZERO, NINETY or MINUS_NINETY")
    end select
 
  end subroutine set_single_overlap
 
  !###################################################################################
  !> compute the overlapping between tiles for the T-cell.
  subroutine define_contact_point( domain, position, num_contact, tile1, tile2, align1, align2, &
       refine1, refine2, istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2,        &
       isgList, iegList, jsgList, jegList )
    type(domain2d),     intent(inout) :: domain
    integer,               intent(in) :: position
    integer,               intent(in) :: num_contact      !< number of contact regions
    integer, dimension(:), intent(in) :: tile1, tile2     !< tile number
    integer, dimension(:), intent(in) :: align1, align2   !< align direction of contact region
    real,    dimension(:), intent(in) :: refine1, refine2 !< refinement between tiles
    integer, dimension(:), intent(in) :: istart1, iend1   !< i-index in tile_1 of contact region
    integer, dimension(:), intent(in) :: jstart1, jend1   !< j-index in tile_1 of contact region
    integer, dimension(:), intent(in) :: istart2, iend2   !< i-index in tile_2 of contact region
    integer, dimension(:), intent(in) :: jstart2, jend2   !< j-index in tile_2 of contact region
    integer, dimension(:), intent(in) :: isgList, iegList !< i-global domain of each tile
    integer, dimension(:), intent(in) :: jsgList, jegList !< j-global domain of each tile
 
    integer              :: isc, iec, jsc, jec, isd, ied, jsd, jed
    integer              :: isc1, iec1, jsc1, jec1, isc2, iec2, jsc2, jec2
    integer              :: isd1, ied1, jsd1, jed1, isd2, ied2, jsd2, jed2
    integer              :: is, ie, js, je, ioff, joff
    integer              :: ntiles, max_contact
    integer              :: nlist, list, m, n, l, count, numS, numR
    integer              :: whalo, ehalo, shalo, nhalo
    integer              :: t1, t2, tt, pos
    integer              :: ntileMe, ntileNbr, tMe, tNbr, tileMe, dir
    integer              :: nxd, nyd, nxc, nyc, ism, iem, jsm, jem
    integer              :: dirlist(8)
    !--- is2Send and is1Send will figure out the overlapping for sending from current pe.
    !--- is1Recv and iscREcv will figure out the overlapping for recving onto current pe.
    integer, dimension(4*num_contact) :: is1Send, ie1Send, js1Send, je1Send
    integer, dimension(4*num_contact) :: is2Send, ie2Send, js2Send, je2Send
    integer, dimension(4*num_contact) :: is2Recv, ie2Recv, js2Recv, je2Recv
    integer, dimension(4*num_contact) :: is1Recv, ie1Recv, js1Recv, je1Recv
    integer, dimension(4*num_contact) :: align1Recv, align2Recv, align1Send, align2Send
    real,    dimension(4*num_contact) :: refineRecv, refineSend
    integer, dimension(4*num_contact) :: rotateSend, rotateRecv, tileSend, tileRecv
    integer                           :: nsend, nrecv, nsend2, nrecv2
    type(contact_type), dimension(domain%ntiles)            :: eCont, wCont, sCont, nCont
    type(overlap_type), dimension(0:size(domain%list(:))-1) :: overlapSend, overlapRecv
    integer                                                 :: iunit
 
    if( position .NE. center )  call mpp_error(fatal,  "mpp_domains_define.inc: " //&
         "routine define_contact_point can only be used to calculate overlapping for cell center.")
 
    ntiles  = domain%ntiles
 
    econt(:)%ncontact = 0
 
    do n = 1, ntiles
       econt(n)%ncontact = 0; scont(n)%ncontact = 0; wcont(n)%ncontact = 0; ncont(n)%ncontact = 0;
       allocate(econt(n)%tile(num_contact), wcont(n)%tile(num_contact) )
       allocate(ncont(n)%tile(num_contact), scont(n)%tile(num_contact) )
       allocate(econt(n)%align1(num_contact), econt(n)%align2(num_contact) )
       allocate(wcont(n)%align1(num_contact), wcont(n)%align2(num_contact) )
       allocate(scont(n)%align1(num_contact), scont(n)%align2(num_contact) )
       allocate(ncont(n)%align1(num_contact), ncont(n)%align2(num_contact) )
       allocate(econt(n)%refine1(num_contact), econt(n)%refine2(num_contact) )
       allocate(wcont(n)%refine1(num_contact), wcont(n)%refine2(num_contact) )
       allocate(scont(n)%refine1(num_contact), scont(n)%refine2(num_contact) )
       allocate(ncont(n)%refine1(num_contact), ncont(n)%refine2(num_contact) )
       allocate(econt(n)%is1(num_contact), econt(n)%ie1(num_contact), econt(n)%js1(num_contact), &
               &  econt(n)%je1(num_contact))
       allocate(econt(n)%is2(num_contact), econt(n)%ie2(num_contact), econt(n)%js2(num_contact), &
               &  econt(n)%je2(num_contact))
       allocate(wcont(n)%is1(num_contact), wcont(n)%ie1(num_contact), wcont(n)%js1(num_contact), &
               &  wcont(n)%je1(num_contact))
       allocate(wcont(n)%is2(num_contact), wcont(n)%ie2(num_contact), wcont(n)%js2(num_contact), &
               &  wcont(n)%je2(num_contact))
       allocate(scont(n)%is1(num_contact), scont(n)%ie1(num_contact), scont(n)%js1(num_contact), &
               &  scont(n)%je1(num_contact))
       allocate(scont(n)%is2(num_contact), scont(n)%ie2(num_contact), scont(n)%js2(num_contact), &
               &  scont(n)%je2(num_contact))
       allocate(ncont(n)%is1(num_contact), ncont(n)%ie1(num_contact), ncont(n)%js1(num_contact), &
               &  ncont(n)%je1(num_contact))
       allocate(ncont(n)%is2(num_contact), ncont(n)%ie2(num_contact), ncont(n)%js2(num_contact), &
               &  ncont(n)%je2(num_contact))
    end do
 
    !--- set up the east, south, west and north contact for each tile.
    do n = 1, num_contact
       t1 = tile1(n)
       t2 = tile2(n)
       select case(align1(n))
       case (east)
          call fill_contact( econt(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
               jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
       case (west)
          call fill_contact( wcont(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
               jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
       case (south)
          call fill_contact( scont(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
               jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
       case (north)
          call fill_contact( ncont(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
               jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
       end select
       select case(align2(n))
       case (east)
          call fill_contact( econt(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
               jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
       case (west)
          call fill_contact( wcont(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
               jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
       case (south)
          call fill_contact( scont(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
               jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
       case (north)
          call fill_contact( ncont(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
               jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
       end select
    end do
 
    !--- the tile number of current pe, halo size
    whalo = domain%whalo
    ehalo = domain%ehalo
    shalo = domain%shalo
    nhalo = domain%nhalo
 
    !--- find if there is an extra point in x and y direction depending on position
    nlist = size(domain%list(:))
 
    max_contact = 4*num_contact ! should be enough
 
    ntileme = size(domain%x(:))
    refinesend = 1; refinerecv = 1
 
    !--------------------------------------------------------------------------------------------------
    !    loop over each tile on current domain to set up the overlapping for each tile
    !--------------------------------------------------------------------------------------------------
    !--- first check the overlap within the tiles.
    do n = 1, domain%update_T%nsend
       pos = domain%update_T%send(n)%pe - mpp_root_pe()
       call add_update_overlap(overlapsend(pos), domain%update_T%send(n) )
    enddo
    do n = 1, domain%update_T%nrecv
       pos = domain%update_T%recv(n)%pe - mpp_root_pe()
       call add_update_overlap(overlaprecv(pos), domain%update_T%recv(n) )
    enddo
 
    call mpp_get_memory_domain(domain, ism, iem, jsm, jem)
    domain%update_T%xbegin = ism;   domain%update_T%xend  = iem
    domain%update_T%ybegin = jsm;   domain%update_T%yend  = jem
    domain%update_T%whalo  = whalo; domain%update_T%ehalo = ehalo
    domain%update_T%shalo  = shalo; domain%update_T%nhalo = nhalo
 
    do tme = 1, ntileme
       tileme = domain%tile_id(tme)
       rotatesend = zero; rotaterecv = zero
 
       !--- loop over all the contact region to figure out the index for overlapping region.
       count = 0
       do n = 1, econt(tileme)%ncontact  ! east contact
          count = count+1
          tilerecv(count)   = econt(tileme)%tile(n);    tilesend(count)   = econt(tileme)%tile(n)
          align1recv(count) = econt(tileme)%align1(n);  align2recv(count) = econt(tileme)%align2(n)
          align1send(count) = econt(tileme)%align1(n);  align2send(count) = econt(tileme)%align2(n)
          refinesend(count) = econt(tileme)%refine2(n); refinerecv(count) = econt(tileme)%refine1(n)
          is1recv(count)    = econt(tileme)%is1(n) + 1; ie1recv(count)    = is1recv(count) + ehalo - 1
          js1recv(count)    = econt(tileme)%js1(n);     je1recv(count)    = econt(tileme)%je1(n)
          select case(econt(tileme)%align2(n))
          case ( west )  ! w <-> e
             is2recv(count) = econt(tileme)%is2(n);     ie2recv(count) = is2recv(count) + ehalo - 1
             js2recv(count) = econt(tileme)%js2(n);     je2recv(count) = econt(tileme)%je2(n)
             ie1send(count) = econt(tileme)%is1(n);     is1send(count) = ie1send(count) - whalo + 1
             js1send(count) = econt(tileme)%js1(n);     je1send(count) = econt(tileme)%je1(n)
             ie2send(count) = econt(tileme)%is2(n) - 1; is2send(count) = ie2send(count) - whalo + 1
             js2send(count) = econt(tileme)%js2(n);     je2send(count) = econt(tileme)%je2(n)
          case ( south ) ! s <-> e
             rotaterecv(count) = ninety;                rotatesend(count) = minus_ninety
             js2recv(count) = econt(tileme)%js2(n);     je2recv(count) = js2recv(count) + ehalo -1
             is2recv(count) = econt(tileme)%is2(n);     ie2recv(count) = econt(tileme)%ie2(n)
             ie1send(count) = econt(tileme)%is1(n);     is1send(count) = ie1send(count) - shalo + 1
             js1send(count) = econt(tileme)%js1(n);     je1send(count) = econt(tileme)%je1(n)
             is2send(count) = econt(tileme)%is2(n);     ie2send(count) = econt(tileme)%ie2(n)
             je2send(count) = econt(tileme)%js2(n) - 1; js2send(count) = je2send(count) - shalo + 1
          end select
       end do
 
       do n = 1, scont(tileme)%ncontact  ! south contact
          count = count+1
          tilerecv(count)   = scont(tileme)%tile(n);    tilesend(count)   = scont(tileme)%tile(n)
          align1recv(count) = scont(tileme)%align1(n);  align2recv(count) = scont(tileme)%align2(n);
          align1send(count) = scont(tileme)%align1(n);  align2send(count) = scont(tileme)%align2(n);
          refinesend(count) = scont(tileme)%refine2(n); refinerecv(count) = scont(tileme)%refine1(n)
          is1recv(count)    = scont(tileme)%is1(n);     ie1recv(count)    = scont(tileme)%ie1(n)
          je1recv(count)    = scont(tileme)%js1(n) - 1; js1recv(count)    = je1recv(count) - shalo + 1
          select case(scont(tileme)%align2(n))
          case ( north ) ! n <-> s
             is2recv(count) = scont(tileme)%is2(n);   ie2recv(count) = scont(tileme)%ie2(n)
             je2recv(count) = scont(tileme)%je2(n);   js2recv(count) = je2recv(count) - shalo + 1
             is1send(count) = scont(tileme)%is1(n);   ie1send(count) = scont(tileme)%ie1(n)
             js1send(count) = scont(tileme)%js1(n);   je1send(count) = js1send(count) + nhalo -1
             is2send(count) = scont(tileme)%is2(n);   ie2send(count) = scont(tileme)%ie2(n)
             js2send(count) = scont(tileme)%je2(n)+1; je2send(count) = js2send(count) + nhalo - 1
          case ( east )  ! e <-> s
             rotaterecv(count) = minus_ninety;        rotatesend(count) = ninety
             ie2recv(count) = scont(tileme)%ie2(n);   is2recv(count) = ie2recv(count) - shalo + 1
             js2recv(count) = scont(tileme)%js2(n);   je2recv(count) = scont(tileme)%je2(n)
             is1send(count) = scont(tileme)%is1(n);   ie1send(count) = scont(tileme)%ie1(n)
             js1send(count) = scont(tileme)%js1(n);   je1send(count) = js1send(count) + ehalo - 1
             is2send(count) = scont(tileme)%ie2(n)+1; ie2send(count) = is2send(count) + ehalo - 1
             js2send(count) = scont(tileme)%js2(n);   je2send(count) = scont(tileme)%je2(n)
          end select
       end do
 
       do n = 1, wcont(tileme)%ncontact  ! west contact
          count = count+1
          tilerecv(count)   = wcont(tileme)%tile(n);    tilesend(count)   = wcont(tileme)%tile(n)
          align1recv(count) = wcont(tileme)%align1(n);  align2recv(count) = wcont(tileme)%align2(n);
          align1send(count) = wcont(tileme)%align1(n);  align2send(count) = wcont(tileme)%align2(n);
          refinesend(count) = wcont(tileme)%refine2(n); refinerecv(count) = wcont(tileme)%refine1(n)
          ie1recv(count)    = wcont(tileme)%is1(n) - 1; is1recv(count)    = ie1recv(count) - whalo + 1
          js1recv(count)    = wcont(tileme)%js1(n);     je1recv(count)    = wcont(tileme)%je1(n)
          select case(wcont(tileme)%align2(n))
          case ( east )  ! e <-> w
             ie2recv(count) = wcont(tileme)%ie2(n);   is2recv(count) = ie2recv(count) - whalo + 1
             js2recv(count) = wcont(tileme)%js2(n);   je2recv(count) = wcont(tileme)%je2(n)
             is1send(count) = wcont(tileme)%is1(n);   ie1send(count) = is1send(count) + ehalo - 1
             js1send(count) = wcont(tileme)%js1(n);   je1send(count) = wcont(tileme)%je1(n)
             is2send(count) = wcont(tileme)%ie2(n)+1; ie2send(count) = is2send(count) + ehalo - 1
             js2send(count) = wcont(tileme)%js2(n);   je2send(count) = wcont(tileme)%je2(n)
          case ( north ) ! n <-> w
             rotaterecv(count) = ninety;              rotatesend(count) = minus_ninety
             je2recv(count) = wcont(tileme)%je2(n);   js2recv(count) = je2recv(count) - whalo + 1
             is2recv(count) = wcont(tileme)%is2(n);   ie2recv(count) = wcont(tileme)%ie2(n)
             is1send(count) = wcont(tileme)%is1(n);   ie1send(count) = is1send(count) + nhalo - 1
             js1send(count) = wcont(tileme)%js1(n);   je1send(count) = wcont(tileme)%je1(n)
             js2send(count) = wcont(tileme)%je2(n)+1; je2send(count) = js2send(count) + nhalo - 1
             is2send(count) = wcont(tileme)%is2(n);   ie2send(count) = wcont(tileme)%ie2(n)
          end select
       end do
 
       do n = 1, ncont(tileme)%ncontact  ! north contact
          count = count+1
          tilerecv(count)   = ncont(tileme)%tile(n);   tilesend(count)   = ncont(tileme)%tile(n)
          align1recv(count) = ncont(tileme)%align1(n); align2recv(count) = ncont(tileme)%align2(n);
          align1send(count) = ncont(tileme)%align1(n); align2send(count) = ncont(tileme)%align2(n);
          refinesend(count) = ncont(tileme)%refine2(n); refinerecv(count) = ncont(tileme)%refine1(n)
          is1recv(count)    = ncont(tileme)%is1(n);    ie1recv(count)    = ncont(tileme)%ie1(n)
          js1recv(count)    = ncont(tileme)%je1(n)+1;  je1recv(count)    = js1recv(count) + nhalo - 1
          select case(ncont(tileme)%align2(n))
          case ( south ) ! s <-> n
             is2recv(count) = ncont(tileme)%is2(n);   ie2recv(count) = ncont(tileme)%ie2(n)
             js2recv(count) = ncont(tileme)%js2(n);   je2recv(count) = js2recv(count) + nhalo - 1
             is1send(count) = ncont(tileme)%is1(n);   ie1send(count) = ncont(tileme)%ie1(n)
             je1send(count) = ncont(tileme)%je1(n);   js1send(count) = je1send(count) - shalo + 1
             is2send(count) = ncont(tileme)%is2(n);   ie2send(count) = ncont(tileme)%ie2(n)
             je2send(count) = ncont(tileme)%js2(n)-1; js2send(count) = je2send(count) - shalo + 1
          case ( west )  ! w <-> n
             rotaterecv(count) = minus_ninety;        rotatesend(count) = ninety
             is2recv(count) = ncont(tileme)%ie2(n);   ie2recv(count) = is2recv(count) + nhalo - 1
             js2recv(count) = ncont(tileme)%js2(n);   je2recv(count) = ncont(tileme)%je2(n)
             is1send(count) = ncont(tileme)%is1(n);   ie1send(count) = ncont(tileme)%ie1(n)
             je1send(count) = ncont(tileme)%je1(n);   js1send(count) = je1send(count) - whalo + 1
             ie2send(count) = ncont(tileme)%is2(n)-1; is2send(count) = ie2send(count) - whalo + 1
             js2send(count) = ncont(tileme)%js2(n);   je2send(count) = ncont(tileme)%je2(n)
          end select
       end do
 
       nums = count
       numr = count
       !--- figure out the index for corner overlapping,
       !--- fill_corner_contact will be updated to deal with the situation that there are multiple tiles on
       !--- each side of six sides of cubic grid.
       if(.NOT. domain%rotated_ninety)  then
          call fill_corner_contact(econt, scont, wcont, ncont, isglist, ieglist, jsglist, jeglist, numr, nums, &
               tilerecv, tilesend, is1recv, ie1recv, js1recv, je1recv, is2recv, ie2recv,   &
               js2recv, je2recv, is1send, ie1send, js1send, je1send, is2send, ie2send,     &
               js2send, je2send, align1recv, align2recv, align1send, align2send,           &
               whalo, ehalo, shalo, nhalo, tileme )
       end if
 
       isc = domain%x(tme)%compute%begin; iec = domain%x(tme)%compute%end
       jsc = domain%y(tme)%compute%begin; jec = domain%y(tme)%compute%end
 
       !--- compute the overlapping for send.
       do n = 1, nums
          do list = 0, nlist-1
             m = mod( domain%pos+list, nlist )
             ntilenbr = size(domain%list(m)%x(:))
             do tnbr = 1, ntilenbr
                if( domain%list(m)%tile_id(tnbr) .NE. tilesend(n) ) cycle
                isc1 = max(isc, is1send(n)); iec1 = min(iec, ie1send(n))
                jsc1 = max(jsc, js1send(n)); jec1 = min(jec, je1send(n))
                if( isc1 > iec1 .OR. jsc1 > jec1 ) cycle
                !--- loop over 8 direction to get the overlapping starting from east with clockwise.
                do dir = 1, 8
                   !--- get the to_pe's data domain.
                   select case ( dir )
                   case ( 1 )  ! eastern halo
                      if( align2send(n) .NE. east ) cycle
                      isd = domain%list(m)%x(tnbr)%compute%end+1; ied = domain%list(m)%x(tnbr)%compute%end+ehalo
                      jsd = domain%list(m)%y(tnbr)%compute%begin; jed = domain%list(m)%y(tnbr)%compute%end
                   case ( 2 )  ! southeast halo
                      isd = domain%list(m)%x(tnbr)%compute%end+1; ied = domain%list(m)%x(tnbr)%compute%end+ehalo
                      jsd = domain%list(m)%y(tnbr)%compute%begin-shalo;    jed = domain%list(m)%y(tnbr)%compute%begin-1
                   case ( 3 )  ! southern halo
                      if( align2send(n) .NE. south ) cycle
                      isd = domain%list(m)%x(tnbr)%compute%begin; ied = domain%list(m)%x(tnbr)%compute%end
                      jsd = domain%list(m)%y(tnbr)%compute%begin-shalo;    jed = domain%list(m)%y(tnbr)%compute%begin-1
                   case ( 4 )  ! southwest halo
                      isd = domain%list(m)%x(tnbr)%compute%begin-whalo;    ied = domain%list(m)%x(tnbr)%compute%begin-1
                      jsd = domain%list(m)%y(tnbr)%compute%begin-shalo;    jed = domain%list(m)%y(tnbr)%compute%begin-1
                   case ( 5 )  ! western halo
                      if( align2send(n) .NE. west ) cycle
                      isd = domain%list(m)%x(tnbr)%compute%begin-whalo;    ied = domain%list(m)%x(tnbr)%compute%begin-1
                      jsd = domain%list(m)%y(tnbr)%compute%begin; jed = domain%list(m)%y(tnbr)%compute%end
                   case ( 6 )  ! northwest halo
                      isd = domain%list(m)%x(tnbr)%compute%begin-whalo;    ied = domain%list(m)%x(tnbr)%compute%begin-1
                      jsd = domain%list(m)%y(tnbr)%compute%end+1; jed = domain%list(m)%y(tnbr)%compute%end+nhalo
                   case ( 7 )  ! northern halo
                      if( align2send(n) .NE. north ) cycle
                      isd = domain%list(m)%x(tnbr)%compute%begin; ied = domain%list(m)%x(tnbr)%compute%end
                      jsd = domain%list(m)%y(tnbr)%compute%end+1; jed = domain%list(m)%y(tnbr)%compute%end+nhalo
                   case ( 8 )  ! northeast halo
                      isd = domain%list(m)%x(tnbr)%compute%end+1; ied = domain%list(m)%x(tnbr)%compute%end+ehalo
                      jsd = domain%list(m)%y(tnbr)%compute%end+1; jed = domain%list(m)%y(tnbr)%compute%end+nhalo
                   end select
                   isd = max(isd, is2send(n)); ied = min(ied, ie2send(n))
                   jsd = max(jsd, js2send(n)); jed = min(jed, je2send(n))
                   if( isd > ied .OR. jsd > jed ) cycle
                   ioff = 0; joff = 0
                   nxd = ied - isd + 1
                   nyd = jed - jsd + 1
                   select case ( align2send(n) )
                   case ( west, east )
                      ioff = isd - is2send(n)
                      joff = jsd - js2send(n)
                   case ( south, north )
                      ioff = isd - is2send(n)
                      joff = jsd - js2send(n)
                   end select
 
                   !--- get the index in current pe.
                   select case ( rotatesend(n) )
                   case ( zero )
                      isc2 = is1send(n) + ioff; iec2 = isc2 + nxd - 1
                      jsc2 = js1send(n) + joff; jec2 = jsc2 + nyd - 1
                   case ( ninety )                     ! N -> W or S -> E
                      iec2 = ie1send(n) - joff; isc2 = iec2 - nyd + 1
                      jsc2 = js1send(n) + ioff; jec2 = jsc2 + nxd - 1
                   case ( minus_ninety )               ! W -> N or E -> S
                      isc2 = is1send(n) + joff; iec2 = isc2 + nyd - 1
                      jec2 = je1send(n) - ioff; jsc2 = jec2 - nxd + 1
                   end select
                   is = max(isc1,isc2); ie = min(iec1,iec2)
                   js = max(jsc1,jsc2); je = min(jec1,jec2)
                   if(ie.GE.is .AND. je.GE.js )then
                      if(.not. associated(overlapsend(m)%tileMe)) call allocate_update_overlap(overlapsend(m), &
                        &  maxoverlap)
                    call insert_overlap_type(overlapsend(m), domain%list(m)%pe, tme, tnbr, &
                         is, ie, js, je, dir, rotatesend(n), .true. )
                   endif
                end do ! end do dir = 1, 8
             end do ! end do tNbr = 1, ntileNbr
          end do ! end do list = 0, nlist-1
       end do ! end do n = 1, numS
 
       !--- compute the overlapping for recv.
       do n = 1, numr
          do list = 0, nlist-1
             m = mod( domain%pos+nlist-list, nlist )
             ntilenbr = size(domain%list(m)%x(:))
             do tnbr = 1, ntilenbr
                if( domain%list(m)%tile_id(tnbr) .NE. tilerecv(n) ) cycle
                isc = domain%list(m)%x(tnbr)%compute%begin; iec = domain%list(m)%x(tnbr)%compute%end
                jsc = domain%list(m)%y(tnbr)%compute%begin; jec = domain%list(m)%y(tnbr)%compute%end
                isc = max(isc, is2recv(n)); iec = min(iec, ie2recv(n))
                jsc = max(jsc, js2recv(n)); jec = min(jec, je2recv(n))
                if( isc > iec .OR. jsc > jec ) cycle
                !--- find the offset for this overlapping.
                ioff = 0; joff = 0
                nxc = iec - isc + 1; nyc = jec - jsc + 1
                select case ( align2recv(n) )
                case ( west, east )
                   if(align2recv(n) == west) then
                      ioff = isc - is2recv(n)
                   else
                      ioff = ie2recv(n) - iec
                   endif
                   joff = jsc - js2recv(n)
                case ( north, south )
                   ioff = isc - is2recv(n)
                   if(align2recv(n) == south) then
                      joff = jsc - js2recv(n)
                   else
                      joff = je2recv(n) - jec
                   endif
                end select
 
                !--- get the index in current pe.
                select case ( rotaterecv(n) )
                case ( zero )
                   isd1 = is1recv(n) + ioff; ied1 = isd1 + nxc - 1
                   jsd1 = js1recv(n) + joff; jed1 = jsd1 + nyc - 1
                   if( align1recv(n) == west ) then
                      ied1 = ie1recv(n)-ioff;   isd1 = ied1 - nxc + 1
                   endif
                   if( align1recv(n) == south ) then
                      jed1 = je1recv(n)-joff;  jsd1 = jed1 - nyc + 1
                   endif
                case ( ninety )                      ! N -> W or S -> E
                   if( align1recv(n) == west ) then
                      ied1 = ie1recv(n)-joff;   isd1 = ied1 - nyc + 1
                   else
                      isd1 = is1recv(n)+joff;   ied1 = isd1 + nyc - 1
                   endif
                   jed1 = je1recv(n) - ioff; jsd1 = jed1 - nxc + 1
                case ( minus_ninety )                ! W -> N or E -> S
                   ied1 = ie1recv(n) - joff; isd1 = ied1 - nyc + 1
                   if( align1recv(n) == south ) then
                      jed1 = je1recv(n)-ioff;  jsd1 = jed1 - nxc + 1
                   else
                      jsd1 = js1recv(n)+ioff;  jed1 = jsd1 + nxc - 1
                   endif
                end select
 
                !--- loop over 8 direction to get the overlapping starting from east with clockwise.
                do dir = 1, 8
                   select case ( dir )
                   case ( 1 )  ! eastern halo
                      if( align1recv(n) .NE. east ) cycle
                      isd2 = domain%x(tme)%compute%end+1; ied2 = domain%x(tme)%domain_data%end
                      jsd2 = domain%y(tme)%compute%begin; jed2 = domain%y(tme)%compute%end
                   case ( 2 )  ! southeast halo
                      isd2 = domain%x(tme)%compute%end+1; ied2 = domain%x(tme)%domain_data%end
                      jsd2 = domain%y(tme)%domain_data%begin;    jed2 = domain%y(tme)%compute%begin-1
                   case ( 3 )  ! southern halo
                      if( align1recv(n) .NE. south ) cycle
                      isd2 = domain%x(tme)%compute%begin; ied2 = domain%x(tme)%compute%end
                      jsd2 = domain%y(tme)%domain_data%begin;    jed2 = domain%y(tme)%compute%begin-1
                   case ( 4 )  ! southwest halo
                      isd2 = domain%x(tme)%domain_data%begin;    ied2 = domain%x(tme)%compute%begin-1
                      jsd2 = domain%y(tme)%domain_data%begin;    jed2 = domain%y(tme)%compute%begin-1
                   case ( 5 )  ! western halo
                      if( align1recv(n) .NE. west ) cycle
                      isd2 = domain%x(tme)%domain_data%begin;    ied2 = domain%x(tme)%compute%begin-1
                      jsd2 = domain%y(tme)%compute%begin; jed2 = domain%y(tme)%compute%end
                   case ( 6 )  ! northwest halo
                      isd2 = domain%x(tme)%domain_data%begin;    ied2 = domain%x(tme)%compute%begin-1
                      jsd2 = domain%y(tme)%compute%end+1; jed2 = domain%y(tme)%domain_data%end
                   case ( 7 )  ! northern halo
                      if( align1recv(n) .NE. north ) cycle
                      isd2 = domain%x(tme)%compute%begin; ied2 = domain%x(tme)%compute%end
                      jsd2 = domain%y(tme)%compute%end+1; jed2 = domain%y(tme)%domain_data%end
                   case ( 8 )  ! northeast halo
                      isd2 = domain%x(tme)%compute%end+1; ied2 = domain%x(tme)%domain_data%end
                      jsd2 = domain%y(tme)%compute%end+1; jed2 = domain%y(tme)%domain_data%end
                   end select
                   is = max(isd1,isd2); ie = min(ied1,ied2)
                   js = max(jsd1,jsd2); je = min(jed1,jed2)
                   if(ie.GE.is .AND. je.GE.js )then
                      if(.not. associated(overlaprecv(m)%tileMe)) call allocate_update_overlap(overlaprecv(m), &
                        &  maxoverlap)
                    call insert_overlap_type(overlaprecv(m), domain%list(m)%pe, tme, tnbr, &
                         is, ie, js, je, dir, rotaterecv(n), .true.)
                      count                              = overlaprecv(m)%count
                   endif
                end do ! end do dir = 1, 8
             end do ! end do tNbr = 1, ntileNbr
          end do ! end do list = 0, nlist-1
       end do ! end do n = 1, numR
    end do   ! end do tMe = 1, ntileMe
 
    !--- copy the overlapping information into domain data
    nsend = 0; nsend2 = 0
    do list = 0, nlist-1
       m = mod( domain%pos+list, nlist )
       if(overlapsend(m)%count>0) nsend = nsend + 1
    enddo
 
    if(debug_message_passing) then
       !--- write out send information
       iunit = mpp_pe() + 1000
       do list = 0, nlist-1
          m = mod( domain%pos+list, nlist )
          if(overlapsend(m)%count==0) cycle
          write(iunit, *) "********to_pe = " ,overlapsend(m)%pe, " count = ",overlapsend(m)%count
          do n = 1, overlapsend(m)%count
             write(iunit, *) overlapsend(m)%is(n), overlapsend(m)%ie(n), overlapsend(m)%js(n), overlapsend(m)%je(n), &
                  overlapsend(m)%dir(n), overlapsend(m)%rotation(n)
          enddo
       enddo
       if(nsend >0) flush(iunit)
    endif
 
    dirlist(1) = 1; dirlist(2) = 3; dirlist(3) = 5; dirlist(4) = 7
    dirlist(5) = 2; dirlist(6) = 4; dirlist(7) = 6; dirlist(8) = 8
 
    ! copy the overlap information into domain.
    if(nsend >0) then
       if(associated(domain%update_T%send)) then
          do m = 1, domain%update_T%nsend
             call deallocate_overlap_type(domain%update_T%send(m))
          enddo
          deallocate(domain%update_T%send)
       endif
       domain%update_T%nsend = nsend
       allocate(domain%update_T%send(nsend))
       do list = 0, nlist-1
          m = mod( domain%pos+list, nlist )
          ntilenbr = size(domain%list(m)%x(:))
          !--- for the send, the list should be in tileNbr order and dir order to be consistent with Recv
          if(overlapsend(m)%count > 0) then
             nsend2 = nsend2+1
             if(nsend2>nsend) call mpp_error(fatal, &
                  "mpp_domains_define.inc(define_contact_point): nsend2 is greater than nsend")
             call allocate_update_overlap(domain%update_T%send(nsend2), overlapsend(m)%count)
 
             do tnbr = 1, ntilenbr
                do tt = 1, ntileme
                   if(domain%list(m)%pe == domain%pe) then ! own processor
                      tme = tnbr+tt-1
                      if(tme > ntileme) tme = tme - ntileme
                   else
                      tme = tt
                   end if
                   do n = 1, 8  ! loop over 8 direction
                      do l = 1, overlapsend(m)%count
                         if(overlapsend(m)%tileMe(l) .NE. tme) cycle
                         if(overlapsend(m)%tileNbr(l) .NE. tnbr) cycle
                         if(overlapsend(m)%dir(l) .NE. dirlist(n) ) cycle
                       call insert_overlap_type(domain%update_T%send(nsend2), overlapsend(m)%pe, &
                              overlapsend(m)%tileMe(l), overlapsend(m)%tileNbr(l), overlapsend(m)%is(l), &
                              overlapsend(m)%ie(l), overlapsend(m)%js(l), overlapsend(m)%je(l), overlapsend(m)%dir(l),&
                              overlapsend(m)%rotation(l), overlapsend(m)%from_contact(l)  )
                      end do
                   end do
                end do
             end do
          end if
       enddo
    endif
 
    if(nsend2 .NE. nsend) call mpp_error(fatal, &
         "mpp_domains_define.inc(define_contact_point): nsend2 does not equal to nsend")
 
    nrecv = 0; nrecv2 = 0
    do list = 0, nlist-1
       m = mod( domain%pos+list, nlist )
       if(overlaprecv(m)%count>0) nrecv = nrecv + 1
    enddo
 
    if(debug_message_passing) then
       do list = 0, nlist-1
          m = mod( domain%pos+list, nlist )
          if(overlaprecv(m)%count==0) cycle
          write(iunit, *) "********from_pe = " ,overlaprecv(m)%pe, " count = ",overlaprecv(m)%count
          do n = 1, overlaprecv(m)%count
             write(iunit, *) overlaprecv(m)%is(n), overlaprecv(m)%ie(n), overlaprecv(m)%js(n), overlaprecv(m)%je(n), &
                  overlaprecv(m)%dir(n), overlaprecv(m)%rotation(n)
          enddo
       enddo
       if(nrecv >0) flush(iunit)
    endif
 
    if(nrecv >0) then
       if(associated(domain%update_T%recv)) then
          do m = 1, domain%update_T%nrecv
             call deallocate_overlap_type(domain%update_T%recv(m))
          enddo
          deallocate(domain%update_T%recv)
       endif
       domain%update_T%nrecv = nrecv
       allocate(domain%update_T%recv(nrecv))
 
       do list = 0, nlist-1
          m = mod( domain%pos+nlist-list, nlist )
          ntilenbr = size(domain%list(m)%x(:))
          if(overlaprecv(m)%count > 0) then
             nrecv2 = nrecv2 + 1
             if(nrecv2>nrecv) call mpp_error(fatal, &
                   "mpp_domains_define.inc(define_contact_point): nrecv2 is greater than nrecv")
             call allocate_update_overlap(domain%update_T%recv(nrecv2), overlaprecv(m)%count)
             do tme = 1, ntileme
                do tt = 1, ntilenbr
                   !--- make sure the same order tile for different pe count
                   if(domain%list(m)%pe == domain%pe) then ! own processor
                      tnbr = tme+tt-1
                      if(tnbr>ntilenbr) tnbr = tnbr - ntilenbr
                   else
                      tnbr = tt
                   end if
                   do n = 1, 8  ! loop over 8 direction
                      do l = 1, overlaprecv(m)%count
                         if(overlaprecv(m)%tileMe(l) .NE. tme) cycle
                         if(overlaprecv(m)%tileNbr(l) .NE. tnbr) cycle
                         if(overlaprecv(m)%dir(l) .NE. dirlist(n) ) cycle
                       call insert_overlap_type(domain%update_T%recv(nrecv2), overlaprecv(m)%pe, &
                              overlaprecv(m)%tileMe(l), overlaprecv(m)%tileNbr(l), overlaprecv(m)%is(l), &
                              overlaprecv(m)%ie(l), overlaprecv(m)%js(l), overlaprecv(m)%je(l), overlaprecv(m)%dir(l),&
                              overlaprecv(m)%rotation(l), overlaprecv(m)%from_contact(l))
                         count = domain%update_T%recv(nrecv2)%count
                      end do
                   end do
                end do
             end do
          end if
       end do
    endif
 
    if(nrecv2 .NE. nrecv) call mpp_error(fatal, &
    "mpp_domains_define.inc(define_contact_point): nrecv2 does not equal to nrecv")
 
    do m = 0,nlist-1
       call deallocate_overlap_type(overlapsend(m))
       call deallocate_overlap_type(overlaprecv(m))
    enddo
    !--- release memory
    do n = 1, ntiles
       deallocate(econt(n)%tile, wcont(n)%tile, scont(n)%tile, ncont(n)%tile )
       deallocate(econt(n)%align1, wcont(n)%align1, scont(n)%align1, ncont(n)%align1)
       deallocate(econt(n)%align2, wcont(n)%align2, scont(n)%align2, ncont(n)%align2)
       deallocate(econt(n)%refine1, wcont(n)%refine1, scont(n)%refine1, ncont(n)%refine1)
       deallocate(econt(n)%refine2, wcont(n)%refine2, scont(n)%refine2, ncont(n)%refine2)
       deallocate(econt(n)%is1, econt(n)%ie1, econt(n)%js1, econt(n)%je1 )
       deallocate(econt(n)%is2, econt(n)%ie2, econt(n)%js2, econt(n)%je2 )
       deallocate(wcont(n)%is1, wcont(n)%ie1, wcont(n)%js1, wcont(n)%je1 )
       deallocate(wcont(n)%is2, wcont(n)%ie2, wcont(n)%js2, wcont(n)%je2 )
       deallocate(scont(n)%is1, scont(n)%ie1, scont(n)%js1, scont(n)%je1 )
       deallocate(scont(n)%is2, scont(n)%ie2, scont(n)%js2, scont(n)%je2 )
       deallocate(ncont(n)%is1, ncont(n)%ie1, ncont(n)%js1, ncont(n)%je1 )
       deallocate(ncont(n)%is2, ncont(n)%ie2, ncont(n)%js2, ncont(n)%je2 )
    end do
 
    domain%initialized = .true.
 
 
  end subroutine define_contact_point
 
!##############################################################################
!> always fill the contact according to index order.
subroutine fill_contact(Contact, tile, is1, ie1, js1, je1, is2, ie2, js2, je2, align1, align2, refine1, refine2 )
  type(contact_type), intent(inout) :: Contact
  integer,            intent(in)    :: tile
  integer,            intent(in)    :: is1, ie1, js1, je1
  integer,            intent(in)    :: is2, ie2, js2, je2
  integer,            intent(in)    :: align1, align2
  real,               intent(in)    :: refine1, refine2
  integer                           :: pos, n
 
  do pos = 1, contact%ncontact
     select case(align1)
     case(west, east)
        if( js1 < contact%js1(pos) ) exit
     case(south, north)
        if( is1 < contact%is1(pos) ) exit
     end select
  end do
 
  contact%ncontact = contact%ncontact + 1
  do n = contact%ncontact, pos+1, -1  ! shift the data if needed.
     contact%tile(n)   = contact%tile(n-1)
     contact%align1(n) = contact%align1(n-1)
     contact%align2(n) = contact%align2(n-1)
     contact%is1(n) = contact%is1(n-1); contact%ie1(n) = contact%ie1(n-1)
     contact%js1(n) = contact%js1(n-1); contact%je1(n) = contact%je1(n-1)
     contact%is2(n) = contact%is2(n-1); contact%ie2(n) = contact%ie2(n-1)
     contact%js2(n) = contact%js2(n-1); contact%je2(n) = contact%je2(n-1)
  end do
 
  contact%tile(pos)    = tile
  contact%align1(pos)  = align1
  contact%align2(pos)  = align2
  contact%refine1(pos) = refine1
  contact%refine2(pos) = refine2
  contact%is1(pos) = is1; contact%ie1(pos) = ie1
  contact%js1(pos) = js1; contact%je1(pos) = je1
  contact%is2(pos) = is2; contact%ie2(pos) = ie2
  contact%js2(pos) = js2; contact%je2(pos) = je2
 
end subroutine fill_contact
 
!############################################################################
!> this routine sets the overlapping between tiles for E,C,N-cell based on T-cell overlapping
subroutine set_contact_point(domain, position)
  type(domain2d), intent(inout) :: domain
  integer,           intent(in) :: position
 
  integer                         :: ishift, jshift, nlist, list, m, n
  integer                         :: ntileMe, tMe, dir, count, pos, nsend, nrecv
  integer                         :: isoff1, ieoff1, jsoff1, jeoff1
  type(overlap_type),  pointer    :: ptrIn  => null()
  type(overlapspec),   pointer    :: update_in  => null()
  type(overlapspec),   pointer    :: update_out => null()
  type(overlap_type)              :: overlapList(0:size(domain%list(:))-1)
  type(overlap_type)              :: overlap
 
  call mpp_get_domain_shift(domain, ishift, jshift, position)
  update_in => domain%update_T
  select case(position)
  case (corner)
     update_out => domain%update_C
  case (east)
     update_out => domain%update_E
  case (north)
     update_out => domain%update_N
  case default
     call mpp_error(fatal, "mpp_domains_define.inc(set_contact_point): the position should be CORNER, EAST or NORTH")
  end select
 
  update_out%xbegin = update_in%xbegin; update_out%xend = update_in%xend + ishift
  update_out%ybegin = update_in%ybegin; update_out%yend = update_in%yend + jshift
  update_out%whalo  = update_in%whalo;  update_out%ehalo  = update_in%ehalo
  update_out%shalo  = update_in%shalo;  update_out%nhalo  = update_in%nhalo
 
  nlist = size(domain%list(:))
  ntileme = size(domain%x(:))
  call allocate_update_overlap(overlap, maxoverlap)
  do m = 0, nlist-1
     call init_overlap_type(overlaplist(m))
  enddo
 
  !--- first copy the send information in update_out to send
  nsend = update_out%nsend
  do m = 1, nsend
     pos = update_out%send(m)%pe - mpp_root_pe()
     call add_update_overlap(overlaplist(pos), update_out%send(m))
     call deallocate_overlap_type(update_out%send(m))
  enddo
  if(ASSOCIATED(update_out%send) )deallocate(update_out%send)
 
  !--- loop over the list of overlapping.
  nsend = update_in%nsend
  do m = 1, nsend
     ptrin  => update_in%send(m)
     pos  = ptrin%pe - mpp_root_pe()
     do n = 1, ptrin%count
        dir = ptrin%dir(n)
        ! only set overlapping between tiles for send ( ptrOut%overlap(1) is false )
        if(ptrin%from_contact(n)) then
           select case ( dir )
           case ( 1 ) ! to_pe's eastern halo
              select case(ptrin%rotation(n))
              case (zero)  !  W -> E
                 isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = jshift
              case (ninety) ! S -> E
                 isoff1 = 0;      ieoff1 = jshift; jsoff1 = ishift; jeoff1 = ishift
              end select
           case ( 2 ) ! to_pe's south-eastearn halo
              select case(ptrin%rotation(n))
              case (zero)
                 isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
              case (ninety)
                 isoff1 = jshift; ieoff1 = jshift; jsoff1 = ishift; jeoff1 = ishift
              case (minus_ninety)
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
              end select
           case ( 3 ) ! to_pe's southern halo
              select case(ptrin%rotation(n))
              case (zero)  !  N -> S
                 isoff1 = 0;      ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
              case (minus_ninety) ! E -> S
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = ishift
              end select
           case ( 4 ) ! to_pe's south-westearn halo
              select case(ptrin%rotation(n))
              case (zero)
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
              case (ninety)
                 isoff1 = jshift; ieoff1 = jshift; jsoff1 = 0;      jeoff1 = 0
              case (minus_ninety)
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = ishift; jeoff1 = ishift
              end select
           case ( 5 ) ! to_pe's western halo
              select case(ptrin%rotation(n))
              case (zero)  !  E -> W
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = jshift
              case (ninety) ! N -> W
                 isoff1 = 0;      ieoff1 = jshift; jsoff1 = 0;      jeoff1 = 0
              end select
           case ( 6 ) ! to_pe's north-westearn halo
              select case(ptrin%rotation(n))
              case (zero)
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = jshift; jeoff1 = jshift
              case (ninety)
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
              case (minus_ninety)
                 isoff1 = jshift; ieoff1 = jshift; jsoff1 = ishift; jeoff1 = ishift
              end select
           case ( 7 ) ! to_pe's northern halo
              select case(ptrin%rotation(n))
              case (zero)  !  S -> N
                 isoff1 = 0;      ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
              case (minus_ninety) ! W -> N
                 isoff1 = jshift; ieoff1 = jshift; jsoff1 = 0;      jeoff1 = ishift
              end select
           case ( 8 ) ! to_pe's north-eastearn halo
              select case(ptrin%rotation(n))
              case (zero)
                 isoff1 = ishift; ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
              case (ninety)
                 isoff1 = 0;      ieoff1 = 0;      jsoff1 = ishift; jeoff1 = ishift
              case (minus_ninety)
                 isoff1 = jshift; ieoff1 = jshift; jsoff1 = 0;      jeoff1 = 0
              end select
           end select
           call insert_overlap_type(overlap, ptrin%pe, ptrin%tileMe(n), ptrin%tileNbr(n), &
                                             ptrin%is(n) + isoff1, ptrin%ie(n) + ieoff1, ptrin%js(n) + jsoff1, &
                ptrin%je(n) + jeoff1, ptrin%dir(n), ptrin%rotation(n), ptrin%from_contact(n))
        end if
     end do ! do n = 1, prtIn%count
     if(overlap%count > 0) then
        call add_update_overlap(overlaplist(pos), overlap)
        call init_overlap_type(overlap)
     endif
  end do  ! do list = 0, nlist-1
 
  nsend = 0
  do list = 0, nlist-1
     m = mod( domain%pos+list, nlist )
     if(overlaplist(m)%count>0) nsend = nsend+1
  enddo
 
  update_out%nsend = nsend
  if(nsend>0) then
   if (associated(update_out%send)) deallocate(update_out%send) !< Check if associated
     allocate(update_out%send(nsend))
     pos = 0
     do list = 0, nlist-1
        m = mod( domain%pos+list, nlist )
        if(overlaplist(m)%count>0) then
           pos = pos+1
           if(pos>nsend) call mpp_error(fatal, &
                "mpp_domains_define.inc(set_contact_point): pos should be no larger than nsend")
           call add_update_overlap(update_out%send(pos), overlaplist(m))
           call deallocate_overlap_type(overlaplist(m))
        endif
     enddo
     if(pos .NE. nsend) call mpp_error(fatal, &
          "mpp_domains_define.inc(set_contact_point): pos should equal to nsend")
  endif
 
 
 
  !--- first copy the recv information in update_out to recv
  nrecv = update_out%nrecv
  do m = 1, nrecv
     pos = update_out%recv(m)%pe - mpp_root_pe()
     call add_update_overlap(overlaplist(pos), update_out%recv(m))
     call deallocate_overlap_type(update_out%recv(m))
  enddo
  if(ASSOCIATED(update_out%recv) )deallocate(update_out%recv)
 
  !--- loop over the list of overlapping.
  nrecv = update_in%nrecv
  do m=1,nrecv
     ptrin  => update_in%recv(m)
     pos  = ptrin%pe - mpp_root_pe()
     do n = 1, ptrin%count
        dir = ptrin%dir(n)
        ! only set overlapping between tiles for recv ( ptrOut%overlap(1) is false )
        if(ptrin%from_contact(n)) then
           select case ( dir )
           case ( 1 ) ! E
              isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = jshift
           case ( 2 ) ! SE
              isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
           case ( 3 ) ! S
              isoff1 = 0;      ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
           case ( 4 ) ! SW
              isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
           case ( 5 ) ! W
              isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = jshift
           case ( 6 ) ! NW
              isoff1 = 0;       ieoff1 = 0;      jsoff1 = jshift; jeoff1 = jshift
           case ( 7 ) ! N
              isoff1 = 0;      ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
           case ( 8 ) ! NE
              isoff1 = ishift; ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
           end select
           call insert_overlap_type(overlap, ptrin%pe, ptrin%tileMe(n), ptrin%tileNbr(n), &
                                             ptrin%is(n) + isoff1, ptrin%ie(n) + ieoff1, ptrin%js(n) + jsoff1, &
                ptrin%je(n) + jeoff1, ptrin%dir(n), ptrin%rotation(n), ptrin%from_contact(n))
           count                     = overlap%count
        end if
     end do ! do n = 1, ptrIn%count
     if(overlap%count > 0) then
        call add_update_overlap(overlaplist(pos), overlap)
        call init_overlap_type(overlap)
     endif
     do tme = 1, size(domain%x(:))
        do n = 1, overlap%count
           if(overlap%tileMe(n) == tme) then
              if(overlap%dir(n) == 1 ) domain%x(tme)%loffset = 0
              if(overlap%dir(n) == 7 ) domain%y(tme)%loffset = 0
           end if
        end do
     end do
  end do ! do list = 0, nlist-1
 
  nrecv = 0
  do list = 0, nlist-1
     m = mod( domain%pos+nlist-list, nlist )
     if(overlaplist(m)%count>0) nrecv = nrecv+1
  enddo
 
  update_out%nrecv = nrecv
  if(nrecv>0) then
   if (associated(update_out%recv)) deallocate(update_out%recv) !< Check if associated
     allocate(update_out%recv(nrecv))
     pos = 0
     do list = 0, nlist-1
        m = mod( domain%pos+nlist-list, nlist )
        if(overlaplist(m)%count>0) then
           pos = pos+1
           if(pos>nrecv) call mpp_error(fatal, &
                "mpp_domains_define.inc(set_contact_point): pos should be no larger than nrecv")
           call  add_update_overlap(update_out%recv(pos), overlaplist(m))
           call deallocate_overlap_type(overlaplist(m))
        endif
     enddo
     if(pos .NE. nrecv) call mpp_error(fatal, &
          "mpp_domains_define.inc(set_contact_point): pos should equal to nrecv")
  endif
 
  call deallocate_overlap_type(overlap)
 
end subroutine set_contact_point
 
!> set up the overlapping for boundary check if the domain is symmetry. The check will be
!! done on current pe for east boundary for E-cell, north boundary for N-cell,
!! East and North boundary for C-cell
subroutine set_check_overlap( domain, position )
type(domain2d),    intent(in) :: domain
integer,           intent(in) :: position
integer                       :: nlist, m, n
integer, parameter            :: MAXCOUNT = 100
integer                       :: is, ie, js, je
integer                       :: nsend, nrecv, pos, maxsize, rotation
type(overlap_type)            :: overlap
type(overlapspec),   pointer  :: update  => null()
type(overlapspec),   pointer  :: check   => null()
 
select case(position)
case (corner)
   update => domain%update_C
   check  => domain%check_C
case (east)
   update => domain%update_E
   check  => domain%check_E
case (north)
   update => domain%update_N
   check  => domain%check_N
case default
   call mpp_error(fatal, "mpp_domains_define.inc(set_check_overlap): position should be CORNER, EAST or NORTH")
end select
 
check%xbegin = update%xbegin; check%xend = update%xend
check%ybegin = update%ybegin; check%yend = update%yend
check%nsend  = 0
check%nrecv  = 0
if( .NOT. domain%symmetry ) return
 
nsend = 0
maxsize = 0
do m = 1, update%nsend
    do n = 1, update%send(m)%count
       if( update%send(m)%rotation(n) == one_hundred_eighty ) cycle
       if( ( (position == east .OR. position == corner) .AND. update%send(m)%dir(n) == 1 ) .OR. &
            ( (position == north .OR. position == corner) .AND. update%send(m)%dir(n) == 7 ) ) then
            maxsize = max(maxsize, update%send(m)%count)
            nsend = nsend + 1
            exit
       endif
    enddo
enddo
 
if(nsend>0) then
   if (associated(check%send)) deallocate(check%send) !< Check if associated
   allocate(check%send(nsend))
   call allocate_check_overlap(overlap, maxsize)
endif
 
 
nlist = size(domain%list(:))
!--- loop over the list of domains to find the boundary overlap for send
pos = 0
do m = 1, update%nsend
 do n = 1, update%send(m)%count
    if( update%send(m)%rotation(n) == one_hundred_eighty ) cycle
    ! comparing east direction on currently pe
    if( (position == east .OR. position == corner) .AND. update%send(m)%dir(n) == 1 ) then
       rotation = update%send(m)%rotation(n)
       select case( rotation )
       case( zero ) ! W -> E
          is = update%send(m)%is(n) - 1
          ie = is
          js = update%send(m)%js(n)
          je = update%send(m)%je(n)
       case( ninety ) ! S -> E
          is = update%send(m)%is(n)
          ie = update%send(m)%ie(n)
          js = update%send(m)%js(n) - 1
          je = js
       end select
       call insert_check_overlap(overlap, update%send(m)%pe, &
                                 update%send(m)%tileMe(n), 1, rotation, is, ie, js, je)
    end if
 
    ! comparing north direction on currently pe
    if( (position == north .OR. position == corner) .AND. update%send(m)%dir(n) == 7 ) then
       rotation = update%send(m)%rotation(n)
       select case( rotation )
       case( zero ) ! S->N
          is = update%send(m)%is(n)
          ie = update%send(m)%ie(n)
          js = update%send(m)%js(n) - 1
          je = js
       case( minus_ninety ) ! W->N
          is = update%send(m)%is(n) - 1
          ie = is
          js = update%send(m)%js(n)
          je = update%send(m)%je(n)
       end select
       call insert_check_overlap(overlap, update%send(m)%pe, &
            update%send(m)%tileMe(n), 4, rotation, is, ie, js, je)
    end if
 end do ! do n =1, update%send(m)%count
 if(overlap%count>0) then
   pos = pos+1
   if(pos>nsend)call mpp_error(fatal, "mpp_domains_define.inc(set_check_overlap): pos is greater than nsend")
   call add_check_overlap(check%send(pos), overlap)
   call init_overlap_type(overlap)
 endif
end do ! end  do list = 0, nlist
 
if(pos .NE. nsend)call mpp_error(fatal, "mpp_domains_define.inc(set_check_overlap): pos is greater than nsend")
 
nrecv = 0
maxsize = 0
do m = 1, update%nrecv
    do n = 1, update%recv(m)%count
       if( update%recv(m)%rotation(n) == one_hundred_eighty ) cycle
       if( ( (position == east .OR. position == corner) .AND. update%recv(m)%dir(n) == 1 ) .OR. &
            ( (position == north .OR. position == corner) .AND. update%recv(m)%dir(n) == 7 ) ) then
            maxsize = max(maxsize, update%recv(m)%count)
            nrecv = nrecv + 1
            exit
       endif
    enddo
enddo
 
if(nsend>0) call deallocate_overlap_type(overlap)
 
if(nrecv>0) then
   if (associated(check%recv)) deallocate(check%recv) !< Check if associated
   allocate(check%recv(nrecv))
   call allocate_check_overlap(overlap, maxsize)
endif
 
pos = 0
do m = 1, update%nrecv
 do n = 1, update%recv(m)%count
    if( update%recv(m)%rotation(n) == one_hundred_eighty ) cycle
    if( (position == east .OR. position == corner) .AND. update%recv(m)%dir(n) == 1 ) then
       is = update%recv(m)%is(n) - 1
       ie = is
       js = update%recv(m)%js(n)
       je = update%recv(m)%je(n)
       call insert_check_overlap(overlap, update%recv(m)%pe, &
                                 update%recv(m)%tileMe(n), 1, update%recv(m)%rotation(n), is, ie, js, je)
    end if
    if( (position == north .OR. position == corner) .AND. update%recv(m)%dir(n) == 7 ) then
       is = update%recv(m)%is(n)
       ie = update%recv(m)%ie(n)
       js = update%recv(m)%js(n) - 1
       je = js
       call insert_check_overlap(overlap, update%recv(m)%pe, &
            update%recv(m)%tileMe(n), 3, update%recv(m)%rotation(n), is, ie, js, je)
    end if
 end do ! n = 1, overlap%count
 if(overlap%count>0) then
   pos = pos+1
   if(pos>nrecv)call mpp_error(fatal, "mpp_domains_define.inc(set_check_overlap): pos is greater than nrecv")
   call add_check_overlap(check%recv(pos), overlap)
   call init_overlap_type(overlap)
 endif
end do ! end  do list = 0, nlist
 
if(pos .NE. nrecv)call mpp_error(fatal, "mpp_domains_define.inc(set_check_overlap): pos is greater than nrecv")
if(nrecv>0) call deallocate_overlap_type(overlap)
 
end subroutine set_check_overlap
 
!#############################################################################
!> set up the overlapping for boundary if the domain is symmetry.
subroutine set_bound_overlap( domain, position )
  type(domain2d), intent(inout) :: domain
  integer,        intent(in)    :: position
  integer                       :: m, n, l, count, dr, tMe
  integer, parameter            :: MAXCOUNT = 100
  integer, dimension(MAXCOUNT)  :: dir, rotation, is, ie, js, je, tileMe, index
  integer, dimension(size(domain%x(:)), 4)           :: nrecvl
  integer, dimension(size(domain%x(:)), 4, MAXCOUNT) :: isl, iel, jsl, jel
  type(overlap_type),  pointer   :: overlap => null()
  type(overlapspec),   pointer   :: update => null()
  type(overlapspec),   pointer   :: bound => null()
  integer                        :: nlist_send, nlist_recv, ishift, jshift
  integer                        :: ism, iem, jsm, jem, nsend, nrecv
  integer                        :: isg, ieg, jsg, jeg, nlist, list
  integer                        :: npes_x, npes_y, ipos, jpos, inbr, jnbr
  integer                        :: isc, iec, jsc, jec, my_pe
  integer                        :: pe_south1, pe_south2, pe_west0, pe_west1, pe_west2
  integer                        :: is_south1, ie_south1, js_south1, je_south1
  integer                        :: is_south2, ie_south2, js_south2, je_south2
  integer                        :: is_west0, ie_west0, js_west0, je_west0
  integer                        :: is_west1, ie_west1, js_west1, je_west1
  integer                        :: is_west2, ie_west2, js_west2, je_west2
  logical                        :: x_cyclic, y_cyclic, folded_north
 
  is_south1=0; ie_south1=0; js_south1=0; je_south1=0
  is_south2=0; ie_south2=0; js_south2=0; je_south2=0
  is_west0=0; ie_west0=0; js_west0=0; je_west0=0
  is_west1=0; ie_west1=0; js_west1=0; je_west1=0
  is_west2=0; ie_west2=0; js_west2=0; je_west2=0
 
 
  if( position == center .OR. .NOT. domain%symmetry ) return
  call mpp_get_domain_shift(domain, ishift, jshift, position)
  call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)
  call mpp_get_memory_domain ( domain, ism, iem, jsm, jem )
 
  select case(position)
  case (corner)
     update => domain%update_C
     bound  => domain%bound_C
  case (east)
     update => domain%update_E
     bound  => domain%bound_E
  case (north)
     update => domain%update_N
     bound  => domain%bound_N
  case default
     call mpp_error( fatal, "mpp_domains_mod(set_bound_overlap): invalid option of position")
  end select
 
  bound%xbegin = ism; bound%xend = iem + ishift
  bound%ybegin = jsm; bound%yend = jem + jshift
 
  nlist_send = max(update%nsend,4)
  nlist_recv = max(update%nrecv,4)
  bound%nsend = nlist_send
  bound%nrecv = nlist_recv
  if(nlist_send >0) then
   if (associated(bound%send)) deallocate(bound%send) !< Check if associated
     allocate(bound%send(nlist_send))
     bound%send(:)%count = 0
  endif
  if(nlist_recv >0) then
   if (associated(bound%recv)) deallocate(bound%recv) !< Check if associated
     allocate(bound%recv(nlist_recv))
     bound%recv(:)%count = 0
  endif
  !--- loop over the list of domains to find the boundary overlap for send
  nlist = size(domain%list(:))
 
  npes_x = size(domain%x(1)%list(:))
  npes_y = size(domain%y(1)%list(:))
  x_cyclic = domain%x(1)%cyclic
  y_cyclic = domain%y(1)%cyclic
  folded_north = btest(domain%fold,north)
  ipos = domain%x(1)%pos
  jpos = domain%y(1)%pos
  isc  = domain%x(1)%compute%begin; iec = domain%x(1)%compute%end
  jsc  = domain%y(1)%compute%begin; jec = domain%y(1)%compute%end
 
  nsend = 0
  if(domain%ntiles == 1) then  ! use neighbor processor to configure send and recv
     ! currently only set up for west and south boundary
 
     ! south boundary for send
     pe_south1 = null_pe; pe_south2 = null_pe
     if( position == north .OR. position == corner ) then
        inbr = ipos; jnbr = jpos + 1
        if( jnbr == npes_y .AND. y_cyclic) jnbr = 0
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_south1 = domain%pearray(inbr,jnbr)
           is_south1 = isc + ishift; ie_south1 = iec+ishift
           js_south1 = jec + jshift; je_south1 = js_south1
        endif
     endif
     !--- send to the southwest processor when position is NORTH
     if( position == corner ) then
        inbr = ipos + 1; jnbr = jpos + 1
        if( inbr == npes_x .AND. x_cyclic) inbr = 0
        if( jnbr == npes_y .AND. y_cyclic) jnbr = 0
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_south2 = domain%pearray(inbr,jnbr)
           is_south2 = iec + ishift; ie_south2 = is_south2
           js_south2 = jec + jshift; je_south2 = js_south2
        endif
     endif
 
     !---west boundary for send
     pe_west0 = null_pe; pe_west1 = null_pe; pe_west2 = null_pe
     if( position == east ) then
        inbr = ipos+1; jnbr = jpos
        if( inbr == npes_x .AND. x_cyclic) inbr = 0
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_west1 = domain%pearray(inbr,jnbr)
           is_west1 = iec + ishift; ie_west1 = is_west1
           js_west1 = jsc + jshift; je_west1 = jec + jshift
        endif
     else if ( position == corner ) then  ! possible split into two parts.
        !--- on the fold.
        if( folded_north .AND. jec == jeg .AND. ipos .LT. (npes_x-1)/2 ) then
           inbr = npes_x - ipos - 1; jnbr = jpos
           if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
               pe_west0 = domain%pearray(inbr,jnbr)
               is_west0 = iec+ishift; ie_west0 = is_west0
               js_west0 = jec+jshift; je_west0 = js_west0
           endif
        endif
 
        if( folded_north .AND. jec == jeg .AND. ipos .GE. npes_x/2 .AND. ipos .LT. (npes_x-1) ) then
           inbr = ipos+1; jnbr = jpos
           if( inbr == npes_x .AND. x_cyclic) inbr = 0
           if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
              pe_west1 = domain%pearray(inbr,jnbr)
              is_west1 = iec + ishift; ie_west1 = is_west1
              js_west1 = jsc + jshift; je_west1 = jec
           endif
        else
           inbr = ipos+1; jnbr = jpos
           if( inbr == npes_x .AND. x_cyclic) inbr = 0
           if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
              pe_west1 = domain%pearray(inbr,jnbr)
              is_west1 = iec + ishift; ie_west1 = is_west1
              js_west1 = jsc + jshift; je_west1 = jec + jshift
           endif
        endif
     endif
     !--- send to the southwest processor when position is NORTH
     if( position == corner ) then
        inbr = ipos + 1; jnbr = jpos + 1
        if( inbr == npes_x .AND. x_cyclic) inbr = 0
        if( jnbr == npes_y .AND. y_cyclic) jnbr = 0
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_west2 = domain%pearray(inbr,jnbr)
           is_west2 = iec + ishift; ie_west2 = is_west2
           js_west2 = jec + jshift; je_west2 = js_west2
        endif
     endif
 
     do list = 0,nlist-1
        m = mod( domain%pos+list, nlist )
        count = 0
        my_pe = domain%list(m)%pe
        if(my_pe == pe_south1) then
           count = count + 1
           is(count) = is_south1; ie(count) = ie_south1
           js(count) = js_south1; je(count) = je_south1
           dir(count) = 2
           rotation(count) = zero
        endif
        if(my_pe == pe_south2) then
           count = count + 1
           is(count) = is_south2; ie(count) = ie_south2
           js(count) = js_south2; je(count) = je_south2
           dir(count) = 2
           rotation(count) = zero
        endif
 
        if(my_pe == pe_west0) then
           count = count + 1
           is(count) = is_west0; ie(count) = ie_west0
           js(count) = js_west0; je(count) = je_west0
           dir(count) = 3
           rotation(count) = one_hundred_eighty
        endif
        if(my_pe == pe_west1) then
           count = count + 1
           is(count) = is_west1; ie(count) = ie_west1
           js(count) = js_west1; je(count) = je_west1
           dir(count) = 3
           rotation(count) = zero
        endif
        if(my_pe == pe_west2) then
           count = count + 1
           is(count) = is_west2; ie(count) = ie_west2
           js(count) = js_west2; je(count) = je_west2
           dir(count) = 3
           rotation(count) = zero
        endif
 
        if(count >0) then
           nsend = nsend + 1
           if(nsend > nlist_send)  call mpp_error(fatal, "set_bound_overlap: nsend > nlist_send")
           bound%send(nsend)%count = count
           bound%send(nsend)%pe    = my_pe
           if (associated(bound%send(nsend)%is)) deallocate(bound%send(nsend)%is) !< Check if allocated
           if (associated(bound%send(nsend)%ie)) deallocate(bound%send(nsend)%ie) !< Check if allocated
           if (associated(bound%send(nsend)%js)) deallocate(bound%send(nsend)%js) !< Check if allocated
           if (associated(bound%send(nsend)%je)) deallocate(bound%send(nsend)%je) !< Check if allocated
           if (associated(bound%send(nsend)%dir)) deallocate(bound%send(nsend)%dir) !< Check if allocated
           if (associated(bound%send(nsend)%rotation)) deallocate(bound%send(nsend)%rotation) !< Check if allocated
           if (associated(bound%send(nsend)%tileMe)) deallocate(bound%send(nsend)%tileMe) !< Check if allocated
           allocate(bound%send(nsend)%is(count),  bound%send(nsend)%ie(count) )
           allocate(bound%send(nsend)%js(count),  bound%send(nsend)%je(count) )
           allocate(bound%send(nsend)%dir(count), bound%send(nsend)%rotation(count) )
           allocate(bound%send(nsend)%tileMe(count))
           bound%send(nsend)%is(:)       = is(1:count)
           bound%send(nsend)%ie(:)       = ie(1:count)
           bound%send(nsend)%js(:)       = js(1:count)
           bound%send(nsend)%je(:)       = je(1:count)
           bound%send(nsend)%dir(:)      = dir(1:count)
           bound%send(nsend)%tileMe(:)   = 1
           bound%send(nsend)%rotation(:) = rotation(1:count)
        endif
     enddo
  else
     !--- The following did not consider wide halo case.
     do m = 1, update%nsend
        overlap => update%send(m)
        if( overlap%count == 0 ) cycle
        count = 0
        do n = 1, overlap%count
           !--- currently not support folded-north
           if( overlap%rotation(n) == one_hundred_eighty ) cycle
           if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 1) then ! east
              count=count+1
              dir(count) = 1
              rotation(count) = overlap%rotation(n)
              tileme(count)   = overlap%tileMe(n)
              select case( rotation(count) )
              case( zero ) ! W -> E
                 is(count) = overlap%is(n) - 1
                 ie(count) = is(count)
                 js(count) = overlap%js(n)
                 je(count) = overlap%je(n)
              case( ninety ) ! S -> E
                 is(count) = overlap%is(n)
                 ie(count) = overlap%ie(n)
                 js(count) = overlap%js(n) - 1
                 je(count) = js(count)
              end select
           end if
           if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 3 ) then ! south
              count=count+1
              dir(count) = 2
              rotation(count) = overlap%rotation(n)
              tileme(count)   = overlap%tileMe(n)
              select case( rotation(count) )
              case( zero ) ! N->S
                 is(count) = overlap%is(n)
                 ie(count) = overlap%ie(n)
                 js(count) = overlap%je(n) + 1
                 je(count) = js(count)
              case( minus_ninety ) ! E->S
                 is(count) = overlap%ie(n) + 1
                 ie(count) = is(count)
                 js(count) = overlap%js(n)
                 je(count) = overlap%je(n)
              end select
           end if
           if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 5 ) then ! west
              count=count+1
              dir(count) = 3
              rotation(count) = overlap%rotation(n)
              tileme(count) = overlap%tileMe(n)
              select case( rotation(count) )
              case( zero ) ! E->W
                 is(count) = overlap%ie(n) + 1
                 ie(count) = is(count)
                 js(count) = overlap%js(n)
                 je(count) = overlap%je(n)
              case( ninety ) ! N->W
                 is(count) = overlap%is(n)
                 ie(count) = overlap%ie(n)
                 js(count) = overlap%je(n) + 1
                 je(count) = js(count)
              end select
           end if
           if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 7 ) then ! north
              count=count+1
              dir(count) = 4
              rotation(count) = overlap%rotation(n)
              tileme(count) = overlap%tileMe(n)
              select case( rotation(count) )
              case( zero ) ! S->N
                 is(count) = overlap%is(n)
                 ie(count) = overlap%ie(n)
                 js(count) = overlap%js(n) - 1
                 je(count) = js(count)
              case( minus_ninety ) ! W->N
                 is(count) = overlap%is(n) - 1
                 ie(count) = is(count)
                 js(count) = overlap%js(n)
                 je(count) = overlap%je(n)
              end select
           end if
        end do ! do n =1, overlap%count
     if(count>0) then
        nsend = nsend + 1
        bound%send(nsend)%count = count
        bound%send(nsend)%pe    = overlap%pe
        if (associated(bound%send(nsend)%is)) deallocate(bound%send(nsend)%is) !< Check if allocated
        if (associated(bound%send(nsend)%ie)) deallocate(bound%send(nsend)%ie) !< Check if allocated
        if (associated(bound%send(nsend)%js)) deallocate(bound%send(nsend)%js) !< Check if allocated
        if (associated(bound%send(nsend)%je)) deallocate(bound%send(nsend)%je) !< Check if allocated
        if (associated(bound%send(nsend)%dir)) deallocate(bound%send(nsend)%dir) !< Check if allocated
        if (associated(bound%send(nsend)%rotation)) deallocate(bound%send(nsend)%rotation) !< Check if allocated
        if (associated(bound%send(nsend)%tileMe)) deallocate(bound%send(nsend)%tileMe) !< Check if allocated
        allocate(bound%send(nsend)%is(count),  bound%send(nsend)%ie(count) )
        allocate(bound%send(nsend)%js(count),  bound%send(nsend)%je(count) )
        allocate(bound%send(nsend)%dir(count), bound%send(nsend)%rotation(count) )
        allocate(bound%send(nsend)%tileMe(count))
        bound%send(nsend)%is(:)       = is(1:count)
        bound%send(nsend)%ie(:)       = ie(1:count)
        bound%send(nsend)%js(:)       = js(1:count)
        bound%send(nsend)%je(:)       = je(1:count)
        bound%send(nsend)%dir(:)      = dir(1:count)
        bound%send(nsend)%tileMe(:)   = tileme(1:count)
        bound%send(nsend)%rotation(:) = rotation(1:count)
     end if
  end do ! end  do list = 0, nlist
  endif
 
  !--- loop over the list of domains to find the boundary overlap for recv
  bound%nsend = nsend
  nrecvl(:,:) = 0
  nrecv       = 0
 
  !--- will computing overlap for tripolar grid.
  if( domain%ntiles == 1 ) then
     ! currently only set up for west and south boundary
 
     ! south boundary for recv
     pe_south1 = null_pe; pe_south2 = null_pe
     if( position == north .OR. position == corner ) then
        inbr = ipos; jnbr = jpos - 1
        if( jnbr == -1 .AND. y_cyclic) jnbr = npes_y-1
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_south1 = domain%pearray(inbr,jnbr)
           is_south1 = isc + ishift; ie_south1 = iec+ishift
           js_south1 = jsc;          je_south1 = js_south1
        endif
     endif
 
     !--- south boudary for recv:  the southwest point when position is NORTH
     if( position == corner ) then
        inbr = ipos - 1; jnbr = jpos - 1
        if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
        if( jnbr == -1 .AND. y_cyclic) jnbr = npes_y-1
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_south2 = domain%pearray(inbr,jnbr)
           is_south2 = isc; ie_south2 = is_south2
           js_south2 = jsc; je_south2 = js_south2
        endif
     endif
 
 
     !---west boundary for recv
     pe_west0 = null_pe; pe_west1 = null_pe; pe_west2 = null_pe
     if( position == east ) then
        inbr = ipos-1; jnbr = jpos
        if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_west1 = domain%pearray(inbr,jnbr)
           is_west1 = isc;          ie_west1 = is_west1
           js_west1 = jsc + jshift; je_west1 = jec + jshift
        endif
     else if ( position == corner ) then  ! possible split into two parts.
        !--- on the fold.
        if( folded_north .AND. jec == jeg .AND. ipos .GT. npes_x/2 ) then
           inbr = npes_x - ipos - 1; jnbr = jpos
           if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
               pe_west0 = domain%pearray(inbr,jnbr)
               is_west0 = isc;        ie_west0 = is_west0
               js_west0 = jec+jshift; je_west0 = js_west0
           endif
           inbr = ipos-1; jnbr = jpos
           if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
           if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
              pe_west1 = domain%pearray(inbr,jnbr)
              is_west1 = isc;          ie_west1 = is_west1
              js_west1 = jsc + jshift; je_west1 = jec
           endif
        else
           inbr = ipos-1; jnbr = jpos
           if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
           if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
              pe_west1 = domain%pearray(inbr,jnbr)
              is_west1 = isc;          ie_west1 = is_west1
              js_west1 = jsc + jshift; je_west1 = jec+jshift
           endif
        endif
     endif
 
     !--- west boundary for recv: the southwest point when position is CORNER
     if( position == corner ) then
        inbr = ipos - 1; jnbr = jpos - 1
        if( inbr == -1 .AND. x_cyclic) inbr = npes_x - 1
        if( jnbr == -1 .AND. y_cyclic) jnbr = npes_y - 1
        if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) then
           pe_west2 = domain%pearray(inbr,jnbr)
           is_west2 = isc; ie_west2 = is_west2
           js_west2 = jsc; je_west2 = js_west2
        endif
     endif
 
     tme = 1
     do list = 0,nlist-1
        m = mod( domain%pos+nlist-list, nlist )
        count = 0
        my_pe = domain%list(m)%pe
        if(my_pe == pe_south1) then
           count = count + 1
           is(count) = is_south1; ie(count) = ie_south1
           js(count) = js_south1; je(count) = je_south1
           dir(count) = 2
           rotation(count) = zero
           index(count) = 1 + ishift
        endif
        if(my_pe == pe_south2) then
           count = count + 1
           is(count) = is_south2; ie(count) = ie_south2
           js(count) = js_south2; je(count) = je_south2
           dir(count) = 2
           rotation(count) = zero
           index(count) = 1
        endif
        if(my_pe == pe_west0) then
           count = count + 1
           is(count) = is_west0; ie(count) = ie_west0
           js(count) = js_west0; je(count) = je_west0
           dir(count) = 3
           rotation(count) = one_hundred_eighty
           index(count) = jec-jsc+1+jshift
        endif
        if(my_pe == pe_west1) then
           count = count + 1
           is(count) = is_west1; ie(count) = ie_west1
           js(count) = js_west1; je(count) = je_west1
           dir(count) = 3
           rotation(count) = zero
           index(count) = 1 + jshift
        endif
        if(my_pe == pe_west2) then
           count = count + 1
           is(count) = is_west2; ie(count) = ie_west2
           js(count) = js_west2; je(count) = je_west2
           dir(count) = 3
           rotation(count) = zero
           index(count) = 1
        endif
 
        if(count >0) then
           nrecv = nrecv + 1
           if(nrecv > nlist_recv) call mpp_error(fatal, "set_bound_overlap: nrecv > nlist_recv")
           bound%recv(nrecv)%count = count
           bound%recv(nrecv)%pe    = my_pe
           if (associated(bound%recv(nrecv)%is)) deallocate(bound%recv(nrecv)%is) !< Check if allocated
           if (associated(bound%recv(nrecv)%ie)) deallocate(bound%recv(nrecv)%ie) !< Check if allocated
           if (associated(bound%recv(nrecv)%js)) deallocate(bound%recv(nrecv)%js) !< Check if allocated
           if (associated(bound%recv(nrecv)%je)) deallocate(bound%recv(nrecv)%je) !< Check if allocated
           if (associated(bound%recv(nrecv)%dir)) deallocate(bound%recv(nrecv)%dir) !< Check if allocated
           if (associated(bound%recv(nrecv)%index)) deallocate(bound%recv(nrecv)%index) !< Check if allocated
           if (associated(bound%recv(nrecv)%tileMe)) deallocate(bound%recv(nrecv)%tileMe) !< Check if allocated
           if (associated(bound%recv(nrecv)%rotation)) deallocate(bound%recv(nrecv)%rotation) !< Check if allocated
           allocate(bound%recv(nrecv)%is(count),     bound%recv(nrecv)%ie(count) )
           allocate(bound%recv(nrecv)%js(count),     bound%recv(nrecv)%je(count) )
           allocate(bound%recv(nrecv)%dir(count),    bound%recv(nrecv)%index(count)  )
           allocate(bound%recv(nrecv)%tileMe(count), bound%recv(nrecv)%rotation(count) )
 
           bound%recv(nrecv)%is(:)       = is(1:count)
           bound%recv(nrecv)%ie(:)       = ie(1:count)
           bound%recv(nrecv)%js(:)       = js(1:count)
           bound%recv(nrecv)%je(:)       = je(1:count)
           bound%recv(nrecv)%dir(:)      = dir(1:count)
           bound%recv(nrecv)%tileMe(:)   = 1
           bound%recv(nrecv)%rotation(:) = rotation(1:count)
           bound%recv(nrecv)%index(:)        = index(1:count)
        endif
     enddo
  else
     do m = 1, update%nrecv
        overlap => update%recv(m)
        if( overlap%count == 0 ) cycle
        count = 0
        do n = 1, overlap%count
           !--- currently not support folded-north
           if( overlap%rotation(n) == one_hundred_eighty ) cycle
           if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 1) then ! east
              count=count+1
              dir(count) = 1
              rotation(count) = overlap%rotation(n)
              tileme(count)   = overlap%tileMe(n)
              is(count) = overlap%is(n) - 1
              ie(count) = is(count)
              js(count) = overlap%js(n)
              je(count) = overlap%je(n)
              tme                        = tileme(count)
              nrecvl(tme, 1) = nrecvl(tme,1) + 1
              isl(tme,1,nrecvl(tme, 1)) = is(count)
              iel(tme,1,nrecvl(tme, 1)) = ie(count)
              jsl(tme,1,nrecvl(tme, 1)) = js(count)
              jel(tme,1,nrecvl(tme, 1)) = je(count)
           end if
 
           if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 3) then ! south
              count=count+1
              dir(count) = 2
              rotation(count) = overlap%rotation(n)
              tileme(count)   = overlap%tileMe(n)
              is(count) = overlap%is(n)
              ie(count) = overlap%ie(n)
              js(count) = overlap%je(n) + 1
              je(count) = js(count)
              tme                        = tileme(count)
              nrecvl(tme, 2) = nrecvl(tme,2) + 1
              isl(tme,2,nrecvl(tme, 2)) = is(count)
              iel(tme,2,nrecvl(tme, 2)) = ie(count)
              jsl(tme,2,nrecvl(tme, 2)) = js(count)
              jel(tme,2,nrecvl(tme, 2)) = je(count)
           end if
 
           if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 5) then ! west
              count=count+1
              dir(count) = 3
              rotation(count) = overlap%rotation(n)
              tileme(count)   = overlap%tileMe(n)
              is(count) = overlap%ie(n) + 1
              ie(count) = is(count)
              js(count) = overlap%js(n)
              je(count) = overlap%je(n)
              tme                        = tileme(count)
              nrecvl(tme, 3) = nrecvl(tme,3) + 1
              isl(tme,3,nrecvl(tme, 3)) = is(count)
              iel(tme,3,nrecvl(tme, 3)) = ie(count)
              jsl(tme,3,nrecvl(tme, 3)) = js(count)
              jel(tme,3,nrecvl(tme, 3)) = je(count)
           end if
 
           if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 7) then ! north
              count=count+1
              dir(count) = 4
              rotation(count) = overlap%rotation(n)
              tileme(count) = overlap%tileMe(n)
              is(count) = overlap%is(n)
              ie(count) = overlap%ie(n)
              js(count) = overlap%js(n) - 1
              je(count) = js(count)
              tme                        = tileme(count)
              nrecvl(tme, 4) = nrecvl(tme,4) + 1
              isl(tme,4,nrecvl(tme, 4)) = is(count)
              iel(tme,4,nrecvl(tme, 4)) = ie(count)
              jsl(tme,4,nrecvl(tme, 4)) = js(count)
              jel(tme,4,nrecvl(tme, 4)) = je(count)
           end if
        end do ! do n = 1, overlap%count
        if(count>0) then
           nrecv = nrecv + 1
           bound%recv(nrecv)%count = count
           bound%recv(nrecv)%pe    = overlap%pe
           if (associated(bound%recv(nrecv)%is)) deallocate(bound%recv(nrecv)%is) !< Check if allocated
           if (associated(bound%recv(nrecv)%ie)) deallocate(bound%recv(nrecv)%ie) !< Check if allocated
           if (associated(bound%recv(nrecv)%js)) deallocate(bound%recv(nrecv)%js) !< Check if allocated
           if (associated(bound%recv(nrecv)%je)) deallocate(bound%recv(nrecv)%je) !< Check if allocated
           if (associated(bound%recv(nrecv)%dir)) deallocate(bound%recv(nrecv)%dir) !< Check if allocated
           if (associated(bound%recv(nrecv)%index)) deallocate(bound%recv(nrecv)%index) !< Check if allocated
           if (associated(bound%recv(nrecv)%tileMe)) deallocate(bound%recv(nrecv)%tileMe) !< Check if allocated
           if (associated(bound%recv(nrecv)%rotation)) deallocate(bound%recv(nrecv)%rotation) !< Check if allocated
           allocate(bound%recv(nrecv)%is(count),     bound%recv(nrecv)%ie(count) )
           allocate(bound%recv(nrecv)%js(count),     bound%recv(nrecv)%je(count) )
           allocate(bound%recv(nrecv)%dir(count),    bound%recv(nrecv)%index(count)  )
           allocate(bound%recv(nrecv)%tileMe(count), bound%recv(nrecv)%rotation(count) )
           bound%recv(nrecv)%is(:)       = is(1:count)
           bound%recv(nrecv)%ie(:)       = ie(1:count)
           bound%recv(nrecv)%js(:)       = js(1:count)
           bound%recv(nrecv)%je(:)       = je(1:count)
           bound%recv(nrecv)%dir(:)      = dir(1:count)
           bound%recv(nrecv)%tileMe(:)   = tileme(1:count)
           bound%recv(nrecv)%rotation(:) = rotation(1:count)
        end if
     end do ! end  do list = 0, nlist
     !--- find the boundary index for each contact within the east boundary
     do m = 1, nrecv
        do n = 1, bound%recv(m)%count
           tme = bound%recv(m)%tileMe(n)
           dr = bound%recv(m)%dir(n)
           bound%recv(m)%index(n) = 1
           do l = 1, nrecvl(tme,dr)
              if(dr == 1 .OR. dr == 3) then  ! EAST, WEST
                 if( bound%recv(m)%js(n) > jsl(tme, dr, l) ) then
                    if( bound%recv(m)%rotation(n) == one_hundred_eighty ) then
                       bound%recv(m)%index(n) = bound%recv(m)%index(n)                  + &
                            max(abs(jel(tme, dr, l)-jsl(tme, dr, l))+1, &
                            abs(iel(tme, dr, l)-isl(tme, dr, l))+1)
                    else
                       bound%recv(m)%index(n) = bound%recv(m)%index(n)                  + &
                            max(abs(jel(tme, dr, l)-jsl(tme, dr, l)), &
                            abs(iel(tme, dr, l)-isl(tme, dr, l))) + 1 - jshift
                    endif
                 end if
              else                             ! South, North
                 if( bound%recv(m)%is(n) > isl(tme, dr, l) ) then
                    bound%recv(m)%index(n) = bound%recv(m)%index(n)                  + &
                         max(abs(jel(tme, dr, l)-jsl(tme, dr, l)), &
                         abs(iel(tme, dr, l)-isl(tme, dr, l))) + 1 - ishift
                 end if
              end if
           end do
        end do
     end do
 
  endif
  bound%nrecv = nrecv
 
 
end subroutine set_bound_overlap
 
 
!#############################################################################
 
subroutine fill_corner_contact(eCont, sCont, wCont, nCont, isg, ieg, jsg, jeg, numR, numS, tileRecv, tileSend, &
 is1Recv, ie1Recv, js1Recv, je1Recv, is2Recv, ie2Recv, js2Recv, je2Recv,         &
 is1Send, ie1Send, js1Send, je1Send, is2Send, ie2Send, js2Send, je2Send,         &
 align1Recv, align2Recv, align1Send, align2Send,                                 &
 whalo, ehalo, shalo, nhalo, tileMe)
type(contact_type), dimension(:), intent(in) :: eCont, sCont, wCont, nCont
integer, dimension(:),            intent(in) :: isg, ieg, jsg, jeg
integer,                       intent(inout) :: numR, numS
integer, dimension(:),         intent(inout) :: tileRecv, tileSend
integer, dimension(:),         intent(inout) :: is1Recv, ie1Recv, js1Recv, je1Recv
integer, dimension(:),         intent(inout) :: is2Recv, ie2Recv, js2Recv, je2Recv
integer, dimension(:),         intent(inout) :: is1Send, ie1Send, js1Send, je1Send
integer, dimension(:),         intent(inout) :: is2Send, ie2Send, js2Send, je2Send
integer, dimension(:),         intent(inout) :: align1Recv, align2Recv, align1Send, align2Send
integer,                          intent(in) :: tileMe, whalo, ehalo, shalo, nhalo
integer                                      :: is1, ie1, js1, je1, is2, ie2, js2, je2
integer                                      :: tn, tc, n, m
logical                                      :: found_corner
 
found_corner = .false.
!--- southeast for recving
if(econt(tileme)%ncontact > 0) then
 if(econt(tileme)%js1(1) == jsg(tileme) ) then
    tn = econt(tileme)%tile(1)
    if(econt(tileme)%js2(1) > jsg(tn) ) then  ! the corner tile is tn.
       if( econt(tileme)%js2(1) - jsg(tn) < shalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southeast tile for recv 1 is not tiled properly")
       found_corner = .true.; tc = tn
       is1 = econt(tileme)%ie1(1) + 1; je1 = econt(tileme)%js1(1) - 1
       is2 = econt(tileme)%is2(1);     je2 = econt(tileme)%js2(1) - 1
    else if(scont(tn)%ncontact >0) then ! the corner tile may be south tile of tn.
       if(scont(tn)%is1(1) == isg(tn)) then ! corner is nc.
          found_corner = .true.; tc = scont(tn)%tile(1)
          is1 = econt(tileme)%ie1(1) + 1; je1 = econt(tileme)%js1(1) - 1
          is2 = scont(tn)%is2(1);         je2 = scont(tn)%je2(1)
       end if
    end if
 end if
end if
if( .not. found_corner ) then  ! not found,
 n = scont(tileme)%ncontact
 if( n > 0) then
    if( scont(tileme)%ie1(n) == ieg(tileme)) then
       tn = scont(tileme)%tile(n)
       if(scont(tileme)%ie2(n) < ieg(tn) ) then  ! the corner tile is tn.
          if(ieg(tn) - scont(tileme)%ie2(n) < ehalo ) call mpp_error(fatal, &
               "mpp_domains_define.inc: southeast tile for recv 2 is not tiled properly")
          found_corner = .true.; tc = tn
          is1 = scont(tileme)%ie1(n) + 1; je1 = scont(tileme)%js1(n) - 1
          is2 = scont(tileme)%ie2(n) + 1; je2 = scont(tileme)%je2(n)
       else if(econt(tn)%ncontact >0) then ! the corner tile may be east tile of tn.
          m = econt(tn)%ncontact
          if(econt(tn)%je1(m) == jeg(tn)) then ! corner is nc.
             found_corner = .true.; tc = econt(tn)%tile(m)
             is1 = scont(tileme)%ie1(n) + 1; je1 = scont(tileme)%js1(n) - 1
             is2 = econt(tn)%is2(m);         je2 = econt(tn)%je2(m)
          end if
       end if
    end if
 end if
end if
if(found_corner) then
 numr = numr + 1
 tilerecv(numr) = tc; align1recv(numr) = south_east;  align2recv(numr) = north_west
 is1recv(numr) = is1;             ie1recv(numr) = is1 + ehalo - 1
 js1recv(numr) = je1 - shalo + 1; je1recv(numr) = je1
 is2recv(numr) = is2;             ie2recv(numr) = is2 + ehalo - 1
 js2recv(numr) = je2 - shalo + 1; je2recv(numr) = je2
end if
 
!--- southwest for recving
found_corner = .false.
if(wcont(tileme)%ncontact > 0) then
 if(wcont(tileme)%js1(1) == jsg(tileme) ) then
    tn = wcont(tileme)%tile(1)
    if(wcont(tileme)%js2(1) > jsg(tn) ) then  ! the corner tile is tn.
       if( wcont(tileme)%js2(1) - jsg(tn) < shalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southwest tile for recv 1 is not tiled properly")
       found_corner = .true.; tc = tn
       ie1 = wcont(tileme)%is1(1) - 1; je1 = wcont(tileme)%js1(1) - 1
       ie2 = wcont(tileme)%is2(1);     je2 = wcont(tileme)%js2(1) - 1
    else if(scont(tn)%ncontact >0) then ! the corner tile may be south tile of tn.
       n = scont(tn)%ncontact
       if(scont(tn)%ie1(n) == ieg(tn)) then ! corner is nc.
          found_corner = .true.;  tc = scont(tn)%tile(n)
          ie1 = wcont(tileme)%is1(1) - 1; je1 = wcont(tileme)%js1(1) - 1
          ie2 = scont(tn)%ie2(1);         je2 = scont(tn)%je2(1)
       end if
    end if
 end if
end if
if( .not. found_corner ) then  ! not found,
 n = scont(tileme)%ncontact
 if( n > 0) then
    if( scont(tileme)%is1(1) == isg(tileme)) then
       tn = scont(tileme)%tile(1)
       if(scont(tileme)%is2(1) > isg(tn) ) then  ! the corner tile is tn.
          if( scont(tileme)%is2(1)-isg(tn) < whalo ) call mpp_error(fatal, &
               "mpp_domains_define.inc: southwest tile for recv 1 is not tiled properly")
          found_corner = .true.; tc = tn
          ie1 = scont(tileme)%is1(1) - 1; je1 = scont(tileme)%js1(1) - 1
          ie2 = scont(tileme)%is2(1) - 1; je2 = scont(tileme)%js2(1)
       else if(wcont(tn)%ncontact >0) then ! the corner tile may be west tile of tn.
          m = wcont(tn)%ncontact
          if(wcont(tn)%je1(m) == jeg(tn)) then ! corner is nc.
             found_corner = .true.; tc = wcont(tn)%tile(m)
             ie1 = scont(tileme)%is1(1) - 1; je1 = scont(tileme)%js1(1) - 1
             ie2 = wcont(tn)%ie2(m);         je2 = wcont(tn)%je2(m)
          end if
       end if
    end if
 end if
end if
if(found_corner) then
 numr = numr + 1
 tilerecv(numr) = tc; align1recv(numr) = south_west; align2recv(numr) = north_east
 is1recv(numr) = ie1 - whalo + 1; ie1recv(numr) = ie1
 js1recv(numr) = je1 - shalo + 1; je1recv(numr) = je1
 is2recv(numr) = ie2 - whalo + 1; ie2recv(numr) = ie2
 js2recv(numr) = je2 - shalo + 1; je2recv(numr) = je2
end if
 
!--- northwest for recving
found_corner = .false.
n = wcont(tileme)%ncontact
if( n > 0) then
 if(wcont(tileme)%je1(n) == jeg(tileme) ) then
    tn = wcont(tileme)%tile(n)
    if(wcont(tileme)%je2(n) < jeg(tn) ) then  ! the corner tile is tn.
       if( jeg(tn) - wcont(tileme)%je2(n) < nhalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: northwest tile for recv 1 is not tiled properly")
       found_corner = .true.; tc = tn
       ie1 = wcont(tileme)%is1(n) - 1; js1 = wcont(tileme)%je1(n) + 1
       ie2 = wcont(tileme)%is2(n);     js2 = wcont(tileme)%je2(n) + 1
    else if(ncont(tn)%ncontact >0) then ! the corner tile may be south tile of tn.
       m = ncont(tn)%ncontact
       if(ncont(tn)%ie1(m) == ieg(tn)) then ! corner is nc.
          found_corner = .true.; tc = ncont(tn)%tile(m)
          ie1 = wcont(tileme)%is1(n) - 1; js1 = wcont(tileme)%je1(n) + 1
          ie2 = ncont(tn)%ie2(m);         js2 = ncont(tn)%js2(m)
       end if
    endif
 endif
end if
if( .not. found_corner ) then  ! not found,
 if( ncont(tileme)%ncontact > 0) then
    if( ncont(tileme)%is1(1) == isg(tileme)) then
       tn = ncont(tileme)%tile(1)
       if(ncont(tileme)%is2(1) > isg(tn) ) then  ! the corner tile is tn.
          if( ncont(tileme)%is2(1)-isg(tn) < whalo ) call mpp_error(fatal, &
               "mpp_domains_define.inc: northwest tile for recv 2 is not tiled properly")
          found_corner = .true.; tc = tn
          ie1 = ncont(tileme)%is1(1) - 1; js1 = ncont(tileme)%je1(1) + 1
          ie2 = ncont(tileme)%is2(1) - 1; js2 = ncont(tileme)%js2(1)
       else if(wcont(tn)%ncontact >0) then ! the corner tile may be west tile of tn.
          if(wcont(tn)%js1(1) == jsg(tn)) then ! corner is nc.
             found_corner = .true.; tc = wcont(tn)%tile(1)
             ie1 = ncont(tileme)%is1(1) - 1; js1 = ncont(tileme)%je1(1) + 1
             ie2 = wcont(tn)%ie2(1);         js2 = wcont(tn)%js2(1)
          end if
       end if
    end if
 end if
end if
if(found_corner) then
 numr = numr + 1
 tilerecv(numr) = tc; align1recv(numr) =north_west;  align2recv(numr) = south_east
 is1recv(numr) = ie1 - whalo + 1; ie1recv(numr) = ie1
 js1recv(numr) = js1;             je1recv(numr) = js1 + nhalo - 1
 is2recv(numr) = ie2 - whalo + 1; ie2recv(numr) = ie2
 js2recv(numr) = js2;             je2recv(numr) = js2 + nhalo - 1
end if
 
!--- northeast for recving
found_corner = .false.
n = econt(tileme)%ncontact
if( n > 0) then
 if(econt(tileme)%je1(n) == jeg(tileme) ) then
    tn = econt(tileme)%tile(n)
    if(econt(tileme)%je2(n) < jeg(tn) ) then  ! the corner tile is tn.
       if( jeg(tn) - econt(tileme)%je2(n) < nhalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: northeast tile for recv 1 is not tiled properly")
       found_corner = .true.; tc = tn
       is1 = econt(tileme)%ie1(n) + 1; js1 = econt(tileme)%je1(n) + 1
       is2 = econt(tileme)%is2(1);     js2 = econt(tileme)%je2(1) + 1
    else if(ncont(tn)%ncontact >0) then ! the corner tile may be south tile of tn.
       if(ncont(tn)%is1(1) == isg(tn)) then ! corner is nc.
          found_corner = .true.; tc = ncont(tn)%tile(1)
          is1 = econt(tileme)%ie1(n) + 1; js1 = econt(tileme)%je1(n) + 1
          is2 = ncont(tn)%is2(1);         js2 = ncont(tn)%js2(1)
       end if
    end if
 end if
end if
if( .not. found_corner ) then  ! not found,
 n = ncont(tileme)%ncontact
 if( n > 0) then
    if( ncont(tileme)%ie1(n) == ieg(tileme)) then
       tn = ncont(tileme)%tile(n)
       if(ncont(tileme)%ie2(n) < ieg(tn) ) then  ! the corner tile is tn.
          if(ieg(tn) - scont(tileme)%ie2(n) < ehalo ) call mpp_error(fatal, &
               "mpp_domains_define.inc: northeast tile for recv 2 is not tiled properly")
          found_corner = .true.; tc = tn
          is1 = scont(tileme)%ie1(n) + 1; js1 = scont(tileme)%je1(n) + 1
          is2 = scont(tileme)%ie2(n) + 1; js2 = scont(tileme)%js2(n)
       else if(econt(tn)%ncontact >0) then ! the corner tile may be east tile of tn.
          if(econt(tn)%js1(1) == jsg(tn)) then ! corner is nc.
             found_corner = .true.; tc = econt(tn)%tile(1)
             is1 = scont(tileme)%ie1(n) + 1; js1 = scont(tileme)%je1(n) + 1
             is2 = econt(tn)%is2(m);         js2 = econt(tn)%js2(m)
          end if
       end if
    end if
 end if
end if
if(found_corner) then
 numr = numr + 1
 tilerecv(numr) = tc; align1recv(numr) =north_east;  align2recv(numr) = south_west
 is1recv(numr) = is1; ie1recv(numr) = is1 + ehalo - 1
 js1recv(numr) = js1; je1recv(numr) = js1 + nhalo - 1
 is2recv(numr) = is2; ie2recv(numr) = is2 + ehalo - 1
 js2recv(numr) = js2; je2recv(numr) = js2 + nhalo - 1
end if
 
!--- to_pe's southeast for sending
do n = 1, wcont(tileme)%ncontact
 tn = wcont(tileme)%tile(n)
 if(wcont(tileme)%js2(n) == jsg(tn) ) then
    if(wcont(tileme)%js1(n) > jsg(tileme) ) then  ! send to  tile tn.
       if( wcont(tileme)%js1(n) - jsg(tileme) < shalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southeast tile for send 1 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = north_west;  align2send(nums) = south_east
       is1send(nums) = wcont(tileme)%is1(n);     ie1send(nums) = is1send(nums) + ehalo - 1
       je1send(nums) = wcont(tileme)%js1(n) - 1; js1send(nums) = je1send(nums) - shalo + 1
       is2send(nums) = wcont(tileme)%ie2(n) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
       je2send(nums) = wcont(tileme)%js2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
    end if
 end if
end do
do n = 1, ncont(tileme)%ncontact
 tn = ncont(tileme)%tile(n)
 if(ncont(tileme)%ie2(n) == ieg(tn) ) then
    if(ncont(tileme)%ie1(n) < ieg(tileme) ) then  ! send to  tile tn.
       if( ieg(tileme) - ncont(tileme)%ie1(n) < ehalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southeast tile for send 2 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = north_west;  align2send(nums) = south_east
       is1send(nums) = ncont(tileme)%ie1(n) + 1; ie1send(nums) = is1send(nums) + ehalo - 1
       je1send(nums) = ncont(tileme)%je1(n)    ; js1send(nums) = je1send(nums) - shalo + 1
       is2send(nums) = ncont(tileme)%ie2(n) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
       je2send(nums) = ncont(tileme)%je2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
    end if
 end if
end do
 
!--- found the corner overlap that is not specified through contact line.
n = wcont(tileme)%ncontact
found_corner = .false.
if( n > 0) then
 tn = wcont(tileme)%tile(n)
 if( wcont(tileme)%je1(n) == jeg(tileme) .AND. wcont(tileme)%je2(n) == jeg(tn) ) then
    m = ncont(tn)%ncontact
    if(m >0) then
       tc = ncont(tn)%tile(m)
       if( ncont(tn)%ie1(m) == ieg(tn) .AND. ncont(tn)%ie2(m) == ieg(tc) ) found_corner = .true.
    end if
 end if
end if
if( .not. found_corner ) then  ! not found, then starting from north contact
 if( ncont(tileme)%ncontact > 0) then
    tn = ncont(tileme)%tile(1)
    if( ncont(tileme)%is1(1) == isg(tileme) .AND. ncont(tileme)%is2(1) == isg(tn) ) then
       if(wcont(tn)%ncontact >0) then
          tc = wcont(tn)%tile(1)
          if( wcont(tn)%js1(1) == jsg(tn) .AND. wcont(tn)%js2(1) == jsg(tc) ) found_corner = .true.
       end if
    end if
 end if
end if
 
if(found_corner) then
 nums = nums+1; tilesend(nums) = tc
 align1send(nums) = north_west;  align2send(nums) = south_east
 is1send(nums) = isg(tileme); ie1send(nums) = is1send(nums) + ehalo - 1
 je1send(nums) = jeg(tileme); js1send(nums) = je1send(nums) - shalo + 1
 is2send(nums) = ieg(tc) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 je2send(nums) = jsg(tc) - 1; js2send(nums) = je2send(nums) - shalo + 1
end if
 
!--- to_pe's southwest for sending
do n = 1, econt(tileme)%ncontact
 tn = econt(tileme)%tile(n)
 if(econt(tileme)%js2(n) == jsg(tn) ) then
    if(econt(tileme)%js1(n) > jsg(tileme) ) then  ! send to  tile tn.
       if( econt(tileme)%js1(n) - jsg(tileme) < shalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southwest tile for send 1 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = north_east;  align2send(nums) = south_west
       ie1send(nums) = econt(tileme)%ie1(n);     is1send(nums) = ie1send(nums) - whalo + 1
       je1send(nums) = econt(tileme)%js1(n) - 1; js1send(nums) = je1send(nums) - shalo + 1
       ie2send(nums) = econt(tileme)%is2(n) - 1; is2send(nums) = ie2send(nums) - whalo + 1
       je2send(nums) = econt(tileme)%js2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
    end if
 end if
end do
do n = 1, ncont(tileme)%ncontact
 tn = ncont(tileme)%tile(n)
 if(ncont(tileme)%is2(n) == isg(tn) ) then
    if(ncont(tileme)%is1(n) > isg(tileme) ) then  ! send to  tile tn.
       if( ncont(tileme)%is1(n) - isg(tileme) < whalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southwest tile for send 2 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = north_east;  align2send(nums) = south_west
       ie1send(nums) = ncont(tileme)%is1(n) - 1; is1send(nums) = ie1send(nums) - whalo + 1
       ie1send(nums) = ncont(tileme)%je1(n)    ; js1send(nums) = je1send(nums) - shalo + 1
       ie2send(nums) = ncont(tileme)%is2(n) - 1; is2send(nums) = je2send(nums) - whalo + 1
       je2send(nums) = ncont(tileme)%js2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
    end if
 end if
end do
 
!--- found the corner overlap that is not specified through contact line.
n = econt(tileme)%ncontact
found_corner = .false.
if( n > 0) then
 tn = econt(tileme)%tile(n)
 if( econt(tileme)%je1(n) == jeg(tileme) .AND. econt(tileme)%je2(n) == jeg(tn) ) then
    if(ncont(tn)%ncontact >0) then
       tc = ncont(tn)%tile(1)
       if( ncont(tn)%is1(1) == isg(tn) .AND. ncont(tn)%is2(n) == isg(tc) ) found_corner = .true.
    end if
 end if
end if
if( .not. found_corner ) then  ! not found, then starting from north contact
 n = ncont(tileme)%ncontact
 if( n > 0) then
    tn = ncont(tileme)%tile(n)
    if( ncont(tileme)%ie1(n) == ieg(tileme) .AND. ncont(tileme)%ie2(n) == ieg(tn) ) then
       if(econt(tn)%ncontact >0) then
          tc = econt(tn)%tile(1)
          if( econt(tn)%js1(1) == jsg(tn) .AND. econt(tn)%js2(n) == jsg(tc) ) found_corner = .true.
       end if
    end if
 end if
end if
 
if(found_corner) then
 nums = nums+1; tilesend(nums) = tc
 align1send(nums) = north_east;  align2send(nums) = south_west
 ie1send(nums) = ieg(tileme); is1send(nums) = ie1send(nums) - whalo + 1
 je1send(nums) = jeg(tileme); js1send(nums) = je1send(nums) - shalo + 1
 ie2send(nums) = isg(tc) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 je2send(nums) = jsg(tc) - 1; js2send(nums) = je2send(nums) - shalo + 1
end if
 
!--- to_pe's northwest for sending
do n = 1, econt(tileme)%ncontact
 tn = econt(tileme)%tile(n)
 if(econt(tileme)%je2(n) == jeg(tn) ) then
    if(econt(tileme)%je1(n) < jeg(tileme) ) then  ! send to  tile tn.
       if( jeg(tileme) - econt(tileme)%je1(n) < nhalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: northwest tile for send 1 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = south_east;  align2send(nums) = north_west
       ie1send(nums) = econt(tileme)%ie1(n)    ; is1send(nums) = ie1send(nums) - whalo + 1
       js1send(nums) = econt(tileme)%je1(n) + 1; je1send(nums) = js1send(nums) + nhalo - 1
       ie2send(nums) = econt(tileme)%is2(n) - 1; is2send(nums) = ie2send(nums) - whalo + 1
       js2send(nums) = econt(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
    end if
 end if
end do
 
do n = 1, scont(tileme)%ncontact
 tn = scont(tileme)%tile(n)
 if(scont(tileme)%is2(n) == isg(tn) ) then
    if(scont(tileme)%is1(n) > isg(tileme) ) then  ! send to  tile tn.
       if( scont(tileme)%is1(n) - isg(tileme) < whalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southwest tile for send 2 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = south_east;  align2send(nums) = north_west
       ie1send(nums) = ncont(tileme)%is1(n) - 1; is1send(nums) = ie1send(nums) - whalo + 1
       js1send(nums) = ncont(tileme)%je1(n)    ; je1send(nums) = js1send(nums) + nhalo - 1
       ie2send(nums) = ncont(tileme)%is2(n) - 1; is2send(nums) = ie2send(nums) - whalo + 1
       js2send(nums) = ncont(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
    end if
 end if
end do
 
!--- found the corner overlap that is not specified through contact line.
n = econt(tileme)%ncontact
found_corner = .false.
if( n > 0) then
 tn = econt(tileme)%tile(1)
 if( econt(tileme)%js1(1) == jsg(tileme) .AND. econt(tileme)%js2(1) == jsg(tn) ) then
    if(scont(tn)%ncontact >0) then
       tc = scont(tn)%tile(1)
       if( scont(tn)%is1(1) == isg(tn) .AND. scont(tn)%is2(1) == isg(tc) ) found_corner = .true.
    end if
 end if
end if
if( .not. found_corner ) then  ! not found, then starting from north contact
 n = scont(tileme)%ncontact
 found_corner = .false.
 if( n > 0) then
    tn = scont(tileme)%tile(n)
    if( scont(tileme)%ie1(n) == ieg(tileme) .AND. scont(tileme)%ie2(n) == ieg(tn) ) then
       if(econt(tn)%ncontact >0) then
          tc = econt(tn)%tile(n)
          if( econt(tn)%je1(n) == jeg(tn) .AND. econt(tn)%je2(n) == jeg(tc) ) found_corner = .true.
       end if
    end if
 end if
end if
 
if(found_corner) then
 nums = nums+1; tilesend(nums) = tc
 align1send(nums) = south_east;  align2send(nums) = north_west
 ie1send(nums) = ieg(tileme); is1send(nums) = ie1send(nums) - whalo + 1
 js1send(nums) = jsg(tileme); je1send(nums) = js1send(nums) + nhalo - 1
 ie2send(nums) = isg(tc) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 js2send(nums) = jeg(tc) + 1; je2send(nums) = js2send(nums) + nhalo - 1
end if
 
!--- to_pe's northeast for sending
do n = 1, wcont(tileme)%ncontact
 tn = wcont(tileme)%tile(n)
 if(wcont(tileme)%je2(n) == jeg(tn) ) then
    if(wcont(tileme)%je1(n) < jeg(tileme) ) then  ! send to  tile tn.
       if( jeg(tileme) - wcont(tileme)%je1(n) < nhalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: northeast tile for send 1 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = south_west;  align2send(nums) = north_east
       is1send(nums) = wcont(tileme)%is1(n)    ; ie1send(nums) = is1send(nums) + ehalo - 1
       js1send(nums) = wcont(tileme)%je1(n) + 1; je1send(nums) = js1send(nums) + nhalo - 1
       is2send(nums) = wcont(tileme)%ie2(n) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
       js2send(nums) = wcont(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
    end if
 end if
end do
 
do n = 1, scont(tileme)%ncontact
 tn = scont(tileme)%tile(n)
 if(scont(tileme)%ie2(n) == ieg(tn) ) then
    if(scont(tileme)%ie1(n) < ieg(tileme) ) then  ! send to  tile tn.
       if( ieg(tileme) - scont(tileme)%ie1(n) < ehalo ) call mpp_error(fatal, &
            "mpp_domains_define.inc: southeast tile for send 2 is not tiled properly")
       nums = nums+1; tilesend(nums) = tn
       align1send(nums) = south_west;  align2send(nums) = north_east
       is1send(nums) = scont(tileme)%ie1(n) + 1; ie1send(nums) = is1send(nums) + ehalo - 1
       js1send(nums) = scont(tileme)%js1(n)    ; je1send(nums) = js1send(nums) + nhalo - 1
       is2send(nums) = scont(tileme)%ie2(n) + 1; ie2send(nums) = is1send(nums) + ehalo - 1
       js2send(nums) = scont(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
    end if
 end if
end do
 
!--- found the corner overlap that is not specified through contact line.
n = wcont(tileme)%ncontact
found_corner = .false.
if( n > 0) then
 tn = wcont(tileme)%tile(1)
 if( wcont(tileme)%js1(n) == jsg(tileme) .AND. wcont(tileme)%js2(n) == jsg(tn) ) then
    m = scont(tn)%ncontact
    if(m >0) then
       tc = scont(tn)%tile(m)
       if( scont(tn)%ie1(m) == ieg(tn) .AND. scont(tn)%ie2(m) == ieg(tc) ) found_corner = .true.
    end if
 end if
end if
if( .not. found_corner ) then  ! not found, then starting from north contact
 n = scont(tileme)%ncontact
 found_corner = .false.
 if( n > 0) then
    tn = scont(tileme)%tile(1)
    if( scont(tileme)%is1(1) == isg(tileme) .AND. scont(tileme)%is2(1) == isg(tn) ) then
       m = wcont(tn)%ncontact
       if( m > 0 ) then
          tc = wcont(tn)%tile(m)
          if( wcont(tn)%je1(m) == jeg(tn) .AND. wcont(tn)%je2(m) == jeg(tc) ) found_corner = .true.
       end if
    end if
 end if
end if
if(found_corner) then
 nums = nums+1; tilesend(nums) = tc
 align1send(nums) = south_west;  align2send(nums) = north_east
 is1send(nums) = isg(tileme); ie1send(nums) = is1send(nums) + ehalo - 1
 js1send(nums) = jsg(tileme); je1send(nums) = js1send(nums) + nhalo - 1
 is2send(nums) = ieg(tc) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 js2send(nums) = jeg(tc) + 1; je2send(nums) = js2send(nums) + nhalo - 1
end if
 
end subroutine fill_corner_contact
 
!--- find the alignment direction, check if index is reversed, if reversed, exchange index.
subroutine check_alignment( is, ie, js, je, isg, ieg, jsg, jeg, alignment )
integer, intent(inout) :: is, ie, js, je, isg, ieg, jsg, jeg
integer, intent(out)   :: alignment
 
integer :: i, j
 
if ( is == ie ) then      ! x-alignment
 if ( is == isg ) then
    alignment = west
 else if ( is == ieg ) then
    alignment = east
 else
    call mpp_error(fatal, 'mpp_domains_define.inc: The contact region is not on the x-boundary of the tile')
 end if
 if ( js > je ) then
    j = js; js = je; je = j
 end if
else if ( js == je ) then ! y-alignment
 if ( js == jsg ) then
    alignment = south
 else if ( js == jeg ) then
    alignment = north
 else
    call mpp_error(fatal, 'mpp_domains_define.inc: The contact region is not on the y-boundary of the tile')
 end if
 if ( is > ie ) then
    i = is; is = ie; ie = i
 end if
else
 call mpp_error(fatal, 'mpp_domains_define.inc: The contact region should be line contact' )
end if
 
end subroutine check_alignment
!#####################################################################
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                             !
!              MPP_MODIFY_DOMAIN: modify extent of domain                     !
!                                                                             !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
!> @brief Modifies the exents of a domain
subroutine mpp_modify_domain1d(domain_in,domain_out,cbegin,cend,gbegin,gend, hbegin, hend)
  ! </PUBLICROUTINE>
type(domain1d), intent(in)    :: domain_in !< The source domain.
type(domain1d), intent(inout) :: domain_out !< The returned domain.
integer, intent(in), optional :: hbegin, hend !< halo size
integer, intent(in), optional :: cbegin, cend !< Axis specifications associated with the compute
                                              !! domain of the returned 1D domain.
integer, intent(in), optional :: gbegin, gend !< Axis specifications associated with the global
                                              !! domain of the returned 1D domain.
integer :: ndivs, global_indices(2) !(/ isg, ieg /)
integer                       :: flag
! get the global indices of the input domain
global_indices(1) = domain_in%global%begin;  global_indices(2) = domain_in%global%end
 
! get the layout
ndivs = size(domain_in%list(:))
 
! get the flag
flag = 0
if(domain_in%cyclic) flag = flag + cyclic_global_domain
if(domain_in%domain_data%is_global) flag = flag + global_data_domain
 
call mpp_define_domains( global_indices, ndivs, domain_out, pelist = domain_in%list(:)%pe, &
   flags = flag, begin_halo = hbegin, end_halo = hend, extent = domain_in%list(:)%compute%size )
 
if(present(cbegin)) domain_out%compute%begin = cbegin
if(present(cend))   domain_out%compute%end = cend
domain_out%compute%size = domain_out%compute%end - domain_out%compute%begin + 1
if(present(gbegin)) domain_out%global%begin = gbegin
if(present(gend))   domain_out%global%end = gend
domain_out%global%size = domain_out%global%end - domain_out%global%begin + 1
 
end subroutine mpp_modify_domain1d
 
!#######################################################################
 
subroutine mpp_modify_domain2d(domain_in, domain_out, isc, iec, jsc, jec, isg, ieg, jsg, jeg, whalo, ehalo, &
                              &  shalo, nhalo)
  ! </PUBLICROUTINE>
type(domain2d), intent(in)    :: domain_in !< The source domain.
type(domain2d), intent(inout) :: domain_out !< The returned domain.
integer, intent(in), optional :: isc, iec, jsc, jec !< Zonal and meridional axis specifications
                                 !! associated with the global domain of the returned 2D domain.
integer, intent(in), optional :: isg, ieg, jsg, jeg !<  Zonal axis specifications associated with
                                 !! the global domain of the returned 2D domain.
integer, intent(in), optional :: whalo, ehalo, shalo, nhalo !< halo size in x- and y- directions
integer                       :: global_indices(4), layout(2)
integer                       :: xflag, yflag, nlist, i
 
if(present(whalo) .or. present(ehalo) .or. present(shalo) .or. present(nhalo) ) then
   ! get the global indices of the input domain
 global_indices(1) = domain_in%x(1)%global%begin;  global_indices(2) = domain_in%x(1)%global%end
 global_indices(3) = domain_in%y(1)%global%begin;  global_indices(4) = domain_in%y(1)%global%end
 
 ! get the layout
 layout(1) = size(domain_in%x(1)%list(:)); layout(2) = size(domain_in%y(1)%list(:))
 
 ! get the flag
 xflag = 0; yflag = 0
 if(domain_in%x(1)%cyclic) xflag = xflag + cyclic_global_domain
 if(domain_in%x(1)%domain_data%is_global) xflag = xflag + global_data_domain
 if(domain_in%y(1)%cyclic) yflag = yflag + cyclic_global_domain
 if(domain_in%y(1)%domain_data%is_global) yflag = yflag + global_data_domain
 
 call mpp_define_domains( global_indices, layout, domain_out, pelist = domain_in%list(:)%pe, &
      xflags = xflag, yflags = yflag,  whalo = whalo, ehalo = ehalo,     &
      shalo = shalo, nhalo = nhalo,                                      &
      xextent = domain_in%x(1)%list(:)%compute%size,                     &
      yextent = domain_in%y(1)%list(:)%compute%size,                     &
      symmetry=domain_in%symmetry,                                       &
      maskmap = domain_in%pearray .NE. null_pe )
 domain_out%ntiles = domain_in%ntiles
 domain_out%tile_id = domain_in%tile_id
else
 call mpp_define_null_domain(domain_out)
 nlist = size(domain_in%list(:))
 if (associated(domain_out%list)) deallocate(domain_out%list) !< Check if allocated
 allocate(domain_out%list(0:nlist-1) )
 do i = 0, nlist-1
    allocate(domain_out%list(i)%tile_id(1))
    domain_out%list(i)%tile_id(1) = 1
 enddo
 call mpp_modify_domain(domain_in%x(1), domain_out%x(1), isc, iec, isg, ieg)
 call mpp_modify_domain(domain_in%y(1), domain_out%y(1), jsc, jec, jsg, jeg)
 domain_out%ntiles = domain_in%ntiles
 domain_out%tile_id = domain_in%tile_id
endif
 
end subroutine mpp_modify_domain2d
! </SUBROUTINE>
 
!#####################################################################
 
 
subroutine mpp_define_null_domain1d(domain)
type(domain1d), intent(inout) :: domain
 
domain%global%begin  = -1; domain%global%end  = -1; domain%global%size = 0
domain%domain_data%begin    = -1; domain%domain_data%end    = -1; domain%domain_data%size = 0
domain%compute%begin = -1; domain%compute%end = -1; domain%compute%size = 0
domain%pe = null_pe
 
end subroutine mpp_define_null_domain1d
 
!#####################################################################
 
 
subroutine mpp_define_null_domain2d(domain)
type(domain2d), intent(inout) :: domain
 
allocate(domain%x(1), domain%y(1), domain%tile_id(1))
call mpp_define_null_domain(domain%x(1))
call mpp_define_null_domain(domain%y(1))
domain%pe = null_pe
domain%tile_id(1)   = 1
domain%ntiles       = 1
domain%max_ntile_pe = 1
domain%ncontacts    = 0
 
end subroutine mpp_define_null_domain2d
 
!####################################################################
 
subroutine mpp_deallocate_domain1d(domain)
  type(domain1d), intent(inout) :: domain
 
  if(ASSOCIATED(domain%list)) deallocate(domain%list)
 
end subroutine mpp_deallocate_domain1d
 
!####################################################################
 
subroutine mpp_deallocate_domain2d(domain)
  type(domain2d), intent(inout) :: domain
 
  call deallocate_domain2d_local(domain)
  if(ASSOCIATED(domain%io_domain) ) then
     call deallocate_domain2d_local(domain%io_domain)
     deallocate(domain%io_domain)
  endif
 
end subroutine mpp_deallocate_domain2d
 
!##################################################################
 
subroutine deallocate_domain2d_local(domain)
type(domain2d), intent(inout) :: domain
integer :: i, ntileMe
 
ntileme = size(domain%x(:))
 
if(ASSOCIATED(domain%pearray))deallocate(domain%pearray)
do i = 1, ntileme
   call mpp_deallocate_domain1d(domain%x(i))
   call mpp_deallocate_domain1d(domain%y(i))
enddo
deallocate(domain%x, domain%y, domain%tile_id)
 
! TODO: Check if these are always allocated
if(ASSOCIATED(domain%tileList)) deallocate(domain%tileList)
if(ASSOCIATED(domain%tile_id_all)) deallocate(domain%tile_id_all)
 
if(ASSOCIATED(domain%list)) then
 do i = 0, size(domain%list(:))-1
    deallocate(domain%list(i)%x, domain%list(i)%y, domain%list(i)%tile_id)
 enddo
 deallocate(domain%list)
endif
 
if(ASSOCIATED(domain%check_C)) then
  call deallocate_overlapspec(domain%check_C)
  deallocate(domain%check_C)
endif
 
if(ASSOCIATED(domain%check_E)) then
  call deallocate_overlapspec(domain%check_E)
  deallocate(domain%check_E)
endif
 
if(ASSOCIATED(domain%check_N)) then
  call deallocate_overlapspec(domain%check_N)
  deallocate(domain%check_N)
endif
 
if(ASSOCIATED(domain%bound_C)) then
  call deallocate_overlapspec(domain%bound_C)
  deallocate(domain%bound_C)
endif
 
if(ASSOCIATED(domain%bound_E)) then
  call deallocate_overlapspec(domain%bound_E)
  deallocate(domain%bound_E)
endif
 
if(ASSOCIATED(domain%bound_N)) then
  call deallocate_overlapspec(domain%bound_N)
  deallocate(domain%bound_N)
endif
 
if(ASSOCIATED(domain%update_T)) then
  call deallocate_overlapspec(domain%update_T)
  deallocate(domain%update_T)
endif
 
if(ASSOCIATED(domain%update_E)) then
  call deallocate_overlapspec(domain%update_E)
  deallocate(domain%update_E)
endif
 
if(ASSOCIATED(domain%update_C)) then
  call deallocate_overlapspec(domain%update_C)
  deallocate(domain%update_C)
endif
 
if(ASSOCIATED(domain%update_N)) then
  call deallocate_overlapspec(domain%update_N)
  deallocate(domain%update_N)
endif
 
end subroutine deallocate_domain2d_local
 
!####################################################################
 
subroutine allocate_check_overlap(overlap, count)
  type(overlap_type), intent(inout) :: overlap
  integer,            intent(in   ) :: count
 
  overlap%count = 0
  overlap%pe    = null_pe
  if(associated(overlap%tileMe)) call mpp_error(fatal, &
       "allocate_check_overlap(mpp_domains_define): overlap is already been allocated")
  if(count < 1)  call mpp_error(fatal, &
       "allocate_check_overlap(mpp_domains_define): count should be a positive integer")
  allocate(overlap%tileMe  (count), overlap%dir(count) )
  allocate(overlap%is      (count), overlap%ie (count) )
  allocate(overlap%js      (count), overlap%je (count) )
  allocate(overlap%rotation(count)                     )
  overlap%rotation     =  zero
 
end subroutine allocate_check_overlap
 
!#######################################################################
subroutine insert_check_overlap(overlap, pe, tileMe, dir, rotation, is, ie, js, je)
  type(overlap_type), intent(inout) :: overlap
  integer,            intent(in   ) :: pe
  integer,            intent(in   ) :: tileMe, dir, rotation
  integer,            intent(in   ) :: is, ie, js, je
  integer                           :: count
 
  overlap%count = overlap%count + 1
  count = overlap%count
  if(.NOT. associated(overlap%tileMe)) call mpp_error(fatal, &
     "mpp_domains_define.inc(insert_check_overlap): overlap is not assigned any memory")
  if(count > size(overlap%tileMe(:)) ) call mpp_error(fatal, &
     "mpp_domains_define.inc(insert_check_overlap): overlap%count is greater than size(overlap%tileMe)")
  if( overlap%pe == null_pe ) then
     overlap%pe = pe
  else
     if(overlap%pe .NE. pe) call mpp_error(fatal,  &
           "mpp_domains_define.inc(insert_check_overlap): mismatch on pe")
  endif
  overlap%tileMe  (count) = tileme
  overlap%dir     (count) = dir
  overlap%rotation(count) = rotation
  overlap%is      (count) = is
  overlap%ie      (count) = ie
  overlap%js      (count) = js
  overlap%je      (count) = je
 
end subroutine insert_check_overlap
 
!#######################################################################
!> this routine adds the overlap_in into overlap_out
subroutine add_check_overlap( overlap_out, overlap_in)
  type(overlap_type), intent(inout) :: overlap_out
  type(overlap_type), intent(in   ) :: overlap_in
  type(overlap_type)                :: overlap
  integer                          :: count, count_in, count_out
 
  ! if overlap_out%count == 0, then just copy overlap_in to overlap_out
  count_in  = overlap_in %count
  count_out = overlap_out%count
  count     = count_in+count_out
  if(count_in == 0) call mpp_error(fatal, &
       "add_check_overlap(mpp_domains_define): overlap_in%count is zero")
 
  if(count_out == 0) then
     if(associated(overlap_out%tileMe)) call mpp_error(fatal, &
          "add_check_overlap(mpp_domains_define): overlap is already been allocated but count=0")
     call allocate_check_overlap(overlap_out, count_in)
     overlap_out%pe  = overlap_in%pe
  else  ! need to expand the dimension size of overlap
     call allocate_check_overlap(overlap, count_out)
     if(overlap_out%pe .NE. overlap_in%pe) call mpp_error(fatal, &
         "mpp_domains_define.inc(add_check_overlap): mismatch of pe between overlap_in and overlap_out")
     overlap%tileMe      (1:count_out) = overlap_out%tileMe      (1:count_out)
     overlap%is          (1:count_out) = overlap_out%is          (1:count_out)
     overlap%ie          (1:count_out) = overlap_out%ie          (1:count_out)
     overlap%js          (1:count_out) = overlap_out%js          (1:count_out)
     overlap%je          (1:count_out) = overlap_out%je          (1:count_out)
     overlap%dir         (1:count_out) = overlap_out%dir         (1:count_out)
     overlap%rotation    (1:count_out) = overlap_out%rotation    (1:count_out)
     call deallocate_overlap_type(overlap_out)
     call allocate_check_overlap(overlap_out, count)
     overlap_out%tileMe      (1:count_out) = overlap%tileMe      (1:count_out)
     overlap_out%is          (1:count_out) = overlap%is          (1:count_out)
     overlap_out%ie          (1:count_out) = overlap%ie          (1:count_out)
     overlap_out%js          (1:count_out) = overlap%js          (1:count_out)
     overlap_out%je          (1:count_out) = overlap%je          (1:count_out)
     overlap_out%dir         (1:count_out) = overlap%dir         (1:count_out)
     overlap_out%rotation    (1:count_out) = overlap%rotation    (1:count_out)
     call deallocate_overlap_type(overlap)
  end if
  overlap_out%count                           = count
  overlap_out%tileMe      (count_out+1:count) = overlap_in%tileMe      (1:count_in)
  overlap_out%is          (count_out+1:count) = overlap_in%is          (1:count_in)
  overlap_out%ie          (count_out+1:count) = overlap_in%ie          (1:count_in)
  overlap_out%js          (count_out+1:count) = overlap_in%js          (1:count_in)
  overlap_out%je          (count_out+1:count) = overlap_in%je          (1:count_in)
  overlap_out%dir         (count_out+1:count) = overlap_in%dir         (1:count_in)
  overlap_out%rotation    (count_out+1:count) = overlap_in%rotation    (1:count_in)
 
end subroutine add_check_overlap
 
!####################################################################
subroutine init_overlap_type(overlap)
  type(overlap_type), intent(inout) :: overlap
 
  overlap%count = 0
  overlap%pe    = null_pe
 
end subroutine init_overlap_type
 
!####################################################################
 
subroutine allocate_update_overlap( overlap, count)
  type(overlap_type), intent(inout) :: overlap
  integer,           intent(in   ) :: count
 
  overlap%count = 0
  overlap%pe    = null_pe
  if(associated(overlap%tileMe)) call mpp_error(fatal, &
       "allocate_update_overlap(mpp_domains_define): overlap is already been allocated")
  if(count < 1)  call mpp_error(fatal, &
       "allocate_update_overlap(mpp_domains_define): count should be a positive integer")
  allocate(overlap%tileMe      (count), overlap%tileNbr (count) )
  allocate(overlap%is          (count), overlap%ie      (count) )
  allocate(overlap%js          (count), overlap%je      (count) )
  allocate(overlap%dir         (count), overlap%rotation(count) )
  allocate(overlap%from_contact(count), overlap%msgsize (count) )
  overlap%rotation     =  zero
  overlap%from_contact = .false.
 
end subroutine allocate_update_overlap
 
  !#####################################################################################
  subroutine insert_update_overlap(overlap, pe, is1, ie1, js1, je1, is2, ie2, js2, je2, dir, reverse, symmetry)
    type(overlap_type), intent(inout) :: overlap
    integer,            intent(in   ) :: pe
    integer,            intent(in   ) :: is1, ie1, js1, je1, is2, ie2, js2, je2
    integer,            intent(in   ) :: dir
    logical, optional,  intent(in   ) :: reverse, symmetry
 
    logical :: is_reverse, is_symmetry, is_overlapped
    integer :: is, ie, js, je, count
 
    is_reverse = .false.
    if(PRESENT(reverse)) is_reverse = reverse
    is_symmetry = .false.
    if(PRESENT(symmetry)) is_symmetry = symmetry
 
    is = max(is1,is2); ie = min(ie1,ie2)
    js = max(js1,js2); je = min(je1,je2)
    is_overlapped = .false.
    !--- to avoid unnecessary ( duplicate overlap ) for symmetry domain
    if(is_symmetry .AND. (dir == 1 .OR. dir == 5)) then  ! x-direction
       if( ie .GE. is .AND. je .GT. js ) is_overlapped = .true.
    else if(is_symmetry .AND. (dir == 3 .OR. dir == 7)) then ! y-direction
       if( ie .GT. is .AND. je .GE. js ) is_overlapped = .true.
    else if(ie.GE.is .AND. je.GE.js )then
       is_overlapped = .true.
    endif
 
    if(is_overlapped) then
     if( overlap%count == 0 ) then
          overlap%pe = pe
       else
          if(overlap%pe .NE. pe) call mpp_error(fatal,  &
               "mpp_domains_define.inc(insert_update_overlap): mismatch on pe")
       endif
       overlap%count = overlap%count+1
       count = overlap%count
       if(count > maxoverlap) call mpp_error(fatal, "mpp_domains_define.inc(insert_update_overlap):"//&
                              & " number of overlap is greater than MAXOVERLAP, increase MAXOVERLAP")
       overlap%is(count) = is
       overlap%ie(count) = ie
       overlap%js(count) = js
       overlap%je(count) = je
       overlap%tileMe (count) = 1
       overlap%tileNbr(count) = 1
       overlap%dir(count) = dir
       if(is_reverse) then
          overlap%rotation(count) = one_hundred_eighty
       else
          overlap%rotation(count) = zero
       end if
    end if
 
  end subroutine insert_update_overlap
 
  !#####################################################################################
subroutine insert_overlap_type(overlap, pe, tileMe, tileNbr, is, ie, js, je, dir, &
     rotation, from_contact)
    type(overlap_type), intent(inout) :: overlap
    integer,            intent(in   ) :: tileMe, tileNbr, pe
    integer,            intent(in   ) :: is, ie, js, je
    integer,            intent(in   ) :: dir, rotation
  logical,            intent(in   ) :: from_contact
    integer                           :: count
 
  if( overlap%count == 0 ) then
       overlap%pe = pe
    else
       if(overlap%pe .NE. pe) call mpp_error(fatal,  &
          "mpp_domains_define.inc(insert_overlap_type): mismatch on pe")
    endif
    overlap%count = overlap%count+1
    count = overlap%count
    if(count > maxoverlap) call mpp_error(fatal, "mpp_domains_define.inc(insert_overlap_type):"//&
                           & " number of overlap is greater than MAXOVERLAP, increase MAXOVERLAP")
    overlap%tileMe      (count) = tileme
    overlap%tileNbr     (count) = tilenbr
    overlap%is          (count) = is
    overlap%ie          (count) = ie
    overlap%js          (count) = js
    overlap%je          (count) = je
    overlap%dir         (count) = dir
    overlap%rotation    (count) = rotation
    overlap%from_contact(count) = from_contact
    overlap%msgsize     (count) = (ie-is+1)*(je-js+1)
 
end subroutine insert_overlap_type
 
 
!#######################################################################
subroutine deallocate_overlap_type( overlap)
  type(overlap_type), intent(inout) :: overlap
 
  if(overlap%count == 0) then
     if( .NOT. associated(overlap%tileMe)) return
  else
     if( .NOT. associated(overlap%tileMe)) call mpp_error(fatal, &
          "deallocate_overlap_type(mpp_domains_define): overlap is not been allocated")
  endif
  if(ASSOCIATED(overlap%tileMe)) deallocate(overlap%tileMe)
  if(ASSOCIATED(overlap%tileNbr)) deallocate(overlap%tileNbr)
  if(ASSOCIATED(overlap%is)) deallocate(overlap%is)
  if(ASSOCIATED(overlap%ie)) deallocate(overlap%ie)
  if(ASSOCIATED(overlap%js)) deallocate(overlap%js)
  if(ASSOCIATED(overlap%je)) deallocate(overlap%je)
  if(ASSOCIATED(overlap%dir)) deallocate(overlap%dir)
  if(ASSOCIATED(overlap%index)) deallocate(overlap%index)
  if(ASSOCIATED(overlap%rotation)) deallocate(overlap%rotation)
  if(ASSOCIATED(overlap%from_contact)) deallocate(overlap%from_contact)
  if(ASSOCIATED(overlap%msgsize)) deallocate(overlap%msgsize)
  overlap%count = 0
 
end subroutine deallocate_overlap_type
 
!#######################################################################
subroutine deallocate_overlapspec(overlap)
type(overlapspec), intent(inout) :: overlap
integer                          :: n
 
   if(ASSOCIATED(overlap%send)) then
      do n = 1, size(overlap%send(:))
         call deallocate_overlap_type(overlap%send(n))
      enddo
      deallocate(overlap%send)
   endif
   if(ASSOCIATED(overlap%recv)) then
      do n = 1, size(overlap%recv(:))
         call deallocate_overlap_type(overlap%recv(n))
      enddo
      deallocate(overlap%recv)
   endif
 
 
end subroutine deallocate_overlapspec
 
!#######################################################################
!--- this routine add the overlap_in into overlap_out
subroutine add_update_overlap( overlap_out, overlap_in)
  type(overlap_type), intent(inout) :: overlap_out
  type(overlap_type), intent(in   ) :: overlap_in
  type(overlap_type)                :: overlap
  integer                          :: count, count_in, count_out, n
 
  ! if overlap_out%count == 0, then just copy overlap_in to overlap_out
  count_in  = overlap_in %count
  count_out = overlap_out%count
  count     = count_in+count_out
  if(count_in == 0) call mpp_error(fatal, &
       "mpp_domains_define.inc(add_update_overlap): overlap_in%count is zero")
 
  if(count_out == 0) then
     if(associated(overlap_out%tileMe)) call mpp_error(fatal, &
          "mpp_domains_define.inc(add_update_overlap): overlap is already been allocated but count=0")
     call allocate_update_overlap(overlap_out, count_in)
     overlap_out%pe  = overlap_in%pe
  else  ! need to expand the dimension size of overlap
     if(overlap_in%pe .NE. overlap_out%pe) call mpp_error(fatal, &
          "mpp_domains_define.inc(add_update_overlap): mismatch of pe between overlap_in and overlap_out")
 
     call allocate_update_overlap(overlap, count_out)
     overlap%tileMe      (1:count_out) = overlap_out%tileMe      (1:count_out)
     overlap%tileNbr     (1:count_out) = overlap_out%tileNbr     (1:count_out)
     overlap%is          (1:count_out) = overlap_out%is          (1:count_out)
     overlap%ie          (1:count_out) = overlap_out%ie          (1:count_out)
     overlap%js          (1:count_out) = overlap_out%js          (1:count_out)
     overlap%je          (1:count_out) = overlap_out%je          (1:count_out)
     overlap%dir         (1:count_out) = overlap_out%dir         (1:count_out)
     overlap%rotation    (1:count_out) = overlap_out%rotation    (1:count_out)
     overlap%from_contact(1:count_out) = overlap_out%from_contact(1:count_out)
     call deallocate_overlap_type(overlap_out)
     call allocate_update_overlap(overlap_out, count)
     overlap_out%tileMe      (1:count_out) = overlap%tileMe      (1:count_out)
     overlap_out%tileNbr     (1:count_out) = overlap%tileNbr     (1:count_out)
     overlap_out%is          (1:count_out) = overlap%is          (1:count_out)
     overlap_out%ie          (1:count_out) = overlap%ie          (1:count_out)
     overlap_out%js          (1:count_out) = overlap%js          (1:count_out)
     overlap_out%je          (1:count_out) = overlap%je          (1:count_out)
     overlap_out%dir         (1:count_out) = overlap%dir         (1:count_out)
     overlap_out%rotation    (1:count_out) = overlap%rotation    (1:count_out)
     overlap_out%index       (1:count_out) = overlap%index       (1:count_out)
     overlap_out%from_contact(1:count_out) = overlap%from_contact(1:count_out)
     overlap_out%msgsize     (1:count_out) = overlap%msgsize     (1:count_out)
     call deallocate_overlap_type(overlap)
  end if
  overlap_out%count                           = count
  overlap_out%tileMe      (count_out+1:count) = overlap_in%tileMe      (1:count_in)
  overlap_out%tileNbr     (count_out+1:count) = overlap_in%tileNbr     (1:count_in)
  overlap_out%is          (count_out+1:count) = overlap_in%is          (1:count_in)
  overlap_out%ie          (count_out+1:count) = overlap_in%ie          (1:count_in)
  overlap_out%js          (count_out+1:count) = overlap_in%js          (1:count_in)
  overlap_out%je          (count_out+1:count) = overlap_in%je          (1:count_in)
  overlap_out%dir         (count_out+1:count) = overlap_in%dir         (1:count_in)
  overlap_out%rotation    (count_out+1:count) = overlap_in%rotation    (1:count_in)
  overlap_out%from_contact(count_out+1:count) = overlap_in%from_contact(1:count_in)
 
  do n = count_out+1, count
     overlap_out%msgsize(n) = (overlap_out%ie(n)-overlap_out%is(n)+1)*(overlap_out%je(n)-overlap_out%js(n)+1)
  enddo
 
 
end subroutine add_update_overlap
 
!##############################################################################
subroutine expand_update_overlap_list(overlapList, npes)
  type(overlap_type), pointer :: overlapList(:)
  integer,      intent(in   ) :: npes
  type(overlap_type), pointer,save           :: newlist(:) => null()
  integer                                    :: nlist_old, nlist, m
 
  nlist_old = size(overlaplist(:))
  if(nlist_old .GE. npes) call mpp_error(fatal, &
     'mpp_domains_define.inc(expand_update_overlap_list): size of overlaplist should be smaller than npes')
  nlist = min(npes, 2*nlist_old)
  allocate(newlist(nlist))
  do m = 1, nlist_old
     call add_update_overlap(newlist(m), overlaplist(m))
     call deallocate_overlap_type(overlaplist(m))
  enddo
 
  deallocate(overlaplist)
  overlaplist => newlist
  newlist => null()
 
  return
 
end subroutine expand_update_overlap_list
 
!##################################################################################
subroutine expand_check_overlap_list(overlaplist, npes)
  type(overlap_type), pointer :: overlaplist(:)
  integer,         intent(in) :: npes
  type(overlap_type), pointer,save           :: newlist(:) => null()
  integer                                    :: nlist_old, nlist, m
 
  nlist_old = size(overlaplist(:))
  if(nlist_old .GE. npes) call mpp_error(fatal, &
     'mpp_domains_define.inc(expand_check_overlap_list): size of overlaplist should be smaller than npes')
  nlist = min(npes, 2*nlist_old)
  allocate(newlist(nlist))
  do m = 1,size(overlaplist(:))
     call add_check_overlap(newlist(m), overlaplist(m))
     call deallocate_overlap_type(overlaplist(m))
  enddo
  deallocate(overlaplist)
  overlaplist => newlist
 
 
  return
 
end subroutine expand_check_overlap_list
 
 
!###############################################################################
subroutine check_overlap_pe_order(domain, overlap, name)
  type(domain2d),    intent(in) :: domain
  type(overlapspec), intent(in) :: overlap
  character(len=*),  intent(in) :: name
  integer                       :: m
  integer                       :: pe1, pe2
 
  !---make sure overlap%nsend and overlap%nrecv is no larger than MAXLIST
  if( overlap%nsend > maxlist) call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): overlap%nsend > MAXLIST, increase MAXLIST")
  if( overlap%nrecv > maxlist) call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): overlap%nrecv > MAXLIST, increase MAXLIST")
 
  do m = 2, overlap%nsend
     pe1 = overlap%send(m-1)%pe
     pe2 = overlap%send(m)%pe
     !-- when p1 == domain%pe, pe2 could be any value except domain%pe
     if( pe2 == domain%pe ) then
        print*, trim(name)//" at pe = ", domain%pe, ": send pe is ", pe1, pe2
        call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): send pe2 can not equal to domain%pe")
     else if( (pe1 > domain%pe .AND. pe2 > domain%pe) .OR. (pe1 < domain%pe .AND. pe2 < domain%pe)) then
        if( pe2 < pe1 ) then
           print*, trim(name)//" at pe = ", domain%pe, ": send pe is ", pe1, pe2
           call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for send 1")
        endif
     else if ( pe2 > domain%pe .AND. pe1 < domain%pe ) then
        print*, trim(name)//" at pe = ", domain%pe, ": send pe is ", pe1, pe2
        call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for send 2")
     endif
  enddo
 
 
  do m = 2, overlap%nrecv
     pe1 = overlap%recv(m-1)%pe
     pe2 = overlap%recv(m)%pe
     !-- when p1 == domain%pe, pe2 could be any value except domain%pe
     if( pe2 == domain%pe ) then
        print*, trim(name)//" at pe = ", domain%pe, ": recv pe is ", pe1, pe2
        call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): recv pe2 can not equal to domain%pe")
     else if( (pe1 > domain%pe .AND. pe2 > domain%pe) .OR. (pe1 < domain%pe .AND. pe2 < domain%pe)) then
        if( pe2 > pe1 ) then
           print*, trim(name)//" at pe = ", domain%pe, ": recv pe is ", pe1, pe2
           call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for recv 1")
        endif
     else if ( pe2 < domain%pe .AND. pe1 > domain%pe ) then
        print*, trim(name)//" at pe = ", domain%pe, ": recv pe is ", pe1, pe2
        call mpp_error(fatal, &
             "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for recv 2")
     endif
  enddo
 
 
end subroutine check_overlap_pe_order
 
 
!###############################################################################
subroutine set_domain_comm_inf(update)
  type(overlapspec), intent(inout) :: update
 
  integer :: m, totsize, n
 
 
     ! first set the send and recv size
     update%sendsize = 0
     update%recvsize = 0
     do m = 1, update%nrecv
        totsize = 0
        do n = 1, update%recv(m)%count
           totsize = totsize + update%recv(m)%msgsize(n)
        enddo
        update%recv(m)%totsize = totsize
        if(m==1) then
           update%recv(m)%start_pos = 0
        else
           update%recv(m)%start_pos = update%recv(m-1)%start_pos + update%recv(m-1)%totsize
        endif
        update%recvsize = update%recvsize + totsize
     enddo
 
     do m = 1, update%nsend
        totsize = 0
        do n = 1, update%send(m)%count
           totsize = totsize + update%send(m)%msgsize(n)
        enddo
        update%send(m)%totsize = totsize
        if(m==1) then
           update%send(m)%start_pos = 0
        else
           update%send(m)%start_pos = update%send(m-1)%start_pos + update%send(m-1)%totsize
        endif
        update%sendsize = update%sendsize + totsize
     enddo
 
  return
 
 
end subroutine set_domain_comm_inf
!> @}