27     integer, 
intent(in) :: global_indices(:)
 
   28     integer, 
intent(in) :: ndivs
 
   29     integer, 
intent(out) :: layout(:)
 
   31     integer :: isg, ieg, jsg, jeg, isz, jsz, idiv, jdiv
 
   33     if(
size(global_indices(:)) .NE. 4) 
call mpp_error(fatal,
"mpp_define_layout2D: size of global_indices should be 4")
 
   34     if(
size(layout(:)) .NE. 2) 
call mpp_error(fatal,
"mpp_define_layout2D: size of layout should be 2")
 
   36     isg = global_indices(1)
 
   37     ieg = global_indices(2)
 
   38     jsg = global_indices(3)
 
   39     jeg = global_indices(4)
 
   44     idiv = nint( sqrt(float(ndivs*isz)/jsz) )
 
   46     do while( mod(ndivs,idiv).NE.0 )
 
   51     layout = (/ idiv, jdiv /)
 
   62     integer, 
dimension(:), 
intent(in)           :: sizes
 
   63     integer, 
dimension(:), 
intent(inout)        :: pe_start, pe_end
 
   64     integer, 
dimension(:), 
intent(in), 
optional :: pelist, costpertile
 
   65     integer, 
dimension(size(sizes(:)))          :: costs
 
   66     integer, 
dimension(:), 
allocatable          :: pes
 
   67     integer                                     :: ntiles, npes, totcosts, avgcost
 
   68     integer                                     :: ntiles_left, npes_left, pos, n, tile
 
   69     integer                                     :: cost_on_tile, cost_on_pe, npes_used, errunit
 
   71     ntiles = 
size(sizes(:))
 
   72     if(
size(pe_start(:)) .NE. ntiles .OR. 
size(pe_end(:)) .NE. ntiles ) 
then 
   73        call mpp_error(fatal, 
"mpp_define_mosaic_pelist: size mismatch between pe_start/pe_end and sizes")
 
   76     if(
present(costpertile)) 
then 
   77        if(
size(costpertile(:)) .NE. ntiles ) 
then 
   78           call mpp_error(fatal, 
"mpp_define_mosaic_pelist: size mismatch between costpertile and sizes")
 
   80        costs = sizes*costpertile
 
   85     if( 
PRESENT(pelist) )
then 
   86        if( .NOT.any(pelist.EQ.
mpp_pe()) )
then 
   88           write( errunit,* )
'pe=', 
mpp_pe(), 
' pelist=', pelist
 
   89           call mpp_error( fatal, 
'mpp_define_mosaic_pelist: pe must be in pelist.' )
 
   91        npes = 
size(pelist(:))
 
   92        allocate( pes(0:npes-1) )
 
   96        allocate( pes(0:npes-1) )
 
   97        call mpp_get_current_pelist(pes)
 
  104     do while( ntiles_left > 0 )
 
  105        if( npes_left == 1 ) 
then  
  107              if(costs(n) > 0) 
then 
  116           totcosts = sum(costs)
 
  117           avgcost  = ceiling(real(totcosts)/npes_left )
 
  118           tile = minval(maxloc(costs))
 
  119           cost_on_tile = costs(tile)
 
  121           ntiles_left = ntiles_left - 1
 
  123           totcosts = totcosts - cost_on_tile
 
  124           if(cost_on_tile .GE. avgcost ) 
then 
  125              npes_used = min(ceiling(real(cost_on_tile)/avgcost), npes_left)
 
  126              if( ntiles_left > 0 .AND. npes_used == npes_left ) npes_used = npes_used - 1
 
  127              pe_end(tile) = pos + npes_used - 1
 
  128              npes_left = npes_left - npes_used
 
  129              pos = pos + npes_used
 
  133              cost_on_pe = cost_on_tile
 
  134              do while(ntiles_left>npes_left)  
 
  135                 tile = minval(minloc(costs, costs> 0 ))
 
  136                 cost_on_tile = costs(tile)
 
  137                 cost_on_pe = cost_on_pe + cost_on_tile
 
  138                 if(cost_on_pe > avgcost ) 
exit 
  141                 ntiles_left = ntiles_left - 1
 
  143                 totcosts = totcosts - cost_on_tile
 
  145              npes_left = npes_left - 1
 
  151     if(npes_left .NE. 0 ) 
call mpp_error(fatal, 
"mpp_define_mosaic_pelist: the left npes should be zero")
 
  161     integer,                 
intent(in) :: isg, ieg, ndivs
 
  162     integer, 
dimension(:), 
intent(out)  :: ibegin, iend
 
  170       is = ie - ceiling( real(ie-isg+1)/ndiv ) + 1
 
  174       if( ie.LT.is )
call mpp_error( fatal,  &
 
  175           'MPP_DEFINE_DOMAINS(mpp_compute_block_extent): domain extents must be positive definite.' )
 
  176       if( ndiv.EQ.1 .AND. ibegin(ndiv) .NE. isg ) &
 
  177           call mpp_error( fatal, 
'mpp_compute_block_extent: domain extents do not span space completely.' )
 
  187     integer,                 
intent(in)          :: isg, ieg, ndivs
 
  188     integer, 
dimension(0:), 
intent(out)          :: ibegin, iend
 
  189     integer, 
dimension(0:), 
intent(in), 
optional :: extent
 
  191     integer :: ndiv, imax, ndmax, ndmirror
 
  193     logical :: symmetrize, use_extent
 
  196     even(n) = (mod(n,2).EQ.0)
 
  197     odd(n) = (mod(n,2).EQ.1)
 
  200     if(
PRESENT(extent)) 
then 
  201        if( 
size(extent(:)).NE.ndivs ) &
 
  202             call mpp_error( fatal, 
'mpp_compute_extent: extent array size must equal number of domain divisions.' )
 
  204        if(all(extent ==0)) use_extent = .false.
 
  211           if(extent(ndiv) .LE. 0) 
call mpp_error( fatal, &
 
  212              &  
'mpp_compute_extent: domain extents must be positive definite.' )
 
  213           iend(ndiv) = ibegin(ndiv) + extent(ndiv) - 1
 
  214           ibegin(ndiv+1) = iend(ndiv) + 1
 
  216        iend(ndivs-1) = ibegin(ndivs-1) + extent(ndivs-1) - 1
 
  217        if(iend(ndivs-1) .NE. ieg) 
call mpp_error(fatal, &
 
  218           &  
'mpp_compute_extent: extent array limits do not match global domain.' )
 
  232           symmetrize = ( even(ndivs) .AND. even(ieg-isg+1) ) .OR. &
 
  233                (  odd(ndivs) .AND.  odd(ieg-isg+1) ) .OR. &
 
  234                (  odd(ndivs) .AND. even(ieg-isg+1) .AND. ndivs.LT.(ieg-isg+1)/2 )
 
  243           if( ndiv.LT.(ndivs-1)/2+1 )
then 
  245              ie = is + ceiling( real(imax-is+1)/(ndmax-ndiv) ) - 1
 
  246              ndmirror = (ndivs-1) - ndiv 
 
  247              if( ndmirror.GT.ndiv .AND. symmetrize )
then  
  249                 ibegin(ndmirror) = max( isg+ieg-ie, ie+1 )
 
  250                 iend(ndmirror)   = max( isg+ieg-is, ie+1 )
 
  251                 imax = ibegin(ndmirror) - 1
 
  260                 ie = is + ceiling( real(imax-is+1)/(ndmax-ndiv) ) - 1
 
  265           if( ie.LT.is )
call mpp_error( fatal,  &
 
  266                'MPP_DEFINE_DOMAINS(mpp_compute_extent): domain extents must be positive definite.' )
 
  267           if( ndiv.EQ.ndivs-1 .AND. iend(ndiv).NE.ieg ) &
 
  268                call mpp_error( fatal, 
'mpp_compute_extent: domain extents do not span space completely.' )
 
  281                                    memory_size, begin_halo, end_halo )
 
  282     integer,           
intent(in) :: global_indices(:)
 
  283     integer,           
intent(in) :: ndivs
 
  284     type(domain1d), 
intent(inout) :: domain
 
  286     integer, 
intent(in), 
optional :: pelist(0:)
 
  289     integer, 
intent(in), 
optional :: flags, halo
 
  293     integer, 
intent(in), 
optional :: extent(0:)
 
  295     logical, 
intent(in), 
optional :: maskmap(0:)
 
  300     integer, 
intent(in), 
optional :: memory_size
 
  301     integer, 
intent(in), 
optional :: begin_halo, end_halo
 
  303     logical              :: compute_domain_is_global, data_domain_is_global
 
  304     integer              :: ndiv, n, isg, ieg
 
  305     integer, 
allocatable :: pes(:)
 
  306     integer              :: ibegin(0:ndivs-1), iend(0:ndivs-1)
 
  307     logical              :: mask(0:ndivs-1)
 
  308     integer              :: halosz, halobegin, haloend
 
  311     if( .NOT.module_is_initialized )
call mpp_error( fatal, &
 
  312        &  
'MPP_DEFINE_DOMAINS1D: You must first call mpp_domains_init.' )
 
  313     if(
size(global_indices(:)) .NE. 2) 
call mpp_error(fatal,
"mpp_define_domains1D: size of global_indices should be 2")
 
  315     isg = global_indices(1)
 
  316     ieg = global_indices(2)
 
  317     if( ndivs.GT.ieg-isg+1 )
call mpp_error( fatal, &
 
  318        &  
'MPP_DEFINE_DOMAINS1D: more divisions requested than rows available.' )
 
  320     if( 
PRESENT(pelist) )
then 
  321        if( .NOT.any(pelist.EQ.
mpp_pe()) )
then 
  323           write( errunit,* )
'pe=', 
mpp_pe(), 
' pelist=', pelist
 
  324           call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS1D: pe must be in pelist.' )
 
  326        allocate( pes(0:
size(pelist(:))-1) )
 
  330        call mpp_get_current_pelist(pes)
 
  336     if( 
PRESENT(maskmap) )
then 
  337        if( 
size(maskmap(:)).NE.ndivs ) &
 
  338             call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS1D: maskmap array size must equal number of domain divisions.' )
 
  341     if( count(mask).NE.
size(pes(:)) ) &
 
  342          call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS1D: number of TRUEs in maskmap array must match PE count.' )
 
  346     if( 
PRESENT(halo) ) 
then 
  349        if(
present(begin_halo) .OR. 
present(end_halo) ) 
call mpp_error(fatal, &
 
  350             "mpp_domains_define.inc: when halo is present, begin_halo and end_halo should not present")
 
  352     halobegin = halosz; haloend = halosz
 
  353     if(
present(begin_halo)) halobegin = begin_halo
 
  354     if(
present(end_halo))   haloend   = end_halo
 
  355     halosz = max(halobegin, haloend)
 
  357     compute_domain_is_global = .false.
 
  358     data_domain_is_global    = .false.
 
  359     domain%cyclic = .false.
 
  362     if( 
PRESENT(flags) )
then 
  365        compute_domain_is_global = ndivs.EQ.1
 
  367        data_domain_is_global    = btest(flags,global) .OR. compute_domain_is_global
 
  368        domain%cyclic  = btest(flags,cyclic) .AND. halosz.NE.0
 
  369        if(btest(flags,cyclic)) domain%goffset = 0
 
  373     allocate( domain%list(0:ndivs-1) )
 
  376     domain%list(:)%global%begin     = isg
 
  377     domain%list(:)%global%end       = ieg
 
  378     domain%list(:)%global%size      = ieg-isg+1
 
  379     domain%list(:)%global%max_size  = ieg-isg+1
 
  380     domain%list(:)%global%is_global = .true. 
 
  383     if( compute_domain_is_global )
then 
  384        domain%list(:)%compute%begin = isg
 
  385        domain%list(:)%compute%end   = ieg
 
  386        domain%list(:)%compute%is_global = .true.
 
  387        domain%list(:)%pe = pes(:)
 
  390        domain%list(:)%compute%is_global = .false.
 
  394           domain%list(ndiv)%compute%begin = ibegin(ndiv)
 
  395           domain%list(ndiv)%compute%end   = iend(ndiv)
 
  397              domain%list(ndiv)%pe = pes(n)
 
  398              if( 
mpp_pe().EQ.pes(n) )domain%pos = ndiv
 
  401              domain%list(ndiv)%pe = null_pe
 
  406     domain%list(:)%compute%size  = domain%list(:)%compute%end - domain%list(:)%compute%begin + 1
 
  410     domain%list(:)%domain_data%begin = domain%list(:)%compute%begin
 
  411     domain%list(:)%domain_data%end   = domain%list(:)%compute%end
 
  412     domain%list(:)%domain_data%is_global = .false.
 
  414     if( data_domain_is_global )
then 
  415        domain%list(:)%domain_data%begin  = isg
 
  416        domain%list(:)%domain_data%end    = ieg
 
  417        domain%list(:)%domain_data%is_global = .true.
 
  420     domain%list(:)%domain_data%begin = domain%list(:)%domain_data%begin - halobegin
 
  421     domain%list(:)%domain_data%end   = domain%list(:)%domain_data%end   + haloend
 
  422     domain%list(:)%domain_data%size  = domain%list(:)%domain_data%end - domain%list(:)%domain_data%begin + 1
 
  427     domain%list(:)%memory%begin = domain%list(:)%domain_data%begin
 
  428     domain%list(:)%memory%end   = domain%list(:)%domain_data%end
 
  429     if( 
present(memory_size) ) 
then 
  430        if(memory_size > 0) 
then 
  431           if( domain%list(domain%pos)%domain_data%size > memory_size ) 
call mpp_error(fatal, &
 
  432                "mpp_domains_define.inc: data domain size is larger than memory domain size on this pe")
 
  433           domain%list(:)%memory%end   = domain%list(:)%memory%begin + memory_size - 1
 
  436     domain%list(:)%memory%size = domain%list(:)%memory%end - domain%list(:)%memory%begin + 1
 
  437     domain%list(:)%memory%is_global = domain%list(:)%domain_data%is_global
 
  439     domain%compute = domain%list(domain%pos)%compute
 
  440     domain%domain_data    = domain%list(domain%pos)%domain_data
 
  441     domain%global  = domain%list(domain%pos)%global
 
  442     domain%memory  = domain%list(domain%pos)%memory
 
  443     domain%compute%max_size = maxval( domain%list(:)%compute%size )
 
  444     domain%domain_data%max_size    = maxval( domain%list(:)%domain_data%size )
 
  445     domain%global%max_size  = domain%global%size
 
  446     domain%memory%max_size  = domain%memory%size
 
  457     type(domain2d), 
intent(inout) :: domain
 
  458     integer,        
intent(in   ) :: io_layout(2)
 
  460     integer                       :: npes_in_group
 
  461     type(domain2d), 
pointer       :: io_domain=>null()
 
  462     integer                       :: i, j, n, m
 
  463     integer                       :: ipos, jpos, igroup, jgroup
 
  464     integer                       :: ipos_beg, ipos_end, jpos_beg, jpos_end
 
  465     integer                       :: whalo, ehalo, shalo, nhalo
 
  466     integer                       :: npes_x, npes_y, ndivx, ndivy
 
  467     integer, 
allocatable          :: posarray(:,:)
 
  469     if(io_layout(1) * io_layout(2) .LE. 0) 
then 
  470        call mpp_error(note,  &
 
  471          "mpp_domains_define.inc(mpp_define_io_domain): io domain will not be defined for "//trim(domain%name)// &
 
  472          " when one or both entry of io_layout is not positive")
 
  476     layout(1) = 
size(domain%x(1)%list(:))
 
  477     layout(2) = 
size(domain%y(1)%list(:))
 
  479     if(
ASSOCIATED(domain%io_domain)) 
call mpp_error(fatal, &
 
  480        "mpp_domains_define.inc(mpp_define_io_domain): io_domain is already defined")
 
  482     if(mod(layout(1), io_layout(1)) .NE. 0) 
call mpp_error(fatal, &
 
  483        "mpp_domains_define.inc(mpp_define_io_domain): "//trim(domain%name)// &
 
  484                              & 
" domain layout(1) must be divided by io_layout(1)")
 
  485     if(mod(layout(2), io_layout(2)) .NE. 0) 
call mpp_error(fatal, &
 
  486        "mpp_domains_define.inc(mpp_define_io_domain): "//trim(domain%name)// &
 
  487                              & 
" domain layout(2) must be divided by io_layout(2)")
 
  488     if(
size(domain%x(:)) > 1) 
call mpp_error(fatal, &
 
  489        "mpp_domains_define.inc(mpp_define_io_domain): "//trim(domain%name)// &
 
  490        ": multiple tile per pe is not supported yet for this routine")
 
  492     if (
associated(domain%io_domain)) 
deallocate(domain%io_domain) 
 
  493     allocate(domain%io_domain)
 
  494     domain%io_layout = io_layout
 
  495     io_domain => domain%io_domain
 
  497     npes_x = layout(1)/io_layout(1)
 
  498     npes_y = layout(2)/io_layout(2)
 
  499     ipos = mod(domain%x(1)%pos, npes_x)
 
  500     jpos = mod(domain%y(1)%pos, npes_y)
 
  501     igroup  = domain%x(1)%pos/npes_x
 
  502     jgroup  = domain%y(1)%pos/npes_y
 
  503     ipos_beg = igroup*npes_x; ipos_end = ipos_beg + npes_x - 1
 
  504     jpos_beg = jgroup*npes_y; jpos_end = jpos_beg + npes_y - 1
 
  506     do j = jpos_beg, jpos_end
 
  507        do i = ipos_beg, ipos_end
 
  508           if(domain%pearray(i,j) .NE. null_pe) npes_in_group = npes_in_group+1
 
  512     io_domain%whalo    = domain%whalo
 
  513     io_domain%ehalo    = domain%ehalo
 
  514     io_domain%shalo    = domain%shalo
 
  515     io_domain%nhalo    = domain%nhalo
 
  517     io_domain%pe       = domain%pe
 
  518     io_domain%symmetry = domain%symmetry
 
  519     if (
associated(io_domain%list)) 
deallocate(io_domain%list) 
 
  520     allocate(io_domain%list(0:npes_in_group-1))
 
  521     do i = 0, npes_in_group-1
 
  522        allocate( io_domain%list(i)%x(1), io_domain%list(i)%y(1), io_domain%list(i)%tile_id(1) )
 
  525     ndivx = 
size(domain%pearray,1)
 
  526     ndivy = 
size(domain%pearray,2)
 
  527     allocate(posarray(0:ndivx-1, 0:ndivy-1))
 
  528     n = domain%tile_root_pe - mpp_root_pe()
 
  532           if( domain%pearray(i,j) == null_pe) cycle
 
  539     do j = jpos_beg, jpos_end
 
  540        do i = ipos_beg, ipos_end
 
  541           if( domain%pearray(i,j) == null_pe) cycle
 
  542           io_domain%list(n)%pe = domain%pearray(i,j)
 
  544           io_domain%list(n)%x(1)%compute = domain%list(m)%x(1)%compute
 
  545           io_domain%list(n)%y(1)%compute = domain%list(m)%y(1)%compute
 
  546           igroup                         = domain%list(m)%x(1)%pos/npes_x
 
  547           jgroup                         = domain%list(m)%y(1)%pos/npes_y
 
  548           io_domain%list(n)%tile_id(1)   = jgroup*io_layout(1) + igroup
 
  554     if (
associated(io_domain%x)) 
deallocate(io_domain%x) 
 
  555     if (
associated(io_domain%y)) 
deallocate(io_domain%y) 
 
  556     if (
associated(io_domain%tile_id)) 
deallocate(io_domain%tile_id) 
 
  557     allocate(io_domain%x(1), io_domain%y(1), io_domain%tile_id(1) )
 
  558     allocate(io_domain%x(1)%list(0:npes_x-1), io_domain%y(1)%list(0:npes_y-1) )
 
  560     do j = jpos_beg, jpos_beg+jpos
 
  561        do i = ipos_beg, ipos_beg+ipos
 
  562           if(domain%pearray(i,j) .NE. null_pe) n = n + 1
 
  566     io_domain%x(1)%compute = domain%x(1)%compute
 
  567     io_domain%x(1)%domain_data    = domain%x(1)%domain_data
 
  568     io_domain%x(1)%memory  = domain%x(1)%memory
 
  569     io_domain%y(1)%compute = domain%y(1)%compute
 
  570     io_domain%y(1)%domain_data    = domain%y(1)%domain_data
 
  571     io_domain%y(1)%memory  = domain%y(1)%memory
 
  572     io_domain%x(1)%global%begin     = domain%x(1)%list(ipos_beg)%compute%begin
 
  573     io_domain%x(1)%global%end       = domain%x(1)%list(ipos_end)%compute%end
 
  574     io_domain%x(1)%global%size      = io_domain%x(1)%global%end - io_domain%x(1)%global%begin + 1
 
  575     io_domain%x(1)%global%max_size  = io_domain%x(1)%global%size
 
  576     io_domain%y(1)%global%begin     = domain%y(1)%list(jpos_beg)%compute%begin
 
  577     io_domain%y(1)%global%end       = domain%y(1)%list(jpos_end)%compute%end
 
  578     io_domain%y(1)%global%size      = io_domain%y(1)%global%end - io_domain%y(1)%global%begin + 1
 
  579     io_domain%y(1)%global%max_size  = io_domain%y(1)%global%size
 
  580     io_domain%x(1)%pos     = ipos
 
  581     io_domain%y(1)%pos     = jpos
 
  582     io_domain%tile_id(1)   = io_domain%list(n)%tile_id(1)
 
  583     io_domain%tile_root_pe = io_domain%list(0)%pe
 
  608          xhalo, yhalo, xextent, yextent, maskmap, name, symmetry,  memory_size,               &
 
  609          whalo, ehalo, shalo, nhalo, is_mosaic, tile_count, tile_id, complete, x_cyclic_offset, y_cyclic_offset )
 
  610     integer,          
intent(in)           :: global_indices(:)
 
  611     integer,          
intent(in)           :: layout(:)
 
  612     type(domain2d),   
intent(inout)        :: domain
 
  613     integer,          
intent(in), 
optional :: pelist(0:)
 
  614     integer,          
intent(in), 
optional :: xflags, yflags
 
  615     integer,          
intent(in), 
optional :: xhalo, yhalo
 
  616     integer,          
intent(in), 
optional :: xextent(0:), yextent(0:)
 
  617     logical,          
intent(in), 
optional :: maskmap(0:,0:)
 
  618     character(len=*), 
intent(in), 
optional :: name
 
  619     logical,          
intent(in), 
optional :: symmetry
 
  620     logical,          
intent(in), 
optional :: is_mosaic
 
  622     integer,          
intent(in), 
optional :: memory_size(:)
 
  623     integer,          
intent(in), 
optional :: whalo, ehalo, shalo, nhalo
 
  629     integer, 
intent(in),          
optional :: tile_count
 
  633     integer, 
intent(in),          
optional :: tile_id
 
  634     logical, 
intent(in),          
optional :: complete
 
  636     integer, 
intent(in),          
optional :: x_cyclic_offset
 
  639     integer, 
intent(in),          
optional :: y_cyclic_offset
 
  644     integer              :: i, j, m, n, xhalosz, yhalosz, memory_xsize, memory_ysize
 
  645     integer              :: whalosz, ehalosz, shalosz, nhalosz
 
  646     integer              :: ipos, jpos, pos, tile, nlist, cur_tile_id, cur_comm_id
 
  647     integer              :: ndivx, ndivy, isg, ieg, jsg, jeg, ishift, jshift, errunit, logunit
 
  648     integer              :: x_offset, y_offset, start_pos, nfold
 
  649     logical              :: from_mosaic, is_complete
 
  650     logical              :: mask(0:layout(1)-1,0:layout(2)-1)
 
  651     integer, 
allocatable :: pes(:), pesall(:)
 
  652     integer              :: pearray(0:layout(1)-1,0:layout(2)-1)
 
  653     integer              :: ibegin(0:layout(1)-1), iend(0:layout(1)-1)
 
  654     integer              :: jbegin(0:layout(2)-1), jend(0:layout(2)-1)
 
  655     character(len=8)     :: text
 
  656     type(overlapspec), 
pointer :: check_T => null()
 
  658     logical              :: send(8), recv(8)
 
  661     if( .NOT.module_is_initialized )
call mpp_error( fatal, &
 
  662        &  
'MPP_DEFINE_DOMAINS2D: You must first call mpp_domains_init.' )
 
  663     if(
PRESENT(name)) 
then 
  664        if(len_trim(name) > name_length) 
call mpp_error(fatal,  &
 
  665             "mpp_domains_define.inc(mpp_define_domains2D): the len_trim of optional argument name ="//trim(name)// &
 
  666             " is greater than NAME_LENGTH, change the argument name or increase NAME_LENGTH")
 
  669     if(
size(global_indices(:)) .NE. 4) 
call mpp_error(fatal,   &
 
  670        "mpp_define_domains2D: size of global_indices should be 4 for "//trim(domain%name) )
 
  671     if(
size(layout(:)) .NE. 2) 
call mpp_error(fatal,
"mpp_define_domains2D: size of layout should be 2 for "// &
 
  672        & trim(domain%name) )
 
  674     ndivx = layout(1); ndivy = layout(2)
 
  675     isg = global_indices(1); ieg = global_indices(2); jsg = global_indices(3); jeg = global_indices(4)
 
  677     from_mosaic = .false.
 
  678     if(
present(is_mosaic)) from_mosaic = is_mosaic
 
  680     if(
present(complete)) is_complete = complete
 
  682     if(
present(tile_count)) tile = tile_count
 
  684     if(
present(tile_id)) cur_tile_id = tile_id
 
  687     if( 
PRESENT(pelist) )
then 
  688        allocate( pes(0:
size(pelist(:))-1) )
 
  692           call mpp_get_current_pelist(pesall, commid=cur_comm_id)
 
  694           allocate( pesall(0:
size(pes(:))-1) )
 
  696           call mpp_get_current_pelist(pesall, commid=cur_comm_id)
 
  701        call mpp_get_current_pelist(pes, commid=cur_comm_id)
 
  708     x_offset = 0; y_offset = 0
 
  709     if(
PRESENT(x_cyclic_offset)) x_offset = x_cyclic_offset
 
  710     if(
PRESENT(y_cyclic_offset)) y_offset = y_cyclic_offset
 
  711     if(x_offset*y_offset .NE. 0) 
call mpp_error(fatal, &
 
  712        'MPP_DEFINE_DOMAINS2D: At least one of x_cyclic_offset and y_cyclic_offset must be zero for '// &
 
  716     if(abs(x_offset) > jeg-jsg+1) 
call mpp_error(fatal, &
 
  717          'MPP_DEFINE_DOMAINS2D: absolute value of x_cyclic_offset is greater than jeg-jsg+1 for '//trim(domain%name))
 
  718     if(abs(y_offset) > ieg-isg+1) 
call mpp_error(fatal, &
 
  719          'MPP_DEFINE_DOMAINS2D: absolute value of y_cyclic_offset is greater than ieg-isg+1 for '//trim(domain%name))
 
  722     if( tile > 1 .AND. 
size(pes(:)) > 1) 
call mpp_error(fatal, &
 
  723          'MPP_DEFINE_DOMAINS2D: there are more than one tile on this pe, '// &
 
  724          'all the tile should be limited on this pe for '//trim(domain%name))
 
  730     do n = 0, 
size(pesall(:))-1
 
  731        if(pesall(n) == 
mpp_pe() ) 
then 
  736     if(pos<0) 
call  mpp_error(fatal, 
'MPP_DEFINE_DOMAINS2D: mpp_pe() is not in the pesall list')
 
  738     domain%symmetry = .false.
 
  739     if(
present(symmetry)) domain%symmetry = symmetry
 
  740     if(domain%symmetry) 
then 
  741        ishift = 1; jshift = 1
 
  743        ishift = 0; jshift = 0
 
  750     xhalosz = 0; yhalosz = 0
 
  751     if(
present(xhalo)) xhalosz = xhalo
 
  752     if(
present(yhalo)) yhalosz = yhalo
 
  753     whalosz = xhalosz; ehalosz = xhalosz
 
  754     shalosz = yhalosz; nhalosz = yhalosz
 
  755     if(
present(whalo)) whalosz = whalo
 
  756     if(
present(ehalo)) ehalosz = ehalo
 
  757     if(
present(shalo)) shalosz = shalo
 
  758     if(
present(nhalo)) nhalosz = nhalo
 
  762     if( 
PRESENT(maskmap) )
then 
  763        if( 
size(maskmap,1).NE.ndivx .OR. 
size(maskmap,2).NE.ndivy ) &
 
  764             call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS2D: maskmap array does not match layout for '// &
 
  765                            & trim(domain%name) )
 
  766        mask(:,:) = maskmap(:,:)
 
  770     if( n.NE.
size(pes(:)) )
then 
  771        write( text,
'(i8)' )n
 
  772        call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS2D: incorrect number of PEs assigned for ' // &
 
  773             'this layout and maskmap. Use '//text//
' PEs for this domain decomposition for '//trim(domain%name) )
 
  776     memory_xsize = 0; memory_ysize = 0
 
  777     if(
present(memory_size)) 
then 
  778        if(
size(memory_size(:)) .NE. 2) 
call mpp_error(fatal,  &
 
  779              "mpp_define_domains2D: size of memory_size should be 2 for "//trim(domain%name))
 
  780        memory_xsize = memory_size(1)
 
  781        memory_ysize = memory_size(2)
 
  787     nlist = 
size(pesall(:))
 
  788     if( .NOT. 
Associated(domain%x) ) 
then 
  789        allocate(domain%tileList(1))
 
  790        domain%tileList(1)%xbegin = global_indices(1)
 
  791        domain%tileList(1)%xend   = global_indices(2)
 
  792        domain%tileList(1)%ybegin = global_indices(3)
 
  793        domain%tileList(1)%yend   = global_indices(4)
 
  794        allocate(domain%x(1), domain%y(1) )
 
  795        allocate(domain%tile_id(1))
 
  796        allocate(domain%tile_id_all(1))
 
  797        domain%tile_id        = cur_tile_id
 
  798        domain%tile_id_all    = cur_tile_id
 
  799        domain%tile_comm_id   = cur_comm_id
 
  801        domain%max_ntile_pe   = 1
 
  803        domain%rotated_ninety = .false.
 
  804        allocate( domain%list(0:nlist-1) )
 
  806           allocate( domain%list(i)%x(1), domain%list(i)%y(1), domain%list(i)%tile_id(1))
 
  810     domain%initialized = .true.
 
  814        if(pesall(n) == pes(0)) 
then 
  821     pearray(:,:) = null_pe
 
  822     ipos = null_pe; jpos = null_pe
 
  828              pearray(i,j) = pes(n)
 
  829              domain%list(m)%x(tile)%compute%begin = ibegin(i)
 
  830              domain%list(m)%x(tile)%compute%end   = iend(i)
 
  831              domain%list(m)%y(tile)%compute%begin = jbegin(j)
 
  832              domain%list(m)%y(tile)%compute%end   = jend(j)
 
  833              domain%list(m)%x(tile)%compute%size  = domain%list(m)%x(tile)%compute%end &
 
  834                                                   & - domain%list(m)%x(tile)%compute%begin + 1
 
  835              domain%list(m)%y(tile)%compute%size  = domain%list(m)%y(tile)%compute%end &
 
  836                                                   & - domain%list(m)%y(tile)%compute%begin + 1
 
  837              domain%list(m)%tile_id(tile)         = cur_tile_id
 
  838              domain%list(m)%x(tile)%pos           = i
 
  839              domain%list(m)%y(tile)%pos           = j
 
  840              domain%list(m)%tile_root_pe          = pes(0)
 
  841              domain%list(m)%pe                    = pesall(m)
 
  843              if( pes(n).EQ.
mpp_pe() )
then 
  855     if( any(pes == 
mpp_pe()) ) 
then 
  856        domain%io_layout = layout
 
  857        domain%tile_root_pe  = pes(0)
 
  858        domain%comm_id   = cur_comm_id
 
  859        if( ipos.EQ.null_pe .OR. jpos.EQ.null_pe ) &
 
  860             call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS2D: pelist must include this PE for '//trim(domain%name) )
 
  863          write( errunit, * )
'pe, tile, ipos, jpos=', 
mpp_pe(), tile, ipos, jpos, 
' pearray(:,jpos)=', &
 
  864                   pearray(:,jpos), 
' pearray(ipos,:)=', pearray(ipos,:)
 
  869          if (
associated(domain%pearray)) 
deallocate(domain%pearray) 
 
  870           allocate( domain%pearray(0:ndivx-1,0:ndivy-1) )
 
  871           domain%pearray = pearray
 
  876        domain_cnt = domain_cnt + int(1,kind=i8_kind)
 
  877        domain%id = domain_cnt*domain_id_base  
 
  880        call mpp_define_domains( global_indices(1:2), ndivx, domain%x(tile), &
 
  881             pack(pearray(:,jpos),mask(:,jpos)), xflags, xhalo, xextent, mask(:,jpos), memory_xsize, whalo, ehalo )
 
  882        call mpp_define_domains( global_indices(3:4), ndivy, domain%y(tile), &
 
  883             pack(pearray(ipos,:),mask(ipos,:)), yflags, yhalo, yextent, mask(ipos,:), memory_ysize, shalo, nhalo )
 
  884        if( domain%x(tile)%list(ipos)%pe.NE.domain%y(tile)%list(jpos)%pe ) &
 
  885             call mpp_error( fatal, .NE.
'MPP_DEFINE_DOMAINS2D: domain%x%list(ipos)%pedomain%y%list(jpos)%pe.' )
 
  888        if(x_offset .NE. 0 .OR. y_offset .NE. 0) 
then 
  889           if(whalosz .GT. domain%x(tile)%compute%size .OR. ehalosz .GT. domain%x(tile)%compute%size ) &
 
  890               call mpp_error(fatal, 
"mpp_define_domains_2d: when x_cyclic_offset/y_cyclic_offset is set, "// &
 
  891                  "whalo and ehalo must be no larger than the x-direction computation domain size")
 
  892           if(shalosz .GT. domain%y(tile)%compute%size .OR. nhalosz .GT. domain%y(tile)%compute%size ) &
 
  893               call mpp_error(fatal, 
"mpp_define_domains_2d: when x_cyclic_offset/y_cyclic_offset is set, "// &
 
  894                  "shalo and nhalo must be no larger than the y-direction computation domain size")
 
  898        if(whalosz .GT. domain%x(tile)%global%size) &
 
  899            call mpp_error(fatal, 
"MPP_DEFINE_DOMAINS2D: whalo is greather global domain size")
 
  900        if(ehalosz .GT. domain%x(tile)%global%size) &
 
  901            call mpp_error(fatal, 
"MPP_DEFINE_DOMAINS2D: ehalo is greather global domain size")
 
  902        if(shalosz .GT. domain%x(tile)%global%size) &
 
  903            call mpp_error(fatal, 
"MPP_DEFINE_DOMAINS2D: shalo is greather global domain size")
 
  904        if(nhalosz .GT. domain%x(tile)%global%size) &
 
  905            call mpp_error(fatal, 
"MPP_DEFINE_DOMAINS2D: nhalo is greather global domain size")
 
  910        if( 
PRESENT(xflags) )
then 
  911           if( btest(xflags,west) ) 
then 
  913              if(domain%x(tile)%domain_data%begin .LE. domain%x(tile)%global%begin .AND. &
 
  914                 domain%x(tile)%compute%begin > domain%x(tile)%global%begin ) 
then 
  915                 call mpp_error(fatal, &
 
  916                  'MPP_DEFINE_DOMAINS: the domain could not be crossed when west is folded')
 
  918              if( domain%x(tile)%cyclic )
call mpp_error( fatal, &
 
  919                    'MPP_DEFINE_DOMAINS: an axis cannot be both folded west and cyclic for '//trim(domain%name) )
 
  920              domain%fold = domain%fold + fold_west_edge
 
  923           if( btest(xflags,east) ) 
then 
  925              if(domain%x(tile)%domain_data%end .GE. domain%x(tile)%global%end .AND. &
 
  926                 domain%x(tile)%compute%end < domain%x(tile)%global%end ) 
then 
  927                 call mpp_error(fatal, &
 
  928                  'MPP_DEFINE_DOMAINS: the domain could not be crossed when north is folded')
 
  930              if( domain%x(tile)%cyclic )
call mpp_error( fatal, &
 
  931                   'MPP_DEFINE_DOMAINS: an axis cannot be both folded east and cyclic for '//trim(domain%name) )
 
  932              domain%fold = domain%fold + fold_east_edge
 
  936        if( 
PRESENT(yflags) )
then 
  937           if( btest(yflags,south) ) 
then 
  939              if(domain%y(tile)%domain_data%begin .LE. domain%y(tile)%global%begin .AND. &
 
  940                 domain%y(tile)%compute%begin > domain%y(tile)%global%begin ) 
then 
  941                 call mpp_error(fatal, &
 
  942                  'MPP_DEFINE_DOMAINS: the domain could not be crossed when south is folded')
 
  944              if( domain%y(tile)%cyclic )
call mpp_error( fatal, &
 
  945                  'MPP_DEFINE_DOMAINS: an axis cannot be both folded north and cyclic for '//trim(domain%name))
 
  946              domain%fold = domain%fold + fold_south_edge
 
  949           if( btest(yflags,north) ) 
then 
  952              if(whalosz .GT. domain%x(tile)%compute%size .AND. whalosz .GE. domain%x(tile)%global%size/2 ) &
 
  953                   call mpp_error(fatal, .GT.
"MPP_DEFINE_DOMAINS2D: north is folded, whalo  compute domain size "// &
 
  954                   .GE.
"and whalo  half of global domain size")
 
  955              if(ehalosz .GT. domain%x(tile)%compute%size .AND. ehalosz .GE. domain%x(tile)%global%size/2 ) &
 
  956                   call mpp_error(fatal, .GT.
"MPP_DEFINE_DOMAINS2D: north is folded, ehalo is  compute domain size "// &
 
  957                   .GE.
"and ehalo  half of global domain size")
 
  958              if(shalosz .GT. domain%y(tile)%compute%size .AND. shalosz .GE. domain%x(tile)%global%size/2 ) &
 
  959                   call mpp_error(fatal, .GT.
"MPP_DEFINE_DOMAINS2D: north is folded, shalo  compute domain size "// &
 
  960                   .GE.
"and shalo  half of global domain size")
 
  961              if(nhalosz .GT. domain%y(tile)%compute%size .AND. nhalosz .GE. domain%x(tile)%global%size/2 ) &
 
  962                   call mpp_error(fatal, .GT.
"MPP_DEFINE_DOMAINS2D: north is folded, nhalo  compute domain size "// &
 
  963                   .GE.
"and nhalo  half of global domain size")
 
  966              if( domain%y(tile)%cyclic )
call mpp_error( fatal, &
 
  967                 'MPP_DEFINE_DOMAINS: an axis cannot be both folded south and cyclic for '//trim(domain%name) )
 
  968              domain%fold = domain%fold + fold_north_edge
 
  972        if(nfold > 1) 
call mpp_error(fatal, &
 
  973            'MPP_DEFINE_DOMAINS2D: number of folded edge is greater than 1 for '//trim(domain%name) )
 
  976            if( x_offset .NE. 0 .OR. y_offset .NE. 0) 
call mpp_error(fatal, &
 
  977                'MPP_DEFINE_DOMAINS2D: For the foled_north/folded_south/fold_east/folded_west boundary condition,  '//&
 
  978                'x_cyclic_offset and y_cyclic_offset must be zero for '//trim(domain%name))
 
  980        if( btest(domain%fold,south) .OR. btest(domain%fold,north) )
then 
  981           if( domain%y(tile)%cyclic )
call mpp_error( fatal, &
 
  982               'MPP_DEFINE_DOMAINS: an axis cannot be both folded and cyclic for '//trim(domain%name) )
 
  983           if( modulo(domain%x(tile)%global%size,2).NE.0 ) &
 
  984                call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS: number of points in X must be even ' // &
 
  985                   'when there is a fold in Y for '//trim(domain%name) )
 
  990              if( domain%x(tile)%list(i)%compute%size.NE.domain%x(tile)%list(n-i)%compute%size ) &
 
  991                   call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS: Folded domain boundaries ' // &
 
  992                                          'must line up (mirror-symmetric extents) for '//trim(domain%name) )
 
  995        if( btest(domain%fold,west) .OR. btest(domain%fold,east) )
then 
  996           if( domain%x(tile)%cyclic )
call mpp_error( fatal, &
 
  997              'MPP_DEFINE_DOMAINS: an axis cannot be both folded and cyclic for '//trim(domain%name) )
 
  998           if( modulo(domain%y(tile)%global%size,2).NE.0 ) &
 
  999                call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS: number of points in Y must be even '//&
 
 1000                    'when there is a fold in X for '//trim(domain%name) )
 
 1005              if( domain%y(tile)%list(i)%compute%size.NE.domain%y(tile)%list(n-i)%compute%size ) &
 
 1006                   call mpp_error( fatal, 
'MPP_DEFINE_DOMAINS: Folded domain boundaries must '//&
 
 1007                         'line up (mirror-symmetric extents) for '//trim(domain%name) )
 
 1012        if( 
mpp_pe().EQ.pes(0) .AND. 
PRESENT(name) )
then 
 1014           write( logunit, 
'(/a,i5,a,i5)' )trim(name)//
' domain decomposition: ', ndivx, 
' X', ndivy
 
 1015           write( logunit, 
'(3x,a)' )
'pe,   is,  ie,  js,  je,    isd, ied, jsd, jed' 
 1019     if(is_complete) 
then 
 1020        domain%whalo = whalosz; domain%ehalo = ehalosz
 
 1021        domain%shalo = shalosz; domain%nhalo = nhalosz
 
 1022        if (
associated(domain%update_T)) 
deallocate(domain%update_T) 
 
 1023        if (
associated(domain%update_E)) 
deallocate(domain%update_E) 
 
 1024        if (
associated(domain%update_C)) 
deallocate(domain%update_C) 
 
 1025        if (
associated(domain%update_N)) 
deallocate(domain%update_N) 
 
 1026        allocate(domain%update_T, domain%update_E, domain%update_C, domain%update_N)
 
 1027        domain%update_T%next => null()
 
 1028        domain%update_E%next => null()
 
 1029        domain%update_C%next => null()
 
 1030        domain%update_N%next => null()
 
 1031        if (
associated(domain%check_E)) 
deallocate(domain%check_E) 
 
 1032        if (
associated(domain%check_C)) 
deallocate(domain%check_C) 
 
 1033        if (
associated(domain%check_N)) 
deallocate(domain%check_N) 
 
 1034        allocate(domain%check_E,  domain%check_C,  domain%check_N )
 
 1035        domain%update_T%nsend = 0
 
 1036        domain%update_T%nrecv = 0
 
 1037        domain%update_C%nsend = 0
 
 1038        domain%update_C%nrecv = 0
 
 1039        domain%update_E%nsend = 0
 
 1040        domain%update_E%nrecv = 0
 
 1041        domain%update_N%nsend = 0
 
 1042        domain%update_N%nrecv = 0
 
 1044        if( btest(domain%fold,south) ) 
then 
 1049        else if( btest(domain%fold,west) ) 
then 
 1054        else if( btest(domain%fold,east) ) 
then 
 1060           call compute_overlaps(domain, center, domain%update_T, check_t,             0,      0, x_offset, y_offset, &
 
 1061                                 domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
 
 1062           call compute_overlaps(domain, corner, domain%update_C, domain%check_C, ishift, jshift, x_offset, y_offset, &
 
 1063                                 domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
 
 1064           call compute_overlaps(domain, east,   domain%update_E, domain%check_E,  ishift,     0, x_offset, y_offset, &
 
 1065                                 domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
 
 1066           call compute_overlaps(domain, north,  domain%update_N, domain%check_N,      0, jshift, x_offset, y_offset, &
 
 1067                                 domain%whalo, domain%ehalo, domain%shalo, domain%nhalo)
 
 1069        call check_overlap_pe_order(domain, domain%update_T, trim(domain%name)//
" update_T in mpp_define_domains")
 
 1070        call check_overlap_pe_order(domain, domain%update_C, trim(domain%name)//
" update_C in mpp_define_domains")
 
 1071        call check_overlap_pe_order(domain, domain%update_E, trim(domain%name)//
" update_E in mpp_define_domains")
 
 1072        call check_overlap_pe_order(domain, domain%update_N, trim(domain%name)//
" update_N in mpp_define_domains")
 
 1076        if(domain%symmetry .AND. (domain%ncontacts == 0 .OR. domain%ntiles == 1) ) 
then 
 1080           if (
associated(domain%bound_E)) 
deallocate(domain%bound_E) 
 
 1081           if (
associated(domain%bound_C)) 
deallocate(domain%bound_C) 
 
 1082           if (
associated(domain%bound_N)) 
deallocate(domain%bound_N) 
 
 1083           allocate(domain%bound_E,  domain%bound_C,  domain%bound_N )
 
 1088        call set_domain_comm_inf(domain%update_T)
 
 1089        call set_domain_comm_inf(domain%update_E)
 
 1090        call set_domain_comm_inf(domain%update_C)
 
 1091        call set_domain_comm_inf(domain%update_N)
 
 1097     if(debug_message_passing .and. (domain%ncontacts == 0 .OR. domain%ntiles == 1) ) 
then 
 1100        call check_message_size(domain, domain%update_T, send, recv, 
'T')
 
 1101        call check_message_size(domain, domain%update_E, send, recv, 
'E')
 
 1102        call check_message_size(domain, domain%update_C, send, recv, 
'C')
 
 1103        call check_message_size(domain, domain%update_N, send, recv, 
'N')
 
 1108     if( 
mpp_pe() .EQ. pes(0) .AND. 
PRESENT(name) )
then 
 1109        write(*,*) trim(name)//
' domain decomposition' 
 1110        write(*,
'(a,i4,a,i4,a,i4,a,i4)')
'whalo = ', whalosz, 
", ehalo = ", ehalosz, 
", shalo = ", shalosz, &
 
 1111                                      & 
", nhalo = ", nhalosz
 
 1112        write (*,110) (domain%x(1)%list(i)%compute%size, i= 0, layout(1)-1)
 
 1113        write (*,120) (domain%y(1)%list(i)%compute%size, i= 0, layout(2)-1)
 
 1114 110    
format (
'  X-AXIS = ',24i4,/,(11x,24i4))
 
 1115 120    
format (
'  Y-AXIS = ',24i4,/,(11x,24i4))
 
 1118     deallocate( pes, pesall)
 
 1126 subroutine check_message_size(domain, update, send, recv, position)
 
 1127   type(domain2d),       
intent(in) :: domain
 
 1128   type(overlapspec),    
intent(in) :: update
 
 1129   logical,              
intent(in) :: send(:)
 
 1130   logical,              
intent(in) :: recv(:)
 
 1131   character,            
intent(in) :: position
 
 1133   integer, 
dimension(0:size(domain%list(:))-1) :: msg1, msg2, msg3
 
 1134   integer :: m, n, l, dir, is, ie, js, je, from_pe, msgsize
 
 1137   nlist = 
size(domain%list(:))
 
 1142   do m = 1, update%nrecv
 
 1144      do n = 1, update%recv(m)%count
 
 1145         dir = update%recv(m)%dir(n)
 
 1146         if( recv(dir) ) 
then 
 1147            is = update%recv(m)%is(n); ie = update%recv(m)%ie(n)
 
 1148            js = update%recv(m)%js(n); je = update%recv(m)%je(n)
 
 1149            msgsize = msgsize + (ie-is+1)*(je-js+1)
 
 1152      from_pe = update%recv(m)%pe
 
 1153      l = from_pe-mpp_root_pe()
 
 1154      call mpp_recv( msg1(l), glen=1, from_pe=from_pe, block=.false., tag=comm_tag_1)
 
 1158   do m = 1, update%nsend
 
 1160      do n = 1, update%send(m)%count
 
 1161         dir = update%send(m)%dir(n)
 
 1163            is = update%send(m)%is(n); ie = update%send(m)%ie(n)
 
 1164            js = update%send(m)%js(n); je = update%send(m)%je(n)
 
 1165            msgsize = msgsize + (ie-is+1)*(je-js+1)
 
 1168      l = update%send(m)%pe-mpp_root_pe()
 
 1170      call mpp_send( msg3(l), plen=1, to_pe=update%send(m)%pe, tag=comm_tag_1)
 
 1175      if(msg1(m) .NE. msg2(m)) 
then 
 1176         print*, 
"My pe = ", 
mpp_pe(), 
",domain name =", trim(domain%name), 
",at position=",position,
",from pe=", &
 
 1177              domain%list(m)%pe, 
":send size = ", msg1(m), 
", recv size = ", msg2(m)
 
 1178         call mpp_error(fatal, 
"mpp_define_domains2D: mismatch on send and recv size")
 
 1184 end subroutine check_message_size
 
 1200   subroutine mpp_define_mosaic( global_indices, layout, domain, num_tile, num_contact, tile1, tile2,      &
 
 1201                                 istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, &
 
 1202                                 pe_end, pelist, whalo, ehalo, shalo, nhalo, xextent, yextent,             &
 
 1203                                 maskmap, name, memory_size, symmetry, xflags, yflags, tile_id )
 
 1204     integer,          
intent(in)           :: global_indices(:,:)
 
 1208     integer,          
intent(in)           :: layout(:,:)
 
 1209     type(domain2d),   
intent(inout)        :: domain
 
 1210     integer,          
intent(in)           :: num_tile
 
 1211     integer,          
intent(in)           :: num_contact
 
 1212     integer,          
intent(in)           :: tile1(:), tile2(:)
 
 1213     integer,          
intent(in)           :: istart1(:), iend1(:)
 
 1214     integer,          
intent(in)           :: jstart1(:), jend1(:)
 
 1215     integer,          
intent(in)           :: istart2(:), iend2(:)
 
 1216     integer,          
intent(in)           :: jstart2(:), jend2(:)
 
 1217     integer,          
intent(in)           :: pe_start(:)
 
 1218     integer,          
intent(in)           :: pe_end(:)
 
 1219     integer,          
intent(in), 
optional :: pelist(:)
 
 1220     integer,          
intent(in), 
optional :: whalo, ehalo, shalo, nhalo
 
 1221     integer,          
intent(in), 
optional :: xextent(:,:), yextent(:,:)
 
 1222     logical,          
intent(in), 
optional :: maskmap(:,:,:)
 
 1223     character(len=*), 
intent(in), 
optional :: name
 
 1224     integer,          
intent(in), 
optional :: memory_size(2)
 
 1225     logical,          
intent(in), 
optional :: symmetry
 
 1226     integer,          
intent(in), 
optional :: xflags, yflags
 
 1227     integer,          
intent(in), 
optional :: tile_id(:)
 
 1229     integer              :: n, m, ndivx, ndivy, nc, nlist, nt, pos, n1, n2
 
 1230     integer              :: whalosz, ehalosz, shalosz, nhalosz, xhalosz, yhalosz, t1, t2, tile
 
 1231     integer              :: flags_x, flags_y
 
 1232     logical, 
allocatable :: mask(:,:)
 
 1233     integer, 
allocatable :: pes(:), xext(:), yext(:), pelist_tile(:), ntile_per_pe(:), tile_count(:)
 
 1234     integer, 
allocatable :: tile_id_local(:)
 
 1235     logical              :: is_symmetry
 
 1236     integer, 
allocatable :: align1(:), align2(:), is1(:), ie1(:), js1(:), je1(:), is2(:), ie2(:), js2(:), je2(:)
 
 1237     integer, 
allocatable :: isgList(:), iegList(:), jsgList(:), jegList(:)
 
 1238     real,    
allocatable :: refine1(:), refine2(:)
 
 1240     logical              :: send(8), recv(8)
 
 1243     mosaic_defined = .true.
 
 1245     if(
size(global_indices, 1) .NE. 4) 
call mpp_error(fatal, &
 
 1246          'mpp_domains_define.inc: The size of first dimension of global_indices is not 4')
 
 1248     if(
size(global_indices, 2) .NE. num_tile) 
call mpp_error(fatal, &
 
 1249          'mpp_domains_define.inc: The size of second dimension of global_indices is not equal num_tile')
 
 1251     if(
size(layout, 1) .NE. 2) 
call mpp_error(fatal, &
 
 1252          'mpp_domains_define.inc: The size of first dimension of layout is not 2')
 
 1253     if(
size(layout,2) .NE. num_tile)  
call mpp_error(fatal, &
 
 1254          'mpp_domains_define.inc: The size of second dimension of layout is not equal num_tile')
 
 1258     allocate(pes(0:nlist-1))
 
 1259     if(
present(pelist)) 
then 
 1260        if( nlist .NE. 
size(pelist(:))) 
call mpp_error(fatal, &
 
 1261             'mpp_domains_define.inc: size of pelist is not equal mpp_npes')
 
 1264     call mpp_get_current_pelist(pes, commid=domain%comm_id)
 
 1267        if(pes(n) - pes(n-1) .NE. 1) 
call mpp_error(fatal, &
 
 1268            'mpp_domains_define.inc: pelist is not monotonic increasing by 1')
 
 1271     is_symmetry        = .false.
 
 1272     if(
present(symmetry)) is_symmetry = symmetry
 
 1274     if(
size(pe_start(:)) .NE. num_tile .OR. 
size(pe_end(:)) .NE. num_tile ) 
call mpp_error(fatal, &
 
 1275          'mpp_domains_define.inc: size of pe_start and/or pe_end is not equal num_tile')
 
 1277     if( any( pe_start < pes(0) ) ) 
call mpp_error(fatal, &
 
 1278        &  
'mpp_domains_define.inc: not all the pe_start are in the pelist')
 
 1279     if( any( pe_end > pes(nlist-1)) ) 
call mpp_error(fatal, &
 
 1280        &  
'mpp_domains_define.inc: not all the pe_end are in the pelist')
 
 1283     allocate( ntile_per_pe(0:nlist-1) )
 
 1286        do m = pe_start(n) - mpp_root_pe(), pe_end(n) - mpp_root_pe()
 
 1287           ntile_per_pe(m) = ntile_per_pe(m) + 1
 
 1290     if(any(ntile_per_pe == 0)) 
call mpp_error(fatal, &
 
 1291          'mpp_domains_define.inc: At least one pe in pelist is not used by any tile in the mosaic')
 
 1294     if( 
PRESENT(xextent) ) 
then 
 1295        if(
size(xextent,1) .GT. maxval(layout(1,:)) ) 
call mpp_error(fatal, &
 
 1296             'mpp_domains_define.inc: size mismatch between xextent and layout')
 
 1297        if(
size(xextent,2) .NE. num_tile) 
call mpp_error(fatal, &
 
 1298             'mpp_domains_define.inc: size of xextent is not eqaul num_tile')
 
 1300     if( 
PRESENT(yextent) ) 
then 
 1301        if(
size(yextent,1) .GT. maxval(layout(2,:)) ) 
call mpp_error(fatal, &
 
 1302             'mpp_domains_define.inc: size mismatch between yextent and layout')
 
 1303        if(
size(yextent,2) .NE. num_tile) 
call mpp_error(fatal, &
 
 1304             'mpp_domains_define.inc: size of yextent is not eqaul num_tile')
 
 1311     if(
present(maskmap)) 
then 
 1312        if(
size(maskmap,1) .GT. maxval(layout(1,:)) .or. 
size(maskmap,2) .GT. maxval(layout(2,:))) &
 
 1313             call mpp_error(fatal, 
'mpp_domains_define.inc: size mismatch between maskmap and layout')
 
 1314        if(
size(maskmap,3) .NE. num_tile) 
call mpp_error(fatal, &
 
 1315             'mpp_domains_define.inc: the third dimension of maskmap is not equal num_tile')
 
 1318     if (
associated(domain%tileList)) 
deallocate(domain%tileList) 
 
 1319     allocate(domain%tileList(num_tile))
 
 1321        domain%tileList(n)%xbegin = global_indices(1,n)
 
 1322        domain%tileList(n)%xend   = global_indices(2,n)
 
 1323        domain%tileList(n)%ybegin = global_indices(3,n)
 
 1324        domain%tileList(n)%yend   = global_indices(4,n)
 
 1327     nt = ntile_per_pe(
mpp_pe()-mpp_root_pe())
 
 1328     if (
associated(domain%tile_id)) 
deallocate(domain%tile_id) 
 
 1329     if (
associated(domain%x)) 
deallocate(domain%x) 
 
 1330     if (
associated(domain%y)) 
deallocate(domain%y) 
 
 1331     if (
associated(domain%list)) 
deallocate(domain%list) 
 
 1332     allocate(domain%tile_id(nt), domain%x(nt), domain%y(nt) )
 
 1333     allocate(domain%list(0:nlist-1))
 
 1336        nt = ntile_per_pe(n)
 
 1337        allocate(domain%list(n)%x(nt), domain%list(n)%y(nt), domain%list(n)%tile_id(nt))
 
 1342     if( 
PRESENT(tile_id) ) 
then 
 1343        if(
size(tile_id(:)) .NE. num_tile) 
then 
 1344           call mpp_error(fatal, .NE.
"mpp_domains_define.inc: size(tile_id)  num_tile")
 
 1347     allocate(tile_id_local(num_tile))
 
 1355        if(
PRESENT(tile_id)) 
then 
 1356           tile_id_local(n) = tile_id(n)
 
 1358           tile_id_local(n) = n
 
 1364        if( pe .GE. pe_start(n) .AND. pe .LE. pe_end(n)) 
then 
 1366           domain%tile_id(pos) = tile_id_local(n)
 
 1370     if (
associated(domain%tile_id_all)) 
deallocate(domain%tile_id_all) 
 
 1371     allocate(domain%tile_id_all(num_tile))
 
 1372     domain%tile_id_all(:) = tile_id_local(:)
 
 1374     domain%initialized    = .true.
 
 1375     domain%rotated_ninety = .false.
 
 1376     domain%ntiles         = num_tile
 
 1377     domain%max_ntile_pe   = maxval(ntile_per_pe)
 
 1378     domain%ncontacts      = num_contact
 
 1380     deallocate(ntile_per_pe)
 
 1382     allocate(tile_count(pes(0):pes(0)+nlist-1))
 
 1385     domain%tile_comm_id=0
 
 1387        allocate(mask(layout(1,n), layout(2,n)))
 
 1388        allocate(pelist_tile(pe_start(n):pe_end(n)) )
 
 1389        tile_count(pe_start(n)) = tile_count(pe_start(n)) + 1
 
 1390        do m = pe_start(n), pe_end(n)
 
 1394        if (any(pelist_tile == pe)) 
then 
 1398        if(
present(maskmap))  mask = maskmap(1:layout(1,n), 1:layout(2,n), n)
 
 1399        ndivx = layout(1,n); ndivy = layout(2,n)
 
 1400        allocate(xext(ndivx), yext(ndivy))
 
 1402        if(
present(xextent)) xext = xextent(1:ndivx,n)
 
 1403        if(
present(yextent)) yext = yextent(1:ndivy,n)
 
 1406        if(num_tile == 1) 
then 
 1409           if(
PRESENT(xflags)) flags_x = xflags
 
 1410           if(
PRESENT(yflags)) flags_y = yflags
 
 1411           do m = 1, num_contact
 
 1412              if(istart1(m) == iend1(m) ) 
then   
 1413                 if(istart2(m) .NE. iend2(m) ) 
call mpp_error(fatal,  &
 
 1414                    "mpp_domains_define: for one tile mosaic, when istart1=iend1, istart2 must equal iend2")
 
 1415                 if(istart1(m) == istart2(m) ) 
then  
 1416                    if(istart1(m) == global_indices(1,n) ) 
then 
 1417                       if(.NOT. btest(flags_x,west) )  flags_x = flags_x + fold_west_edge
 
 1418                    else if(istart1(m) == global_indices(2,n) ) 
then 
 1419                       if(.NOT. btest(flags_x,east) )  flags_x = flags_x + fold_east_edge
 
 1421                        call mpp_error(fatal, 
"mpp_domains_define: when istart1=iend1,jstart1=jend1, "//&
 
 1422                          "istart1 should equal global_indices(1) or global_indices(2)")
 
 1425                 if(.NOT. btest(flags_x,cyclic))  flags_x = flags_x + cyclic_global_domain
 
 1427              else if( jstart1(m) == jend1(m) ) 
then   
 1428                 if(jstart2(m) .NE. jend2(m) ) 
call mpp_error(fatal,  &
 
 1429                    "mpp_domains_define: for one tile mosaic, when jstart1=jend1, jstart2 must equal jend2")
 
 1430                 if(jstart1(m) == jstart2(m) ) 
then  
 1431                    if(jstart1(m) == global_indices(3,n) ) 
then 
 1432                       if(.NOT. btest(flags_y,south) )  flags_y = flags_y + fold_south_edge
 
 1433                    else if(jstart1(m) == global_indices(4,n) ) 
then 
 1434                    if(.NOT. btest(flags_y,north) )  flags_y = flags_y + fold_north_edge
 
 1436                        call mpp_error(fatal, 
"mpp_domains_define: when istart1=iend1,jstart1=jend1, "//&
 
 1437                          "istart1 should equal global_indices(1) or global_indices(2)")
 
 1440                    if(.NOT. btest(flags_y,cyclic))  flags_y = flags_y + cyclic_global_domain
 
 1443                call mpp_error(fatal,  &
 
 1444                    "mpp_domains_define: for one tile mosaic, invalid boundary contact")
 
 1447           call mpp_define_domains(global_indices(:,n), layout(:,n), domain, pelist=pelist_tile, xflags = flags_x, &
 
 1448                                   yflags = flags_y, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo,           &
 
 1449                                   xextent=xext, yextent=yext, maskmap=mask, name=name, symmetry=is_symmetry,      &
 
 1450                                   memory_size = memory_size, is_mosaic = .true., tile_id=tile_id_local(n))
 
 1452           call mpp_define_domains(global_indices(:,n), layout(:,n), domain, pelist=pelist_tile,                   &
 
 1453                                   whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, xextent=xext, yextent=yext, &
 
 1454                                   maskmap=mask, name=name, symmetry=is_symmetry, memory_size = memory_size,       &
 
 1455                                   is_mosaic = .true., tile_count = tile_count(pe_start(n)), tile_id=tile_id_local(n), &
 
 1456                                   complete = n==num_tile)
 
 1458        deallocate(mask, xext, yext, pelist_tile)
 
 1461     deallocate(pes, tile_count, tile_id_local)
 
 1463     if(num_contact == 0 .OR. num_tile == 1) 
return 
 1467     allocate(is1(num_contact), ie1(num_contact), js1(num_contact), je1(num_contact) )
 
 1468     allocate(is2(num_contact), ie2(num_contact), js2(num_contact), je2(num_contact) )
 
 1469     allocate(isglist(num_tile), ieglist(num_tile), jsglist(num_tile), jeglist(num_tile) )
 
 1470     allocate(align1(num_contact), align2(num_contact), refine1(num_contact), refine2(num_contact))
 
 1473        isglist(n) = domain%tileList(n)%xbegin; ieglist(n) = domain%tileList(n)%xend
 
 1474        jsglist(n) = domain%tileList(n)%ybegin; jeglist(n) = domain%tileList(n)%yend
 
 1479     do n = 1, num_contact
 
 1482        is1(n) = istart1(n) + isglist(t1) - 1; ie1(n) = iend1(n) + isglist(t1) - 1
 
 1483        js1(n) = jstart1(n) + jsglist(t1) - 1; je1(n) = jend1(n) + jsglist(t1) - 1
 
 1484        is2(n) = istart2(n) + isglist(t2) - 1; ie2(n) = iend2(n) + isglist(t2) - 1
 
 1485        js2(n) = jstart2(n) + jsglist(t2) - 1; je2(n) = jend2(n) + jsglist(t2) - 1
 
 1486        call check_alignment( is1(n), ie1(n), js1(n), je1(n), isglist(t1), ieglist(t1), jsglist(t1), &
 
 1487                            &  jeglist(t1), align1(n))
 
 1488        call check_alignment( is2(n), ie2(n), js2(n), je2(n), isglist(t2), ieglist(t2), jsglist(t2), &
 
 1489                            &  jeglist(t2), align2(n))
 
 1490        if( (align1(n) == west .or. align1(n) == east ) .NEQV. (align2(n) == west .or. align2(n) == east ) )&
 
 1491              domain%rotated_ninety=.true.
 
 1495     do n = 1, num_contact
 
 1496        n1 = max(abs(iend1(n) - istart1(n)), abs(jend1(n) - jstart1(n)) ) + 1
 
 1497        n2 = max(abs(iend2(n) - istart2(n)), abs(jend2(n) - jstart2(n)) ) + 1
 
 1498        refine1(n) = real(n2)/n1
 
 1499        refine2(n) = real(n1)/n2
 
 1502     whalosz = 0; ehalosz = 0; shalosz = 0; nhalosz = 0
 
 1503     if(
present(whalo)) whalosz = whalo
 
 1504     if(
present(ehalo)) ehalosz = ehalo
 
 1505     if(
present(shalo)) shalosz = shalo
 
 1506     if(
present(nhalo)) nhalosz = nhalo
 
 1507     xhalosz = max(whalosz, ehalosz)
 
 1508     yhalosz = max(shalosz, nhalosz)
 
 1511     call define_contact_point( domain, center, num_contact, tile1, tile2, align1, align2, refine1, refine2, &
 
 1512                                is1, ie1, js1, je1, is2, ie2, js2, je2, isglist, ieglist, jsglist, jeglist )
 
 1518     call set_domain_comm_inf(domain%update_T)
 
 1519     call set_domain_comm_inf(domain%update_E)
 
 1520     call set_domain_comm_inf(domain%update_C)
 
 1521     call set_domain_comm_inf(domain%update_N)
 
 1525     do m = 1, 
size(domain%tile_id(:))
 
 1526        tile = domain%tile_id(m)
 
 1527        do n = 1, num_contact
 
 1528           if( tile1(n) == tile ) 
then 
 1529              if(align1(n) == east ) domain%x(m)%goffset = 0
 
 1530              if(align1(n) == north) domain%y(m)%goffset = 0
 
 1532           if( tile2(n) == tile ) 
then 
 1533              if(align2(n) == east ) domain%x(m)%goffset = 0
 
 1534              if(align2(n) == north) domain%y(m)%goffset = 0
 
 1538     call check_overlap_pe_order(domain, domain%update_T, trim(domain%name)//
" update_T in mpp_define_mosaic")
 
 1539     call check_overlap_pe_order(domain, domain%update_C, trim(domain%name)//
" update_C in mpp_define_mosaic")
 
 1540     call check_overlap_pe_order(domain, domain%update_E, trim(domain%name)//
" update_E in mpp_define_mosaic")
 
 1541     call check_overlap_pe_order(domain, domain%update_N, trim(domain%name)//
" update_N in mpp_define_mosaic")
 
 1544     if(debug_update_level .NE. no_check) 
then 
 1549     if(domain%symmetry) 
then 
 1550       if (
associated(domain%bound_E)) 
deallocate(domain%bound_E) 
 
 1551       if (
associated(domain%bound_C)) 
deallocate(domain%bound_C) 
 
 1552       if (
associated(domain%bound_N)) 
deallocate(domain%bound_N) 
 
 1553        allocate(domain%bound_E,  domain%bound_C,  domain%bound_N )
 
 1557        call check_overlap_pe_order(domain, domain%bound_C, trim(domain%name)//
" bound_C")
 
 1558        call check_overlap_pe_order(domain, domain%bound_E, trim(domain%name)//
" bound_E")
 
 1559        call check_overlap_pe_order(domain, domain%bound_N, trim(domain%name)//
" bound_N")
 
 1565     if(debug_message_passing) 
then 
 1568        call check_message_size(domain, domain%update_T, send, recv, 
'T')
 
 1569        call check_message_size(domain, domain%update_C, send, recv, 
'C')
 
 1570        call check_message_size(domain, domain%update_E, send, recv, 
'E')
 
 1571        call check_message_size(domain, domain%update_N, send, recv, 
'N')
 
 1576     deallocate(align1, align2, is1, ie1, js1, je1, is2, ie2, js2, je2  )
 
 1577     deallocate(isglist, ieglist, jsglist, jeglist, refine1, refine2 )
 
 1593   subroutine compute_overlaps( domain, position, update, check, ishift, jshift, x_cyclic_offset, y_cyclic_offset, &
 
 1594                                whalo, ehalo, shalo, nhalo )
 
 1595     type(domain2d), 
intent(inout) :: domain
 
 1596     type(overlapspec), 
intent(inout), 
pointer :: update
 
 1597     type(overlapspec), 
intent(inout), 
pointer :: check
 
 1598     integer, 
intent(in)           :: position, ishift, jshift
 
 1599     integer, 
intent(in)           :: x_cyclic_offset, y_cyclic_offset
 
 1600     integer, 
intent(in)           :: whalo, ehalo, shalo, nhalo
 
 1602     integer                          :: i, m, n, nlist, tMe, tNbr, dir
 
 1603     integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd, jed
 
 1604     integer                          :: isg, ieg, jsg, jeg, ioff, joff
 
 1605     integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
 
 1606     integer                          :: ism, iem, jsm, jem
 
 1607     integer                          :: is2, ie2, js2, je2
 
 1608     integer                          :: is3, ie3, js3, je3
 
 1609     integer                          :: isd3, ied3, jsd3, jed3
 
 1610     integer                          :: isd2, ied2, jsd2, jed2
 
 1611     logical                          :: folded, need_adjust_1, need_adjust_2, need_adjust_3, folded_north
 
 1612     type(overlap_type)               :: overlap
 
 1613     type(overlap_type),  
pointer     :: overlapList(:)=>null()
 
 1614     type(overlap_type),  
pointer     :: checkList(:)=>null()
 
 1615     integer                          :: nsend, nrecv
 
 1616     integer                          :: nsend_check, nrecv_check
 
 1618     logical                          :: set_check
 
 1623     if(
size(domain%x(:)) > 1) 
return 
 1626     if(whalo==0 .AND. ehalo==0 .AND. shalo==0 .AND. nhalo==0) 
return 
 1629     nlist = 
size(domain%list(:))
 
 1631     if(
ASSOCIATED(check)) set_check = .true.
 
 1632     allocate(overlaplist(maxlist) )
 
 1633     if(set_check) 
allocate(checklist(maxlist)   )
 
 1636     call allocate_update_overlap( overlap, maxoverlap)
 
 1638     call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position )
 
 1639     call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position ) 
 
 1640     call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
 
 1642     update%xbegin = ism; update%xend = iem
 
 1643     update%ybegin = jsm; update%yend = jem
 
 1645        check%xbegin  = ism; check%xend  = iem
 
 1646        check%ybegin  = jsm; check%yend  = jem
 
 1648     update%whalo  = whalo; update%ehalo = ehalo
 
 1649     update%shalo  = shalo; update%nhalo = nhalo
 
 1653     middle = (isg+ieg)/2+1
 
 1655     folded_north = btest(domain%fold,north)
 
 1656     if( btest(domain%fold,south) .OR. btest(domain%fold,east) .OR. btest(domain%fold,west) ) 
then 
 1657        call mpp_error(fatal,
"mpp_domains_define.inc(compute_overlaps): folded south, east or west boundary condition "&
 
 1658             &//
"is not supported, please use other version of compute_overlaps for "//trim(domain%name))
 
 1665        m = mod( domain%pos+list, nlist )
 
 1666        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 1669           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 1670           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 1672           if( domain%symmetry .AND. (position == north .OR. position == corner ) &
 
 1673                .AND. ( jsc == je .or. jec == js ) ) 
then 
 1678              if( je == jeg .AND. folded_north .AND. (position == corner .OR. position == north) ) 
then 
 1679                 call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1680                                     isg, ieg, dir, ishift, position, ioff, middle)
 
 1682                 if(x_cyclic_offset ==0 .AND. y_cyclic_offset == 0) 
then 
 1683                    call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1684                         isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
 
 1686                    if( ie.GT.ieg ) 
then 
 1687                       if( domain%x(tme)%cyclic .AND. iec.LT.is )
then  
 1688                          is = is-ioff; ie = ie-ioff
 
 1692                    call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1693                         isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 1700           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 1701           js = domain%list(m)%y(tnbr)%compute%begin-shalo;  je = domain%list(m)%y(tnbr)%compute%begin-1
 
 1702           need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 1705           is2 = 0; ie2 = -1; js2 = 0; je2 = -1
 
 1706           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 1707              if(je .LT. jsg) 
then  
 1708                 if( domain%y(tme)%cyclic ) 
then 
 1709                    js = js + joff; je = je + joff
 
 1711              else if(js .Lt. jsg) 
then  
 1712                 if( domain%y(tme)%cyclic ) 
then 
 1713                    js2 = js + joff; je2 = jsg-1+joff
 
 1717              call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1718                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 1719              if(je2 .GE. js2) 
call fill_overlap_send_nofold(overlap, domain, m, is, ie, js2, je2, isc, iec, jsc, jec, &
 
 1720                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 1723                 if( domain%x(tme)%cyclic .AND. iec.LT.is )
then  
 1724                    is = is-ioff; ie = ie-ioff
 
 1725                    need_adjust_1 = .false.
 
 1726                    if(jsg .GT. js) 
then 
 1727                       if( domain%y(tme)%cyclic .AND. je.LT.jsc )
then  
 1728                          js = js+joff; je = je+joff
 
 1729                          need_adjust_2 = .false.
 
 1730                          if(x_cyclic_offset .NE. 0) 
then 
 1732                          else if(y_cyclic_offset .NE. 0) 
then 
 1738                       need_adjust_3 = .false.
 
 1742              if( need_adjust_3 .AND. jsg.GT.js )
then 
 1743                 if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. je.LT.jsc )
then  
 1744                    js = js+joff; je = je+joff
 
 1745                    if(need_adjust_1 .AND. ie.LE.ieg) 
then 
 1750              call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, isg, ieg, jsg, jeg, dir)
 
 1755           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 1756           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 1759              if( domain%y(tme)%cyclic .AND. je.LT.jsc )
then  
 1760                 js = js+joff; je = je+joff
 
 1763           else if (jsg .GT. js) 
then  
 1764              if( domain%y(tme)%cyclic) 
then 
 1765                 js2 = js + joff; je2 = jsg-1+joff
 
 1770           call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1771                                     isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 1772           if(je2 .GE. js2) 
call fill_overlap(overlap, domain, m, is, ie, js2, je2, isc, iec, jsc, jec, &
 
 1773                                     isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 1777           is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 1778           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 1779           need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 1780           is2 = 0; ie2 = -1; js2 = 0; je2 = -1
 
 1781           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 1782              if(je .LT. jsg) 
then  
 1783                 if( domain%y(tme)%cyclic ) 
then 
 1784                    js = js + joff; je = je + joff
 
 1786              else if(js .Lt. jsg) 
then  
 1787                 if( domain%y(tme)%cyclic ) 
then 
 1788                    js2 = js + joff; je2 = jsg-1+joff
 
 1792              call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1793                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 1794              if(je2 .GE. js2) 
call fill_overlap_send_nofold(overlap, domain, m, is, ie, js2, je2, isc, iec, jsc, jec, &
 
 1795                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 1798                 if( domain%x(tme)%cyclic .AND. ie.LT.isc )
then  
 1799                    is = is+ioff; ie = ie+ioff
 
 1800                    need_adjust_1 = .false.
 
 1801                    if(jsg .GT. js) 
then 
 1802                       if( domain%y(tme)%cyclic .AND. je.LT.jsc )
then  
 1803                          js = js+joff; je = je+joff
 
 1804                          need_adjust_2 = .false.
 
 1805                          if(x_cyclic_offset .NE. 0) 
then 
 1807                          else if(y_cyclic_offset .NE. 0) 
then 
 1813                       need_adjust_3 = .false.
 
 1817              if( need_adjust_3 .AND. jsg.GT.js )
then 
 1818                 if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. je.LT.jsc )
then  
 1819                    js = js+joff; je = je+joff
 
 1820                    if(need_adjust_1 .AND. isg.LE.is  )
then 
 1825              call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, isg, ieg, jsg, jeg, dir)
 
 1830           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 1831           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 1835           if( je == jeg .AND. folded_north .AND. (position == corner .OR. position == north)) 
then 
 1836              call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1837                                     isg, ieg, dir, ishift, position, ioff, middle)
 
 1839              if(x_cyclic_offset ==0 .AND. y_cyclic_offset == 0) 
then 
 1840                 call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1841                      isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
 
 1844                    if( domain%x(tme)%cyclic .AND. ie.LT.isc )
then  
 1845                       is = is+ioff; ie = ie+ioff
 
 1849                 call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1850                      isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 1856           is = domain%list(m)%x(tnbr)%compute%begin-whalo;  ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 1857           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 1858           is2 = 0; ie2 = -1; js2 = 0; je2 = -1
 
 1859           is3 = 0; ie3 = -1; js3 = 0; je3 = -1
 
 1861           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 1862              if(js .GT. jeg) 
then  
 1863                 if( domain%y(tme)%cyclic ) 
then 
 1864                    js = js-joff; je = je-joff
 
 1865                 else if(folded_north )
then 
 1867                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 1869              else if(je .GT. jeg) 
then  
 1870                 if( domain%y(tme)%cyclic ) 
then 
 1871                    is2 = is; ie2 = ie; js2 = js; je2 = jeg
 
 1872                    js = jeg+1-joff; je = je -joff
 
 1873                 else if(folded_north) 
then 
 1875                    is2 = is; ie2 = ie; js2 = js; je2 = jeg
 
 1877                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 1878                    if( is .GT. ieg) 
then 
 1879                      is = is - ioff; ie = ie - ioff
 
 1880                    else if( ie .GT. ieg ) 
then 
 1881                      is3 = is; ie3 = ieg; js3 = js; je3 = je
 
 1882                      is = ieg+1-ioff; ie = ie - ioff
 
 1887              if( je == jeg .AND. jec == jeg .AND. folded_north .AND. (position == corner .OR. position == north)) 
then 
 1888                 call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1889                                     isg, ieg, dir, ishift, position, ioff, middle)
 
 1891                 call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1892                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 1894              if(ie3 .GE. is3) 
call fill_overlap_send_nofold(overlap, domain, m, is3, ie3, js3, je3, &
 
 1895                                     isc, iec, jsc, jec, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 1896              if(ie2 .GE. is2) 
then 
 1897                 if(je2 == jeg .AND. jec == jeg .AND. folded_north.AND.(position == corner .OR. position == north))
then 
 1898                    call fill_overlap_send_fold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
 
 1899                                     isg, ieg, dir, ishift, position, ioff, middle)
 
 1901                    call fill_overlap_send_nofold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
 
 1902                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 1906              need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 1908                 if( domain%x(tme)%cyclic .AND. ie.LT.isc )
then  
 1909                    is = is+ioff; ie = ie+ioff
 
 1910                    need_adjust_1 = .false.
 
 1911                    if(je .GT. jeg) 
then 
 1912                       if( domain%y(tme)%cyclic .AND. jec.LT.js )
then  
 1913                          js = js-joff; je = je-joff
 
 1914                          need_adjust_2 = .false.
 
 1915                          if(x_cyclic_offset .NE. 0) 
then 
 1917                          else if(y_cyclic_offset .NE. 0) 
then 
 1923                       need_adjust_3 = .false.
 
 1928              if( need_adjust_3 .AND. je.GT.jeg )
then 
 1929                 if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. jec.LT.js )
then  
 1930                    js = js-joff; je = je-joff
 
 1931                    if( need_adjust_1  .AND. isg.LE.is)
then 
 1934                 else if( folded_north )
then 
 1936                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 1939              call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1940                   isg, ieg, jsg, jeg, dir)
 
 1947           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 1948           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 1953           if( domain%symmetry .AND. (position == east .OR. position == corner ) &
 
 1954                .AND. ( isc == ie .or. iec == is ) .AND. (.not. folded_north) ) 
then 
 1958              if( js .GT. jeg) 
then  
 1959                 if( domain%y(tme)%cyclic .AND. jec.LT.js )
then  
 1960                    js = js-joff; je = je-joff
 
 1962                 else if( folded_north )
then 
 1964                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 1966              else if( je.GT.jeg )
then  
 1967                 if( domain%y(tme)%cyclic)
then  
 1968                    is2 = is; ie2 = ie; js2 = js;         je2 = jeg
 
 1969                    js = jeg+1-joff; je = je - joff
 
 1970                 else if( folded_north )
then 
 1972                    is2 = is; ie2 = ie; js2 = js; je2 = jeg
 
 1974                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 1977              if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 1978                 if( je == jeg .AND. jec == jeg .AND. folded_north .AND.(position == corner .OR. position == north))
then 
 1979                    call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1980                         isg, ieg, dir, ishift, position, ioff, middle, domain%symmetry)
 
 1982                    call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1983                         isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded, domain%symmetry)
 
 1986                 call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 1987                   isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 1990              if(ie2 .GE. is2) 
then 
 1991                 if(je2 == jeg .AND. jec == jeg .AND. folded_north .AND.(position == corner .OR. position == north))
then 
 1992                    call fill_overlap_send_fold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
 
 1993                                     isg, ieg, dir, ishift, position, ioff, middle, domain%symmetry)
 
 1995                    call fill_overlap_send_nofold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
 
 1996                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
 
 2002           if(is .LT. isg .AND. domain%x(tme)%cyclic) 
then 
 2013           if( folded_north .AND. (position == north .OR. position == corner) &
 
 2014               .AND. domain%x(tme)%pos .LT. (
size(domain%x(tme)%list(:))+1)/2 ) 
then 
 2015              if( domain%list(m)%y(tnbr)%compute%end+nhalo+jshift .GE. jeg .AND. isc .LE. middle)
then 
 2017                 is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 2018                 is = max(is, middle)
 
 2019                 select case (position)
 
 2021                    i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 2023                    i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 2025                 call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 2026                      is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 2028              if(debug_update_level .NE. no_check .AND. set_check) 
then 
 2029                 je = domain%list(m)%y(tnbr)%compute%end+jshift;
 
 2031                    is = max(is, isc); ie = min(ie, iec)
 
 2032                    js = max(js, jsc); je = min(je, jec)
 
 2033                    if(ie.GE.is .AND. je.GE.js )
then 
 2034                       nsend_check = nsend_check+1
 
 2035                       if(nsend_check > 
size(checklist(:)) ) 
then 
 2036                          call expand_check_overlap_list(checklist, nlist)
 
 2038                       call allocate_check_overlap(checklist(nsend_check), 1)
 
 2039                       call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
 
 2040                            tme, 4, one_hundred_eighty, is, ie, js, je)
 
 2048           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 2049           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 2050           is2 = 0; ie2=-1; js2=0; je2=-1
 
 2051           is3 = 0; ie3 = -1; js3 = 0; je3 = -1
 
 2052           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2054              if(js .GT. jeg) 
then  
 2055                 if( domain%y(tme)%cyclic ) 
then 
 2056                    js = js-joff; je = je-joff
 
 2057                 else if(folded_north )
then 
 2059                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2061              else if(je .GT. jeg) 
then  
 2062                 if( domain%y(tme)%cyclic ) 
then 
 2063                    is2 = is; ie2 = ie; js2 = js; je2 = jeg
 
 2064                    js = jeg+1-joff; je = je -joff
 
 2065                 else if(folded_north) 
then 
 2067                    is2 = is; ie2 = ie; js2 = js; je2 = jeg
 
 2069                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2071                    if( ie .LT. isg )
then 
 2072                       is = is+ioff; ie = ie+ioff
 
 2073                    else if( is .LT. isg) 
then 
 2074                       is3 = isg; ie3 = ie; js3 = js; je3 = je
 
 2075                       is = is+ioff; ie = isg-1+ioff;
 
 2079              if( je == jeg .AND. jec == jeg .AND. folded_north .AND. (position == corner .OR. position == north)) 
then 
 2080                 call fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 2081                      isg, ieg, dir, ishift, position, ioff, middle)
 
 2083                 call fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 2084                      isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 2086              if(ie3 .GE. is3) 
call fill_overlap_send_nofold(overlap, domain, m, is3, ie3, js3, je3, &
 
 2087                                     isc, iec, jsc, jec, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 2088              if(ie2 .GE. is2) 
then 
 2089                 if(je2 == jeg .AND. jec == jeg .AND. folded_north .AND.(position == corner .OR. position == north))
then 
 2090                    call fill_overlap_send_fold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
 
 2091                                     isg, ieg, dir, ishift, position, ioff, middle)
 
 2093                    call fill_overlap_send_nofold(overlap, domain, m, is2, ie2, js2, je2, isc, iec, jsc, jec, &
 
 2094                                     isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 2098              need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 2100                 if( domain%x(tme)%cyclic .AND. iec.LT.is )
then  
 2101                    is = is-ioff; ie = ie-ioff
 
 2102                    need_adjust_1 = .false.
 
 2103                    if(je .GT. jeg) 
then 
 2104                       if( domain%y(tme)%cyclic .AND. jec.LT.js )
then  
 2105                          js = js-joff; je = je-joff
 
 2106                          need_adjust_2 = .false.
 
 2107                          if(x_cyclic_offset .NE. 0) 
then 
 2109                          else if(y_cyclic_offset .NE. 0) 
then 
 2115                       need_adjust_3 = .false.
 
 2120              if( need_adjust_3 .AND. je.GT.jeg )
then 
 2121                 if( need_adjust_2 .AND. domain%y(tme)%cyclic .AND. jec.LT.js )
then  
 2122                    js = js-joff; je = je-joff
 
 2123                    if( need_adjust_1 .AND. ie.LE.ieg)
then 
 2126                 else if( folded_north )
then 
 2128                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2131              call fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 2132                   isg, ieg, jsg, jeg, dir)
 
 2137        if( overlap%count > 0) 
then 
 2139          if(nsend > 
size(overlaplist(:)) ) 
then 
 2140             call mpp_error(note, 
'mpp_domains_define.inc(compute_overlaps): overlapList for send is expanded')
 
 2141             call expand_update_overlap_list(overlaplist, nlist)
 
 2143          call add_update_overlap( overlaplist(nsend), overlap)
 
 2144          call init_overlap_type(overlap)
 
 2148     if(debug_message_passing) 
then 
 2152           write(iunit, *) 
"********to_pe = " ,overlaplist(m)%pe, 
" count = ",overlaplist(m)%count
 
 2153           do n = 1, overlaplist(m)%count
 
 2154              write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
 
 2155                   overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
 
 2158        if(nsend >0) 
flush(iunit)
 
 2163       if (
associated(update%send)) 
deallocate(update%send) 
 
 2164        allocate(update%send(nsend))
 
 2165        update%nsend = nsend
 
 2167           call add_update_overlap( update%send(m), overlaplist(m) )
 
 2171     if(nsend_check>0) 
then 
 2172        check%nsend = nsend_check
 
 2173        if (
associated(check%send)) 
deallocate(check%send) 
 
 2174        allocate(check%send(nsend_check))
 
 2175        do m = 1, nsend_check
 
 2180     do m = 1,
size(overlaplist(:))
 
 2181        call deallocate_overlap_type(overlaplist(m))
 
 2184     if(debug_update_level .NE. no_check .AND. set_check) 
then 
 2185        do m = 1,
size(checklist(:))
 
 2186           call deallocate_overlap_type(checklist(m))
 
 2190     isgd = isg - domain%whalo
 
 2191     iegd = ieg + domain%ehalo
 
 2192     jsgd = jsg - domain%shalo
 
 2193     jegd = jeg + domain%nhalo
 
 2199        m = mod( domain%pos+nlist-list, nlist )
 
 2200        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 2201           isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
 
 2202           jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
 
 2205           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%compute%end+ehalo+ishift
 
 2206           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 2207           is=isc; ie=iec; js=jsc; je=jec
 
 2208           if( domain%symmetry .AND. (position == north .OR. position == corner ) &
 
 2209                .AND. ( jsd == je .or. jed == js ) ) 
then 
 2214              if( jed == jeg .AND. folded_north .AND. (position == corner .OR. position == north) ) 
then 
 2215                 call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2216                      isg, ieg, dir, ishift, position, ioff, middle)
 
 2218                 if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2219                    call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2220                         isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 2222                    if( ied.GT.ieg )
then 
 2223                       if( domain%x(tme)%cyclic .AND. ie.LT.isd )
then  
 2224                          is = is+ioff; ie = ie+ioff
 
 2228                    call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2229                       isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 2236           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%compute%end+ehalo+ishift
 
 2237           jsd = domain%y(tme)%compute%begin-shalo;    jed = domain%y(tme)%compute%begin-1
 
 2238           is=isc; ie=iec; js=jsc; je=jec
 
 2241           is2 = 0; ie2 = -1; js2 = 0; je2 = -1
 
 2242           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2243              if(jed .LT. jsg) 
then  
 2244                 if( domain%y(tme)%cyclic ) 
then 
 2245                    js = js-joff; je = je-joff
 
 2247              else if(jsd .LT. jsg) 
then  
 2248                 if( domain%y(tme)%cyclic ) 
then 
 2249                    js2 = js-joff; je2 = je-joff
 
 2252              call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2253                      isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 2254              if(je2 .GE. js2) 
call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js2, je2, isd, ied, jsd, jed, &
 
 2255                      isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 2257              need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 2258              if( jsd.LT.jsg )
then 
 2259                 if( domain%y(tme)%cyclic .AND. js.GT.jed )
then  
 2260                    js = js-joff; je = je-joff
 
 2261                    need_adjust_1 = .false.
 
 2262                    if( ied.GT.ieg )
then 
 2263                       if( domain%x(tme)%cyclic .AND. ie.LT.isd )
then  
 2264                          is = is+ioff; ie = ie+ioff
 
 2265                          need_adjust_2 = .false.
 
 2266                          if(x_cyclic_offset .NE. 0) 
then 
 2268                          else if(y_cyclic_offset .NE. 0) 
then 
 2274                       need_adjust_3 = .false.
 
 2278              if( need_adjust_3 .AND. ied.GT.ieg )
then 
 2279                 if( need_adjust_2 .AND. domain%x(tme)%cyclic .AND. ie.LT.isd )
then  
 2280                    is = is+ioff; ie = ie+ioff
 
 2281                    if( need_adjust_1 .AND. jsd.GE.jsg )
then 
 2286              call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2287                  isg, ieg, jsg, jeg, dir)
 
 2292           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 2293           jsd = domain%y(tme)%compute%begin-shalo;    jed = domain%y(tme)%compute%begin-1
 
 2294           is=isc; ie=iec; js=jsc; je=jec
 
 2296           if( jed .LT. jsg) 
then  
 2297              if( domain%y(tme)%cyclic ) 
then 
 2298                 js = js-joff; je = je-joff
 
 2301           else if( jsd.LT.jsg )
then  
 2302              if( domain%y(tme)%cyclic)
then  
 2303                 js2 = js-joff; je2 = je-joff
 
 2306           call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2307                isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 2308           if(je2 .GE. js2) 
call fill_overlap(overlap, domain, m, is, ie, js2, je2, isd, ied, jsd, jed, &
 
 2309                isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 2313           isd = domain%x(tme)%compute%begin-whalo; ied = domain%x(tme)%compute%begin-1
 
 2314           jsd = domain%y(tme)%compute%begin-shalo; jed = domain%y(tme)%compute%begin-1
 
 2315           is=isc; ie=iec; js=jsc; je=jec
 
 2316           is2 = 0; ie2 = -1; js2 = 0; je2 = -1
 
 2317           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2318              if( ied.LT.isg )
then  
 2319                 if( domain%x(tme)%cyclic ) 
then 
 2320                    is = is-ioff; ie = ie-ioff
 
 2322              else if (isd.LT.isg )
then  
 2323                 if( domain%x(tme)%cyclic ) 
then 
 2324                    is2 = is-ioff; ie2 = ie-ioff
 
 2327              if( jed.LT.jsg )
then   
 2328                 if( domain%y(tme)%cyclic ) 
then 
 2329                    js = js-joff; je = je-joff
 
 2331              else if( jsd.LT.jsg )
then  
 2332                 if( domain%y(tme)%cyclic ) 
then 
 2333                    js2 = js-joff; je2 = je-joff
 
 2337              need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 2338              if( jsd.LT.jsg )
then 
 2339                 if( domain%y(tme)%cyclic .AND. js.GT.jed )
then  
 2340                    js = js-joff; je = je-joff
 
 2341                    need_adjust_1 = .false.
 
 2342                    if( isd.LT.isg )
then 
 2343                       if( domain%x(tme)%cyclic .AND. is.GT.ied )
then  
 2344                          is = is-ioff; ie = ie-ioff
 
 2345                          need_adjust_2 = .false.
 
 2346                          if(x_cyclic_offset .NE. 0) 
then 
 2348                          else if(y_cyclic_offset .NE. 0) 
then 
 2354                       need_adjust_3 = .false.
 
 2358              if( need_adjust_3 .AND. isd.LT.isg )
then 
 2359                 if( need_adjust_2 .AND. domain%x(tme)%cyclic .AND. is.GT.ied )
then  
 2360                    is = is-ioff; ie = ie-ioff
 
 2361                    if(need_adjust_1 .AND. jsd.GE.jsg) 
then 
 2367           call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2368                isg, ieg, jsg, jeg, dir)
 
 2370           if(ie2 .GE. is2)
call fill_overlap(overlap, domain, m, is2, ie2, js, je, isd, ied, jsd, jed, &
 
 2371                isg, ieg, jsg, jeg, dir)
 
 2372           if(je2 .GE. js2)
call fill_overlap(overlap, domain, m, is, ie, js2, je2, isd, ied, jsd, jed, &
 
 2373                isg, ieg, jsg, jeg, dir)
 
 2375           if(ie2 .GE. is2 .AND. je2 .GE. js2)
call fill_overlap(overlap, domain, m, is2, ie2, js2, je2, isd, ied, jsd, &
 
 2376                & jed, isg, ieg, jsg, jeg, dir)
 
 2381           isd = domain%x(tme)%compute%begin-whalo;    ied = domain%x(tme)%compute%begin-1
 
 2382           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 2383           is=isc; ie=iec; js=jsc; je=jec
 
 2387           if( jed == jeg .AND. folded_north .AND. (position == corner .OR. position == north) ) 
then 
 2388              call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2389                   isg, ieg, dir, ishift, position, ioff, middle)
 
 2391              if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2392                 call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2393                      isg, ieg, dir, ioff, domain%x(tme)%cyclic, symmetry=domain%symmetry)
 
 2395                 if( isd.LT.isg )
then 
 2396                    if( domain%x(tme)%cyclic .AND. is.GT.ied )
then  
 2397                       is = is-ioff; ie = ie-ioff
 
 2401                 call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2402                      isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 2409           isd = domain%x(tme)%compute%begin-whalo;    ied = domain%x(tme)%compute%begin-1
 
 2410           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%compute%end+nhalo+jshift
 
 2411           is=isc; ie=iec; js=jsc; je=jec
 
 2412           is2 = 0; ie2 = -1; js2 = 0; je2 = -1
 
 2413           is3 = 0; ie3 = -1; js3 = 0; je3 = -1
 
 2414           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2416              if( jsd .GT. jeg ) 
then  
 2417                 if( domain%y(tme)%cyclic .AND. je.LT.jsd )
then  
 2418                    js = js+joff; je = je+joff
 
 2420                 else if( folded_north )
then 
 2422                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2424              else if( jed.GT.jeg )
then  
 2425                 if( domain%y(tme)%cyclic)
then  
 2426                    is2 = is; ie2 = ie; js2 = js; je2 = je
 
 2427                    isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
 
 2428                    js = js + joff; je = je + joff
 
 2430                 else if( folded_north )
then 
 2432                    is2 = is; ie2 = ie; js2 = js; je2 = je
 
 2433                    isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
 
 2435                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2436                    if(isd < isg .and. ied .GE. isg .and. domain%symmetry) 
then 
 2437                       isd3 = isd; ied3 = isg-1
 
 2438                       jsd3 = jsd; jed3 = jed
 
 2439                       is3 = is-ioff; ie3=ie-ioff
 
 2446              if( jeg .GE. js .AND. jeg .LE. je .AND. jed == jeg .AND. folded_north &
 
 2447                   .AND. (position == corner .OR. position == north)) 
then 
 2448                 call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2449                      isg, ieg, dir, ishift, position, ioff, middle)
 
 2451                 call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2452                      isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 2455              if(ie3 .GE. is3) 
call fill_overlap_recv_nofold(overlap, domain, m, is3, ie3, js3, je3, isd3, ied3, jsd3, &
 
 2456                      & jed3, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 2458              if(ie2 .GE. is2) 
then 
 2459                 if( jeg .GE. js2 .AND. jeg .LE. je2 .AND. jed2 == jeg .AND. folded_north &
 
 2460                     .AND. (position == corner .OR. position == north)) 
then 
 2461                    call fill_overlap_recv_fold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
 
 2462                         isg, ieg, dir, ishift, position, ioff, middle)
 
 2464                    call fill_overlap_recv_nofold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
 
 2465                         isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 2469              need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 2470              if( jed.GT.jeg )
then 
 2471                 if( domain%y(tme)%cyclic .AND. je.LT.jsd )
then  
 2472                    js = js+joff; je = je+joff
 
 2473                    need_adjust_1 = .false.
 
 2474                    if( isd.LT.isg )
then 
 2475                       if( domain%x(tme)%cyclic .AND. is.GE.ied )
then  
 2476                          is = is-ioff; ie = ie-ioff
 
 2477                          need_adjust_2 = .false.
 
 2478                          if(x_cyclic_offset .NE. 0) 
then 
 2480                          else if(y_cyclic_offset .NE. 0) 
then 
 2486                       need_adjust_3 = .false.
 
 2488                 else if( folded_north )
then 
 2490                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2493              if( need_adjust_3 .AND. isd.LT.isg )
then 
 2494                 if( need_adjust_2 .AND. domain%x(tme)%cyclic .AND. is.GE.ied )
then  
 2495                    is = is-ioff; ie = ie-ioff
 
 2496                    if( need_adjust_1 .AND. jed.LE.jeg )
then 
 2501              call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2502                   isg, ieg, jsg, jeg, dir)
 
 2506           if(is .LT. isg .AND. domain%x(tme)%cyclic) 
then 
 2508              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 2509                                         is, is, js, je, isd, ied, jsd, jed, dir, folded )
 
 2515           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 2516           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%compute%end+nhalo+jshift
 
 2517           is=isc; ie=iec; js=jsc; je=jec
 
 2521           if( domain%symmetry .AND. (position == east .OR. position == corner ) &
 
 2522                .AND. (isd == ie .or. ied == is ) .AND. (.not. folded_north) ) 
then 
 2526              if( jsd .GT. jeg ) 
then  
 2527                 if( domain%y(tme)%cyclic .AND. je.LT.jsd )
then  
 2528                    js = js+joff; je = je+joff
 
 2530                 else if( folded_north )
then 
 2532                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2534              else if( jed.GT.jeg )
then  
 2535                 if( domain%y(tme)%cyclic)
then  
 2536                    is2 = is; ie2 = ie; js2 = js; je2 = je
 
 2537                    isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
 
 2538                    js = js + joff; je = je + joff
 
 2540                 else if( folded_north )
then 
 2542                    is2 = is; ie2 = ie; js2 = js; je2 = je
 
 2543                    isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
 
 2545                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2548              if(x_cyclic_offset == 0 .and. y_cyclic_offset == 0) 
then 
 2549                 if( jeg .GE. js .AND. jeg .LE. je .AND. jed == jeg .AND. folded_north &
 
 2550                      .AND. (position == corner .OR. position == north)) 
then 
 2551                    call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2552                         isg, ieg, dir, ishift, position, ioff, middle, symmetry=domain%symmetry)
 
 2554                    call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2555                         isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded, symmetry=domain%symmetry)
 
 2558                 call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2559                      isg, ieg, jsg, jeg, dir, symmetry=domain%symmetry)
 
 2561              if(ie2 .GE. is2) 
then 
 2562                 if(jeg .GE. js2 .AND. jeg .LE. je2 .AND. jed2 == jeg .AND. folded_north &
 
 2563                    .AND. (position == corner .OR. position == north)) 
then 
 2564                    call fill_overlap_recv_fold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
 
 2565                         isg, ieg, dir, ishift, position, ioff, middle, symmetry=domain%symmetry)
 
 2567                    call fill_overlap_recv_nofold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
 
 2568                         isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded, symmetry=domain%symmetry)
 
 2574           if(is .LT. isg .AND. domain%x(tme)%cyclic) 
then 
 2584           if( folded_north .AND. (position == north .OR. position == corner) &
 
 2585                .AND. domain%x(tme)%pos .GE. 
size(domain%x(tme)%list(:))/2) 
then 
 2586              if( jed .GE. jeg .AND. ied .GE. middle)
then 
 2587                 jsd = jeg; jed = jeg
 
 2588                 is=isc; ie=iec; js = jsc; je = jec
 
 2589                 isd = max(isd, middle)
 
 2590                 select case (position)
 
 2592                    i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 2594                    i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 2596                 call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 2597                      is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
 
 2599              if(debug_update_level .NE. no_check .AND. set_check) 
then 
 2600                 jsd = domain%y(tme)%compute%end+jshift;   jed = jsd
 
 2602                    is = max(is, isd); ie = min(ie, ied)
 
 2603                    js = max(js, jsd); je = min(je, jed)
 
 2604                    if(ie.GE.is .AND. je.GE.js )
then 
 2605                       nrecv_check = nrecv_check+1
 
 2606                       if(nrecv_check > 
size(checklist(:)) ) 
then 
 2607                          call expand_check_overlap_list(checklist, nlist)
 
 2609                       call allocate_check_overlap(checklist(nrecv_check), 1)
 
 2610                       call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
 
 2611                            tme, 4, one_hundred_eighty, is, ie, js, je)
 
 2621           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%compute%end+ehalo+ishift
 
 2622           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%compute%end+nhalo+jshift
 
 2623           is=isc; ie=iec; js=jsc; je=jec
 
 2624           is2 = 0; ie2=-1; js2=0; je2=-1
 
 2625           is3 = 0; ie3 = -1; js3 = 0; je3 = -1
 
 2626           if(x_cyclic_offset == 0 .AND. y_cyclic_offset == 0) 
then 
 2628              if( jsd .GT. jeg ) 
then  
 2629                 if( domain%y(tme)%cyclic .AND. je.LT.jsd )
then  
 2630                    js = js+joff; je = je+joff
 
 2632                 else if( folded_north )
then 
 2634                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2636              else if( jed.GT.jeg )
then  
 2637                 if( domain%y(tme)%cyclic)
then  
 2638                    is2 = is; ie2 = ie; js2 = js; je2 = je
 
 2639                    isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
 
 2640                    js = js + joff; je = je + joff
 
 2642                 else if( folded_north )
then 
 2644                    is2 = is; ie2 = ie; js2 = js; je2 = je
 
 2645                    isd2 = isd; ied2 = ied; jsd2 = jsd; jed2 = jeg
 
 2647                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2648                    if(ied > ieg .and. isd .LE. ieg .and. domain%symmetry) 
then 
 2649                       isd3 = ieg+1; ied3 = ied
 
 2650                       jsd3 = jsd; jed3 = jed
 
 2651                       is3 = is+ioff; ie3=ie+ioff
 
 2657              if( jeg .GE. js .AND. jeg .LE. je .AND. jed == jeg .AND. folded_north &
 
 2658                   .AND. (position == corner .OR. position == north)) 
then 
 2659                 call fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2660                      isg, ieg, dir, ishift, position, ioff, middle)
 
 2662                 call fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2663                      isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 2665              if(ie3 .GE. is3) 
call fill_overlap_recv_nofold(overlap, domain, m, is3, ie3, js3, je3, isd3, ied3, jsd3, &
 
 2666                      & jed3, isg, ieg, dir, ioff, domain%x(tme)%cyclic, folded)
 
 2667              if(ie2 .GE. is2) 
then 
 2668                 if(jeg .GE. js2 .AND. jeg .LE. je2 .AND. jed2 == jeg .AND. folded_north &
 
 2669                      .AND. (position == corner .OR. position == north)) 
then 
 2670                    call fill_overlap_recv_fold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
 
 2671                         isg, ieg, dir, ishift, position, ioff, middle)
 
 2673                    call fill_overlap_recv_nofold(overlap, domain, m, is2, ie2, js2, je2, isd2, ied2, jsd2, jed2, &
 
 2674                         isg, ieg, dir, ioff, domain%x(tme)%cyclic)
 
 2678              need_adjust_1 = .true.; need_adjust_2 = .true.; need_adjust_3 = .true.
 
 2679              if( jed.GT.jeg )
then 
 2680                 if( domain%y(tme)%cyclic .AND. je.LT.jsd )
then  
 2681                    js = js+joff; je = je+joff
 
 2682                    need_adjust_1 = .false.
 
 2683                    if( ied.GT.ieg )
then 
 2684                       if( domain%x(tme)%cyclic .AND. ie.LT.isd )
then  
 2685                          is = is+ioff; ie = ie+ioff
 
 2686                          need_adjust_2 = .false.
 
 2687                          if(x_cyclic_offset .NE. 0) 
then 
 2689                          else if(y_cyclic_offset .NE. 0) 
then 
 2695                       need_adjust_3 = .false.
 
 2697                 else if( folded_north )
then 
 2699                    call get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 2702              if(  need_adjust_3 .AND. ied.GT.ieg )
then 
 2703                 if(  need_adjust_2 .AND. domain%x(tme)%cyclic .AND. ie.LT.isd )
then  
 2704                    is = is+ioff; ie = ie+ioff
 
 2705                    if( need_adjust_1 .AND. jed.LE.jeg)
then 
 2710              call fill_overlap(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2711                   isg, ieg, jsg, jeg, dir)
 
 2716        if( overlap%count > 0) 
then 
 2718           if(nrecv > 
size(overlaplist(:)) )
then 
 2719             call mpp_error(note, 
'mpp_domains_define.inc(compute_overlaps): overlapList for recv is expanded')
 
 2720             call expand_update_overlap_list(overlaplist, nlist)
 
 2722           call add_update_overlap( overlaplist(nrecv), overlap)
 
 2723           call init_overlap_type(overlap)
 
 2727     if(debug_message_passing) 
then 
 2731           write(iunit, *) 
"********from_pe = " ,overlaplist(m)%pe, 
" count = ",overlaplist(m)%count
 
 2732           do n = 1, overlaplist(m)%count
 
 2733              write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
 
 2734                   overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
 
 2737        if(nrecv >0) 
flush(iunit)
 
 2742       if (
associated(update%recv)) 
deallocate(update%recv) 
 
 2743        allocate(update%recv(nrecv))
 
 2744        update%nrecv = nrecv
 
 2746           call add_update_overlap( update%recv(m), overlaplist(m) )
 
 2747           do n = 1, update%recv(m)%count
 
 2748              if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) 
then 
 2749                 if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
 
 2750                 if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
 
 2756     if(nrecv_check>0) 
then 
 2757        check%nrecv = nrecv_check
 
 2758        if (
associated(check%recv)) 
deallocate(check%recv) 
 
 2759        allocate(check%recv(nrecv_check))
 
 2760        do m = 1, nrecv_check
 
 2765     call deallocate_overlap_type(overlap)
 
 2766     do m = 1,
size(overlaplist(:))
 
 2767        call deallocate_overlap_type(overlaplist(m))
 
 2770     if(debug_update_level .NE. no_check .AND. set_check) 
then 
 2771        do m = 1,
size(checklist(:))
 
 2772           call deallocate_overlap_type(checklist(m))
 
 2776     deallocate(overlaplist)
 
 2777     if(set_check) 
deallocate(checklist)
 
 2778     domain%initialized = .true.
 
 2783   subroutine fill_overlap_send_nofold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 2784                                     isg, ieg, dir, ioff, is_cyclic, folded, symmetry)
 
 2785     type(overlap_type), 
intent(inout) :: overlap
 
 2786     type(domain2d),     
intent(inout) :: domain
 
 2787     integer,            
intent(in   ) :: m, is, ie, js, je
 
 2788     integer,            
intent(in   ) :: isc, iec, jsc, jec
 
 2789     integer,            
intent(in   ) :: isg, ieg, dir, ioff
 
 2790     logical,            
intent(in   ) :: is_cyclic
 
 2791     logical, 
optional,  
intent(in   ) :: folded, symmetry
 
 2793     call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2794             is, ie, js, je, isc, iec, jsc, jec, dir, reverse=folded, symmetry=symmetry)
 
 2796        if(ie .GT. ieg) 
then 
 2797           call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2798                is-ioff, ie-ioff, js, je, isc, iec, jsc, jec, dir, reverse=folded, symmetry=symmetry)
 
 2799        else if( is .LT. isg ) 
then 
 2800           call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2801                is+ioff, ie+ioff, js, je, isc, iec, jsc, jec, dir, reverse=folded, symmetry=symmetry)
 
 2805   end subroutine fill_overlap_send_nofold
 
 2807   subroutine fill_overlap_send_fold(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 2808                                     isg, ieg, dir, ishift, position, ioff, middle, symmetry)
 
 2809     type(overlap_type), 
intent(inout) :: overlap
 
 2810     type(domain2d),     
intent(inout) :: domain
 
 2811     integer,            
intent(in   ) :: m, is, ie, js, je
 
 2812     integer,            
intent(in   ) :: isc, iec, jsc, jec
 
 2813     integer,            
intent(in   ) :: isg, ieg, dir, ishift, position, ioff, middle
 
 2814     logical, 
optional,  
intent(in   ) :: symmetry
 
 2815     integer                           :: is1, ie1, is2, ie2, i
 
 2819     if(position == corner .AND. .NOT. domain%symmetry .AND. is .LE. isg-1 .AND. ie .GE. isg-1) 
then 
 2820        call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 2821             isg-1+ioff, isg-1+ioff, je, je, isc, iec, jsc, jec, dir, .true.)
 
 2824     is1 = 0; ie1 = -1; is2 = 0; ie2 = -1
 
 2827        is2 = is-ioff; ie2 = ie-ioff
 
 2828     else if( ie > ieg ) 
then  
 2830        is2 = ieg+1-ioff; ie2 = ie-ioff
 
 2831     else if( is .GE. middle ) 
then 
 2833     else if( ie .GE. middle ) 
then  
 2834        is1 = middle; ie1 = ie
 
 2835        is2 = is;     ie2 = middle-1
 
 2836     else if( ie < isg ) 
then  
 2837        is1 = is+ieg-isg+1-ishift; ie1 = ie+ieg-isg+1-ishift
 
 2838     else if( is < isg ) 
then  
 2839        is1 = is+ieg-isg+1-ishift; ie1 = isg-1+ieg-isg+1-ishift
 
 2845     if( ie1 .GE. is1) 
then 
 2846        call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2847             is1, ie1, js, je-1, isc, iec, jsc, jec, dir, symmetry=symmetry)
 
 2849        select case (position)
 
 2851           i=is1; is1 = isg+ieg-ie1; ie1 = isg+ieg-i
 
 2853           i=is1; is1 = isg+ieg-ie1-1+ishift; ie1 = isg+ieg-i-1+ishift
 
 2855        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2856             is1, ie1, je, je, isc, iec, jsc, jec, dir, .true., symmetry=symmetry)
 
 2859     if(ie2 .GE. is2) 
then 
 2860        call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2861             is2, ie2, js, je, isc, iec, jsc, jec, dir)
 
 2864   end subroutine fill_overlap_send_fold
 
 2868   subroutine fill_overlap_recv_nofold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2869                                     isg, ieg, dir, ioff, is_cyclic, folded, symmetry)
 
 2870     type(overlap_type), 
intent(inout) :: overlap
 
 2871     type(domain2d),     
intent(inout) :: domain
 
 2872     integer,            
intent(in   ) :: m, is, ie, js, je
 
 2873     integer,            
intent(in   ) :: isd, ied, jsd, jed
 
 2874     integer,            
intent(in   ) :: isg, ieg, dir, ioff
 
 2875     logical,            
intent(in   ) :: is_cyclic
 
 2876     logical, 
optional,  
intent(in   ) :: folded, symmetry
 
 2877     integer                           :: is1, ie1, is2, ie2
 
 2878     integer                           :: isd1, ied1, isd2, ied2
 
 2880     is1 = 0; ie1 = -1; is2 = 0; ie2 = -1
 
 2884     call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2885             is, ie, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
 
 2887        if(ied .GT. ieg) 
then 
 2888           call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2889                is+ioff, ie+ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
 
 2890        else if( isd .LT. isg ) 
then 
 2891           call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2892                is-ioff, ie-ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
 
 2893        else if ( is .LT. isg ) 
then 
 2894           call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2895                is+ioff, ie+ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
 
 2896        else if ( ie .GT. ieg ) 
then 
 2897           call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2898                is-ioff, ie-ioff, js, je, isd, ied, jsd, jed, dir, reverse=folded, symmetry=symmetry)
 
 2902   end subroutine fill_overlap_recv_nofold
 
 2904   subroutine fill_overlap_recv_fold(overlap, domain, m, is, ie, js, je, isd, ied, jsd, jed, &
 
 2905                                     isg, ieg, dir, ishift, position, ioff, middle, symmetry)
 
 2906     type(overlap_type), 
intent(inout) :: overlap
 
 2907     type(domain2d),     
intent(inout) :: domain
 
 2908     integer,            
intent(in   ) :: m, is, ie, js, je
 
 2909     integer,            
intent(in   ) :: isd, ied, jsd, jed
 
 2910     integer,            
intent(in   ) :: isg, ieg, dir, ishift, position, ioff, middle
 
 2911     logical, 
optional,  
intent(in   ) :: symmetry
 
 2912     integer                           :: is1, ie1, is2, ie2, is3, ie3
 
 2913     integer                           :: isd1, ied1, isd2, ied2
 
 2917     if( position == corner .AND. .NOT. domain%symmetry .AND. isd .LE. isg-1 .AND. ied .GE. isg-1 ) 
then 
 2918        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2919             is-ioff, ie-ioff, js, je, isg-1, isg-1, jed, jed, dir, .true.)
 
 2922     is1 = 0;  ie1 = -1; is2 = 0;  ie2 = -1
 
 2925     select case (position)
 
 2927        is3 = isg+ieg-ie; ie3 = isg+ieg-is
 
 2929        is3 = isg+ieg-ie-1+ishift; ie3 = isg+ieg-is-1+ishift
 
 2932     if(isd .GT. ieg) 
then  
 2933        is2 = is + ioff; ie2 = ie + ioff;
 
 2934     else if(ied .GT. ieg) 
then  
 2936        isd1 = isd; ied1 = ieg;
 
 2937        is2 = is + ioff; ie2 = ie + ioff
 
 2938        isd2 = ieg + 1; ied2 = ied
 
 2939     else if(isd .GE. middle) 
then 
 2941     else if(ied .GE. middle) 
then  
 2943        isd1 = middle; ied1 = ied
 
 2945        isd2 = isd; ied2 = middle-1
 
 2946     else if(ied .LT. isg) 
then 
 2947        is1 = is - ioff; ie1 = ie - ioff;
 
 2948        is3 = is3 - ioff; ie3 = ie3 - ioff;
 
 2949     else if(isd .LT. isg) 
then  
 2950        is1 = is - ioff; ie1 = ie - ioff;
 
 2951        is3 = is3 - ioff; ie3 = ie3 - ioff;
 
 2952        isd1 = isd; ied1 = isg-1
 
 2954        isd2 = isg;      ied2 = ied
 
 2957        isd2 = isd; ied2 = ied
 
 2960    if( ie1 .GE. is1) 
then 
 2961       call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2962            is1, ie1, js, je, isd1, ied1, jsd, jed-1, dir, symmetry=symmetry)
 
 2964       call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2965            is3, ie3, js, je, isd1, ied1, jed, jed, dir, .true., symmetry=symmetry)
 
 2968    if(ie2 .GE. is2) 
then 
 2969       call insert_update_overlap( overlap, domain%list(m)%pe,              &
 
 2970            is2, ie2, js, je, isd2, ied2, jsd, jed, dir)
 
 2973   end subroutine fill_overlap_recv_fold
 
 2976   subroutine fill_overlap(overlap, domain, m, is, ie, js, je, isc, iec, jsc, jec, &
 
 2977                                   isg, ieg, jsg, jeg, dir, reverse, symmetry)
 
 2978     type(overlap_type), 
intent(inout) :: overlap
 
 2979     type(domain2d),     
intent(inout) :: domain
 
 2980     integer,            
intent(in   ) :: m, is, ie, js, je
 
 2981     integer,            
intent(in   ) :: isc, iec, jsc, jec
 
 2982     integer,            
intent(in   ) :: isg, ieg, jsg, jeg
 
 2983     integer,            
intent(in   ) :: dir
 
 2984     logical, 
optional,  
intent(in   ) :: reverse, symmetry
 
 2988        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2989             is, ie, jsg, je, isc, iec, jsc, jec, dir, reverse, symmetry)
 
 2990        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2991             is, ie, js, jeg, isc, iec, jsc, jec, dir, reverse, symmetry)
 
 2992     else if(is > ie) 
then  
 2994        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2995             is, ieg, js, je, isc, iec, jsc, jec, dir, reverse, symmetry)
 
 2996        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 2997             isg, ie, js, je, isc, iec, jsc, jec, dir, reverse, symmetry)
 
 2999        call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3000             is, ie, js, je, isc, iec, jsc, jec, dir, reverse, symmetry)
 
 3004   end subroutine fill_overlap
 
 3011     type(domain2d), 
intent(inout) :: domain
 
 3012     integer, 
intent(in)           :: position, ishift, jshift
 
 3014     integer                          :: i, m, n, nlist, tMe, tNbr, dir
 
 3015     integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd, jed
 
 3016     integer                          :: isg, ieg, jsg, jeg, ioff, joff
 
 3017     integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
 
 3018     integer                          :: ism, iem, jsm, jem, whalo, ehalo, shalo, nhalo
 
 3020     type(overlap_type)               :: overlap
 
 3021     type(overlapspec),   
pointer     :: update=>null()
 
 3022     type(overlap_type),  
pointer     :: overlapList(:)=>null()
 
 3023     type(overlap_type),  
pointer     :: checkList(:)=>null()
 
 3024     type(overlapspec),   
pointer     :: check =>null()
 
 3025     integer                          :: nsend, nrecv
 
 3026     integer                          :: nsend_check, nrecv_check
 
 3032     if(
size(domain%x(:)) > 1) 
return 
 3035     if(domain%whalo==0 .AND. domain%ehalo==0 .AND. domain%shalo==0 .AND. domain%nhalo==0) 
return 
 3038     nlist = 
size(domain%list(:))
 
 3040     select case(position)
 
 3042        update => domain%update_T
 
 3045        update => domain%update_C
 
 3046        check  => domain%check_C
 
 3048        update => domain%update_E
 
 3049        check  => domain%check_E
 
 3051        update => domain%update_N
 
 3052        check  => domain%check_N
 
 3054        call mpp_error(fatal, &
 
 3055         "mpp_domains_define.inc(compute_overlaps_fold_south): the value of position should be CENTER, EAST, & 
 3059     allocate(overlaplist(maxlist) )
 
 3060     allocate(checklist(maxlist)   )
 
 3063     call allocate_update_overlap( overlap, maxoverlap)
 
 3066     call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position  )
 
 3067     call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position  ) 
 
 3068     call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
 
 3069     update%xbegin = ism; update%xend = iem
 
 3070     update%ybegin = jsm; update%yend = jem
 
 3071     if(
ASSOCIATED(check)) 
then 
 3072        check%xbegin  = ism; check%xend  = iem
 
 3073        check%ybegin  = jsm; check%yend  = jem
 
 3075     update%whalo  = domain%whalo; update%ehalo = domain%ehalo
 
 3076     update%shalo  = domain%shalo; update%nhalo = domain%nhalo
 
 3077     whalo         = domain%whalo; ehalo        = domain%ehalo
 
 3078     shalo         = domain%shalo; nhalo        = domain%nhalo
 
 3083     middle = (isg+ieg)/2+1
 
 3086     if(.NOT. btest(domain%fold,south)) 
then 
 3087        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_south): "//&
 
 3088             "boundary condition in y-direction should be folded-south for "//trim(domain%name))
 
 3090     if(.NOT. domain%x(tme)%cyclic) 
then 
 3091        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_south): "//&
 
 3092             "boundary condition in x-direction should be cyclic for "//trim(domain%name))
 
 3095     if(.not. domain%symmetry) 
then 
 3096        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_south): "//&
 
 3097             "when south boundary is folded, the domain must be symmetry for "//trim(domain%name))
 
 3103        m = mod( domain%pos+list, nlist )
 
 3104        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 3107           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3108           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 3110           if( (position == north .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) 
then 
 3113              if( ie.GT.ieg .AND. iec.LT.is )
then  
 3114                 is = is-ioff; ie = ie-ioff
 
 3118              if( js == jsg .AND. (position == corner .OR. position == north) &
 
 3119                   .AND. is .GE. middle .AND. domain%list(m)%x(tnbr)%compute%end+ehalo+jshift .LE. ieg ) 
then 
 3120                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3121                                             is, ie, js+1, je, isc, iec, jsc, jec, dir)
 
 3122                 is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3124                 select case (position)
 
 3126                    i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 3128                    i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 3130                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3131                                             is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 3133                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3134                                             is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 3141           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3142           js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3143           if( ie.GT.ieg .AND. iec.LT.is )
then  
 3144              is = is-ioff; ie = ie-ioff
 
 3148              call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 3151           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3152                                       is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
 3157           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 3158           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3162              call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 3167           if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) 
then 
 3170              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3171                                          is, ie, js, je, isc, iec, jsc, jec, dir, folded, symmetry=domain%symmetry)
 
 3174           if(is .LT. isg) 
then 
 3176              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3177                                          is, is, js, je, isc, iec, jsc, jec, dir, folded)
 
 3183           is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3184           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3185           if( isg.GT.is .AND. ie.LT.isc )
then  
 3186              is = is+ioff; ie = ie+ioff
 
 3190              call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 3192           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3193                                       is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
 3195           if(is .LT. isg) 
then 
 3197              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3198                                          is, is, js, je, isc, iec, jsc, jec, dir, folded)
 
 3203           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3204           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 3207           if( (position == north .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) 
then 
 3210              if( isg.GT.is .AND. ie.LT.isc )
then  
 3211                 is = is+ioff; ie = ie+ioff
 
 3215              if( js == jsg .AND. (position == corner .OR. position == north) &
 
 3216                   .AND. ( domain%list(m)%x(tnbr)%compute%begin == isg .OR. &
 
 3217                         & domain%list(m)%x(tnbr)%compute%begin-1 .GE. middle)) 
then 
 3218                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3219                                             is, ie, js+1, je, isc, iec, jsc, jec, dir)
 
 3220                 is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3221                 js = domain%list(m)%y(tnbr)%compute%begin;   je = js
 
 3222                 if ( domain%list(m)%x(tnbr)%compute%begin == isg ) 
then 
 3223                    select case (position)
 
 3225                       i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
 
 3227                       i=is; is = 2*isg-ie-2+2*ishift; ie = 2*isg-i-2+2*ishift
 
 3229                    if(ie .GT. domain%x(tme)%compute%end+ishift) 
call mpp_error( fatal, &
 
 3230                         'mpp_domains_define.inc(compute_overlaps_fold_south): west edge ubound error send.' )
 
 3232                    select case (position)
 
 3234                       i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 3236                       i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 3239                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3240                                             is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 3242                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3243                                             is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 3249           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3250           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3251           if( isg.GT.is .AND. ie.LT.isc )
then  
 3252              is = is+ioff; ie = ie+ioff
 
 3254           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3255                                       is, ie, js, je, isc, iec, jsc, jec, dir)
 
 3259           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 3260           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3261           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3262                                       is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 3266           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3267           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3268           if( ie.GT.ieg .AND. iec.LT.is )
then  
 3269              is = is-ioff; ie = ie-ioff
 
 3271           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3272                                       is, ie, js, je, isc, iec, jsc, jec, dir)
 
 3276           if( ( position == north .OR. position == corner) ) 
then 
 3278              if( domain%y(tme)%domain_data%begin .LE. jsg .AND. jsg .LE. domain%y(tme)%domain_data%end+jshift )
then 
 3281                 if( domain%x(tme)%pos .LT. (
size(domain%x(tme)%list(:))+1)/2 )
then 
 3282                    js = domain%list(m)%y(tnbr)%compute%begin;   je = js
 
 3284                       is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 3285                       select case (position)
 
 3287                          is = max(is, middle)
 
 3288                          i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 3290                          is = max(is, middle)
 
 3291                          i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 3293                       call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3294                                                  is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 3295                       is = max(is, isc); ie = min(ie, iec)
 
 3296                       js = max(js, jsc); je = min(je, jec)
 
 3297                       if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )
then 
 3298                          nsend_check = nsend_check+1
 
 3299                          call allocate_check_overlap(checklist(nsend_check), 1)
 
 3300                          call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
 
 3301                                                    tme, 2, one_hundred_eighty, is, ie, js, je)
 
 3309        if( overlap%count > 0) 
then 
 3311          if(nsend > 
size(overlaplist(:)) ) 
then 
 3312             call mpp_error(note, 
'mpp_domains_define.inc(compute_overlaps_south): overlapList for send is expanded')
 
 3313             call expand_update_overlap_list(overlaplist, nlist)
 
 3315          call add_update_overlap(overlaplist(nsend), overlap)
 
 3316          call init_overlap_type(overlap)
 
 3320     if(debug_message_passing) 
then 
 3324           write(iunit, *) 
"********to_pe = " ,overlaplist(m)%pe, 
" count = ",overlaplist(m)%count
 
 3325           do n = 1, overlaplist(m)%count
 
 3326              write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
 
 3327                   overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
 
 3330        if( nsend > 0) 
flush(iunit)
 
 3335       if (
associated(update%send)) 
deallocate(update%send) 
 
 3336        allocate(update%send(nsend))
 
 3337        update%nsend = nsend
 
 3339           call add_update_overlap( update%send(m), overlaplist(m) )
 
 3343     if(nsend_check>0) 
then 
 3344       if (
associated(check%send)) 
deallocate(check%send) 
 
 3345        allocate(check%send(nsend_check))
 
 3346        check%nsend = nsend_check
 
 3347        do m = 1, nsend_check
 
 3352     do m = 1,
size(overlaplist(:))
 
 3353        call deallocate_overlap_type(overlaplist(m))
 
 3356     if(debug_update_level .NE. no_check) 
then 
 3357        do m = 1,
size(checklist(:))
 
 3358           call deallocate_overlap_type(checklist(m))
 
 3362     isgd = isg - domain%whalo
 
 3363     iegd = ieg + domain%ehalo
 
 3364     jsgd = jsg - domain%shalo
 
 3365     jegd = jeg + domain%nhalo
 
 3371        m = mod( domain%pos+nlist-list, nlist )
 
 3372        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 3373           isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
 
 3374           jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
 
 3377           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 3378           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 3379           is=isc; ie=iec; js=jsc; je=jec
 
 3380           if( (position == north .OR. position == corner ) .AND. ( jsd == je .or. jed == js ) ) 
then 
 3383              if( ied.GT.ieg .AND. ie.LT.isd )
then  
 3384                 is = is+ioff; ie = ie+ioff
 
 3389              if( jsd == jsg .AND. (position == corner .OR. position == north) &
 
 3390                   .AND. isd .GE. middle .AND. ied .LE. ieg ) 
then 
 3391                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3392                                             is, ie, js, je, isd, ied, jsd+1, jed, dir)
 
 3393                 is=isc; ie=iec; js=jsc; je=jec
 
 3395                 select case (position)
 
 3397                    i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 3399                    i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 3401                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3402                                             is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
 
 3404                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3405                                             is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 3412           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 3413           jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
 
 3414           is=isc; ie=iec; js=jsc; je=jec
 
 3415           if( jsd.LT.jsg )
then 
 3417              call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 3419           if( ied.GT.ieg .AND. ie.LT.isd )
then  
 3420              is = is+ioff; ie = ie+ioff
 
 3422           call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3423                                      is, ie, js, je, isd, ied, jsd, jed, dir, folded)
 
 3428           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 3429           jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
 
 3430           is=isc; ie=iec; js=jsc; je=jec
 
 3431           if( jsd.LT.jsg )
then 
 3433              call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 3435           if( (position == east .OR. position == corner ) .AND. (isd == ie .or. ied == is ) ) 
then 
 3438              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3439                                         is, ie, js, je, isd, ied, jsd, jed, dir, folded, symmetry=domain%symmetry)
 
 3442           if(is .LT. isg ) 
then 
 3444              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3445                                         is, is, js, je, isd, ied, jsd, jed, dir, folded)
 
 3451           isd = domain%x(tme)%domain_data%begin; ied = domain%x(tme)%compute%begin-1
 
 3452           jsd = domain%y(tme)%domain_data%begin; jed = domain%y(tme)%compute%begin-1
 
 3453           is=isc; ie=iec; js=jsc; je=jec
 
 3454           if( jsd.LT.jsg )
then 
 3456              call get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 3458           if( isd.LT.isg .AND. is.GT.ied ) 
then  
 3459              is = is-ioff; ie = ie-ioff
 
 3461           call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3462                                      is, ie, js, je, isd, ied, jsd, jed, dir, folded)
 
 3464           if(is .LT. isg ) 
then 
 3466              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3467                                         is, is, js, je, isd, ied, jsd, jed, dir, folded )
 
 3472           isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
 
 3473           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 3474           is=isc; ie=iec; js=jsc; je=jec
 
 3475           if( (position == north .OR. position == corner ) .AND. ( jsd == je .or. jed == js ) ) 
then 
 3478              if( isd.LT.isg .AND. is.GT.ied )
then  
 3479                 is = is-ioff; ie = ie-ioff
 
 3483              if( jsd == jsg .AND. (position == corner .OR. position == north) &
 
 3484                   .AND. ( isd < isg  .OR. ied .GE. middle ) )  
then 
 3485                 call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3486                                            is, ie, js, je, isd, ied, jsd+1, jed, dir)
 
 3487                 is=isc; ie=iec; js=jsc; je=jec
 
 3489                    select case (position)
 
 3491                       i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
 
 3493                       ied = ied -1 + ishift
 
 3494                       i=is; is = 2*isg-ie-2+2*ishift; ie = 2*isg-i-2+2*ishift
 
 3496                    if(ie .GT. domain%x(tme)%compute%end+ishift) 
call mpp_error( fatal, &
 
 3497                         'mpp_domains_define.inc(compute_overlaps): west edge ubound error recv.' )
 
 3499                    select case (position)
 
 3501                       i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 3503                       i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 3506                 call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3507                                            is, ie, js, je, isd, ied, jsd, jsd, dir, .true.)
 
 3509                 call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3510                                            is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 3516           isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
 
 3517           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 3518           is=isc; ie=iec; js=jsc; je=jec
 
 3519           if( isd.LT.isg .AND. is.GE.ied )
then  
 3520              is = is-ioff; ie = ie-ioff
 
 3523           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3524                                       is, ie, js, je, isd, ied, jsd, jed, dir)
 
 3528           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 3529           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 3530           is=isc; ie=iec; js=jsc; je=jec
 
 3531           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3532                                       is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 3536           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 3537           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 3538           is=isc; ie=iec; js=jsc; je=jec
 
 3539           if(  ied.GT.ieg .AND. ie.LT.isd )
then  
 3540              is = is+ioff; ie = ie+ioff
 
 3542           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3543                                       is, ie, js, je, isd, ied, jsd, jed, dir)
 
 3548           if( ( position == north .OR. position == corner) ) 
then 
 3550              if( domain%y(tme)%domain_data%begin .LE. jsg .AND. jsg .LE. domain%y(tme)%domain_data%end+jshift )
then 
 3553                 if( domain%x(tme)%pos .GE. 
size(domain%x(tme)%list(:))/2 )
then 
 3554                    jsd = domain%y(tme)%compute%begin;   jed = jsd
 
 3555                    if( jsd == jsg )
then    
 3556                       isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 3557                       is=isc; ie=iec; js = jsc; je = jec
 
 3558                       select case (position)
 
 3560                          isd = max(isd, middle)
 
 3561                          i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 3563                          isd = max(isd, middle)
 
 3564                          i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 3566                       call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3567                                                  is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
 
 3568                       is = max(is, isd); ie = min(ie, ied)
 
 3569                       js = max(js, jsd); je = min(je, jed)
 
 3570                       if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )
then 
 3571                          nrecv_check = nrecv_check+1
 
 3572                          call allocate_check_overlap(checklist(nrecv_check), 1)
 
 3573                          call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
 
 3574                                                    tme, 2, one_hundred_eighty, is, ie, js, je)
 
 3582        if( overlap%count > 0) 
then 
 3584           if(nrecv > 
size(overlaplist(:)) )
then 
 3585             call mpp_error(note, 
'mpp_domains_define.inc(compute_overlaps_south): overlapList for recv is expanded')
 
 3586             call expand_update_overlap_list(overlaplist, nlist)
 
 3588           call add_update_overlap( overlaplist(nrecv), overlap)
 
 3589           call init_overlap_type(overlap)
 
 3593     if(debug_message_passing) 
then 
 3597           write(iunit, *) 
"********from_pe = " ,overlaplist(m)%pe, 
" count = ",overlaplist(m)%count
 
 3598           do n = 1, overlaplist(m)%count
 
 3599              write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
 
 3600                   overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
 
 3603        if(nrecv >0) 
flush(iunit)
 
 3608        update%nrecv = nrecv
 
 3609        if (
associated(update%recv)) 
deallocate(update%recv) 
 
 3610        allocate(update%recv(nrecv))
 
 3612           call add_update_overlap( update%recv(m), overlaplist(m) )
 
 3613           do n = 1, update%recv(m)%count
 
 3614              if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) 
then 
 3615                 if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
 
 3616                 if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
 
 3622     if(nrecv_check>0) 
then 
 3623        check%nrecv = nrecv_check
 
 3624        if (
associated(check%recv)) 
deallocate(check%recv) 
 
 3625        allocate(check%recv(nrecv_check))
 
 3626        do m = 1, nrecv_check
 
 3631     call deallocate_overlap_type(overlap)
 
 3633     do m = 1,
size(overlaplist(:))
 
 3634        call deallocate_overlap_type(overlaplist(m))
 
 3637     if(debug_update_level .NE. no_check) 
then 
 3638        do m = 1,
size(checklist(:))
 
 3639           call deallocate_overlap_type(checklist(m))
 
 3643     deallocate(overlaplist)
 
 3644     deallocate(checklist)
 
 3647     domain%initialized = .true.
 
 3656     type(domain2d), 
intent(inout) :: domain
 
 3657     integer, 
intent(in)           :: position, ishift, jshift
 
 3659     integer                          :: j, m, n, nlist, tMe, tNbr, dir
 
 3660     integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd, jed
 
 3661     integer                          :: isg, ieg, jsg, jeg, ioff, joff
 
 3662     integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
 
 3663     integer                          :: ism, iem, jsm, jem, whalo, ehalo, shalo, nhalo
 
 3665     type(overlap_type)               :: overlap
 
 3666     type(overlapspec),   
pointer     :: update=>null()
 
 3667     type(overlap_type)               :: overlapList(MAXLIST)
 
 3668     type(overlap_type)               :: checkList(MAXLIST)
 
 3669     type(overlapspec),   
pointer     :: check =>null()
 
 3670     integer                          :: nsend, nrecv
 
 3671     integer                          :: nsend_check, nrecv_check
 
 3677     if(
size(domain%x(:)) > 1) 
return 
 3680     if(domain%whalo==0 .AND. domain%ehalo==0 .AND. domain%shalo==0 .AND. domain%nhalo==0) 
return 
 3683     nlist = 
size(domain%list(:))
 
 3685     select case(position)
 
 3687        update => domain%update_T
 
 3690        update => domain%update_C
 
 3691        check  => domain%check_C
 
 3693        update => domain%update_E
 
 3694        check  => domain%check_E
 
 3696        update => domain%update_N
 
 3697        check  => domain%check_N
 
 3699        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_west):"//&
 
 3700                            & 
" the value of position should be CENTER, EAST, CORNER or NORTH")
 
 3704     call allocate_update_overlap( overlap, maxoverlap)
 
 3707     call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position )
 
 3708     call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position ) 
 
 3709     call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
 
 3710     update%xbegin = ism; update%xend = iem
 
 3711     update%ybegin = jsm; update%yend = jem
 
 3712     if(
ASSOCIATED(check)) 
then 
 3713        check%xbegin  = ism; check%xend  = iem
 
 3714        check%ybegin  = jsm; check%yend  = jem
 
 3716     update%whalo  = domain%whalo; update%ehalo = domain%ehalo
 
 3717     update%shalo  = domain%shalo; update%nhalo = domain%nhalo
 
 3718     whalo         = domain%whalo; ehalo        = domain%ehalo
 
 3719     shalo         = domain%shalo; nhalo        = domain%nhalo
 
 3723     middle = (jsg+jeg)/2+1
 
 3726     if(.NOT. btest(domain%fold,west)) 
then 
 3727        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_west): "//&
 
 3728             "boundary condition in y-direction should be folded-west for "//trim(domain%name))
 
 3730     if(.NOT. domain%y(tme)%cyclic) 
then 
 3731        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_west): "//&
 
 3732             "boundary condition in y-direction should be cyclic for "//trim(domain%name))
 
 3735     if(.not. domain%symmetry) 
then 
 3736        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_west): "//&
 
 3737             "when west boundary is folded, the domain must be symmetry for "//trim(domain%name))
 
 3743        m = mod( domain%pos+list, nlist )
 
 3744        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 3747           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3748           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 3749           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3750                                       is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 3754           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3755           js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3756           if( js.LT.jsg .AND. jsc.GT.je )
then  
 3757              js = js+joff; je = je+joff
 
 3760           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3761                                        is, ie, js, je, isc, iec, jsc, jec, dir)
 
 3765           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 3766           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3768           if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) 
then 
 3771              if( js.LT.jsg .AND. jsc.GT.je) 
then  
 3772                 js = js+joff; je = je+joff
 
 3777              if( is == isg .AND. (position == corner .OR. position == east) &
 
 3778                   .AND. ( domain%list(m)%y(tnbr)%compute%begin == jsg .OR. &
 
 3779                   & domain%list(m)%y(tnbr)%compute%begin-1 .GE. middle)) 
then 
 3780                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3781                                             is+1, ie, js, je, isc, iec, jsc, jec, dir)
 
 3782                 is = domain%list(m)%x(tnbr)%compute%begin; ie = is
 
 3783                 js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3784                 if ( domain%list(m)%y(tnbr)%compute%begin == jsg ) 
then 
 3785                    select case (position)
 
 3787                       j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
 
 3789                       j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
 
 3791                    if(je .GT. domain%y(tme)%compute%end+jshift) 
call mpp_error( fatal, &
 
 3792                         'mpp_domains_define.inc(compute_overlaps_fold_west: south edge ubound error send.' )
 
 3794                    select case (position)
 
 3796                       j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 3798                       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 3801                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3802                                             is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 3804                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3805                                             is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 3812           is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3813           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 3814           if( jsg.GT.js .AND. je.LT.jsc )
then  
 3815              js = js+joff; je = je+joff
 
 3819              call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 3821           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3822                                       is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
 3824           if(js .LT. jsg) 
then 
 3826              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3827                                          is, ie, js, js, isc, iec, jsc, jec, dir, folded)
 
 3833           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3834           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 3837              call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 3842           if( (position == east .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) 
then 
 3845              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3846                                          is, ie, js, je, isc, iec, jsc, jec, dir, folded, symmetry=domain%symmetry)
 
 3849           if(js .LT. jsg) 
then 
 3851              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3852                                          is, ie, js, js, isc, iec, jsc, jec, dir, folded)
 
 3858           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 3859           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3860           if( je.GT.jeg .AND. jec.LT.js )
then  
 3861              js = js-joff; je = je-joff
 
 3865              call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 3868           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3869                                       is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
 3873           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 3874           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3876           if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) 
then 
 3879              if( je.GT.jeg .AND. jec.LT.js) 
then  
 3880                 js = js-joff; je = je-joff
 
 3884              if( is == isg .AND. (position == corner .OR. position == east) &
 
 3885                   .AND. ( js .GE. middle .AND. domain%list(m)%y(tnbr)%compute%end+nhalo+jshift .LE. jeg ) ) 
then 
 3886                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3887                                             is+1, ie, js, je, isc, iec, jsc, jec, dir)
 
 3888                 is = domain%list(m)%x(tnbr)%compute%begin; ie = is
 
 3889                 js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3890                 select case (position)
 
 3892                    j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 3894                    j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 3896                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3897                                             is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 3899                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3900                                             is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 3906           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 3907           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 3908           if( je.GT.jeg .AND. jec.LT.js )
then  
 3909              js = js-joff; je = je-joff
 
 3911           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 3912                                       is, ie, js, je, isc, iec, jsc, jec, dir)
 
 3916           if( ( position == east .OR. position == corner) ) 
then 
 3918              if( domain%x(tme)%compute%begin-whalo .LE. isg .AND. isg .LE. domain%x(tme)%domain_data%end+ishift )
then 
 3921                 if( domain%y(tme)%pos .LT. (
size(domain%y(tme)%list(:))+1)/2 )
then 
 3922                    is = domain%list(m)%x(tnbr)%compute%begin;   ie = is
 
 3924                       js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 3925                       select case (position)
 
 3927                          js = max(js, middle)
 
 3928                          j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 3930                          js = max(js, middle)
 
 3931                          j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 3933                       call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 3934                                                  is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 3935                       is = max(is, isc); ie = min(ie, iec)
 
 3936                       js = max(js, jsc); je = min(je, jec)
 
 3937                       if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )
then 
 3938                          nsend_check = nsend_check+1
 
 3939                          call allocate_check_overlap(checklist(nsend_check), 1)
 
 3940                          call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
 
 3941                                                    tme, 3, one_hundred_eighty, is, ie, js, je)
 
 3949        if( overlap%count > 0) 
then 
 3951          if(nsend > maxlist) 
call mpp_error(fatal,  &
 
 3952              "mpp_domains_define.inc(compute_overlaps_west): nsend is greater than MAXLIST, increase MAXLIST")
 
 3953          call add_update_overlap(overlaplist(nsend), overlap)
 
 3954          call init_overlap_type(overlap)
 
 3958     if(debug_message_passing) 
then 
 3962           write(iunit, *) 
"********to_pe = " ,overlaplist(m)%pe, 
" count = ",overlaplist(m)%count
 
 3963           do n = 1, overlaplist(m)%count
 
 3964              write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
 
 3965                   overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
 
 3968        if(nsend >0) 
flush(iunit)
 
 3973        update%nsend = nsend
 
 3974        if (
associated(update%send)) 
deallocate(update%send) 
 
 3975        allocate(update%send(nsend))
 
 3977           call add_update_overlap( update%send(m), overlaplist(m) )
 
 3981     if(nsend_check>0) 
then 
 3982        check%nsend = nsend_check
 
 3983        if (
associated(check%send)) 
deallocate(check%send) 
 
 3984        allocate(check%send(nsend_check))
 
 3985        do m = 1, nsend_check
 
 3991        call deallocate_overlap_type(overlaplist(m))
 
 3992        if(debug_update_level .NE. no_check) 
call deallocate_overlap_type(checklist(m))
 
 3995     isgd = isg - domain%whalo
 
 3996     iegd = ieg + domain%ehalo
 
 3997     jsgd = jsg - domain%shalo
 
 3998     jegd = jeg + domain%nhalo
 
 4004        m = mod( domain%pos+nlist-list, nlist )
 
 4005        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 4006           isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
 
 4007           jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
 
 4010           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 4011           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 4012           is=isc; ie=iec; js=jsc; je=jec
 
 4013           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4014                                       is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 4018           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 4019           jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
 
 4020           is=isc; ie=iec; js=jsc; je=jec
 
 4021           if( jsd.LT.jsg .AND. js.GE.jed )
then  
 4022              js = js-joff; je = je-joff
 
 4024           call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4025                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
 4030           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 4031           jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
 
 4032           is=isc; ie=iec; js=jsc; je=jec
 
 4034           if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) 
then 
 4037              if( jsd.LT.jsg .AND. js .GT. jed)
then 
 4038                 js = js-joff; je = je-joff
 
 4042              if( isd == isg .AND. (position == corner .OR. position == east) &
 
 4043                   .AND. ( jsd < jsg .OR. jed .GE. middle ) ) 
then 
 4044                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4045                                             is, ie, js, je, isd+1, ied, jsd, jed, dir)
 
 4046                 is=isc; ie=iec; js=jsc; je=jec
 
 4048                    select case (position)
 
 4050                       j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
 
 4052                       j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
 
 4054                    if(je .GT. domain%y(tme)%compute%end+jshift) 
call mpp_error( fatal, &
 
 4055                         'mpp_domains_define.inc(compute_overlaps_fold_west: south edge ubound error recv.' )
 
 4057                    select case (position)
 
 4059                       j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4061                       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4064                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4065                                             is, ie, js, je, isd, isd, jsd, jed, dir, .true.)
 
 4067                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4068                                             is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 4075           isd = domain%x(tme)%domain_data%begin; ied = domain%x(tme)%compute%begin-1
 
 4076           jsd = domain%y(tme)%domain_data%begin; jed = domain%y(tme)%compute%begin-1
 
 4077           is=isc; ie=iec; js=jsc; je=jec
 
 4078           if( isd.LT.isg )
then 
 4080              call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 4082           if( jsd.LT.jsg .AND. js.GT.jed ) 
then  
 4083              js = js-joff; je = je-joff
 
 4085           call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4086                                      is, ie, js, je, isd, ied, jsd, jed, dir, folded)
 
 4088           if(js .LT. jsg ) 
then 
 4090              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4091                                         is, ie, js, js, isd, ied, jsd, jed, dir, folded )
 
 4097           isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
 
 4098           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 4099           is=isc; ie=iec; js=jsc; je=jec
 
 4100           if( isd.LT.isg )
then 
 4102              call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 4104           if( (position == east .OR. position == corner ) .AND. (jsd == je .or. jed == js ) ) 
then 
 4107              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4108                                         is, ie, js, je, isd, ied, jsd, jed, dir, folded, symmetry=domain%symmetry)
 
 4111           if(js .LT. jsg ) 
then 
 4113              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4114                                         is, ie, js, js, isd, ied, jsd, jed, dir, folded)
 
 4120           isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
 
 4121           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 4122           is=isc; ie=iec; js=jsc; je=jec
 
 4123           if( isd.LT.isg) 
then 
 4125              call get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 4127           if( jed.GT.jeg .AND. je.LT.jsd )
then  
 4128              js = js+joff; je = je+joff
 
 4131           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4132                                       is, ie, js, je, isd, ied, jsd, jed, dir)
 
 4137           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 4138           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 4139           is=isc; ie=iec; js=jsc; je=jec
 
 4140           if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) 
then 
 4143              if( jed.GT.jeg .AND. je.LT.jsd)
then 
 4144                 js = js+joff; je = je+joff
 
 4148              if( isd == isg .AND. (position == corner .OR. position == east) &
 
 4149                   .AND. jsd .GE. middle .AND. jed .LE. jeg ) 
then 
 4150                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4151                                             is, ie, js, je, isd+1, ied, jsd, jed, dir)
 
 4152                 is=isc; ie=iec; js=jsc; je=jec
 
 4153                 select case (position)
 
 4155                    j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4157                    j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4159                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4160                                             is, ie, js, je, isd, isd, jsd, jed, dir, .true.)
 
 4162                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4163                                             is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 4169           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 4170           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 4171           is=isc; ie=iec; js=jsc; je=jec
 
 4172           if(  jed.GT.jeg .AND. je.LT.jsd )
then  
 4173              js = js+joff; je = je+joff
 
 4175           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4176                                       is, ie, js, je, isd, ied, jsd, jed, dir)
 
 4181           if( ( position == east .OR. position == corner) ) 
then 
 4183              if( domain%x(tme)%domain_data%begin .LE. isg .AND. isg .LE. domain%x(tme)%domain_data%end+ishift )
then 
 4186                 if( domain%y(tme)%pos .GE. 
size(domain%y(tme)%list(:))/2 )
then 
 4187                    isd = domain%x(tme)%compute%begin;   ied = isd
 
 4188                    if( isd == isg )
then    
 4189                       jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 4190                       is=isc; ie=iec; js = jsc; je = jec
 
 4191                       select case (position)
 
 4193                          jsd = max(jsd, middle)
 
 4194                          j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4196                          jsd = max(jsd, middle)
 
 4197                          j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4199                       call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4200                                                  is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
 
 4201                       is = max(is, isd); ie = min(ie, ied)
 
 4202                       js = max(js, jsd); je = min(je, jed)
 
 4203                       if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )
then 
 4204                          nrecv_check = nrecv_check+1
 
 4205                          call allocate_check_overlap(checklist(nrecv_check), 1)
 
 4206                          call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
 
 4207                                                    tme, 3, one_hundred_eighty, is, ie, js, je)
 
 4215        if( overlap%count > 0) 
then 
 4217          if(nrecv > maxlist) 
call mpp_error(fatal,  &
 
 4218              "mpp_domains_define.inc(compute_overlaps_west): nrecv is greater than MAXLIST, increase MAXLIST")
 
 4219           call add_update_overlap( overlaplist(nrecv), overlap)
 
 4220           call init_overlap_type(overlap)
 
 4224     if(debug_message_passing) 
then 
 4228           write(iunit, *) 
"********from_pe = " ,overlaplist(m)%pe, 
" count = ",overlaplist(m)%count
 
 4229           do n = 1, overlaplist(m)%count
 
 4230              write(iunit, *) overlaplist(m)%is(n), overlaplist(m)%ie(n), overlaplist(m)%js(n), overlaplist(m)%je(n), &
 
 4231                   overlaplist(m)%dir(n), overlaplist(m)%rotation(n)
 
 4234        if(nrecv >0) 
flush(iunit)
 
 4239        update%nrecv = nrecv
 
 4240        if (
associated(update%recv)) 
deallocate(update%recv) 
 
 4241        allocate(update%recv(nrecv))
 
 4243           call add_update_overlap( update%recv(m), overlaplist(m) )
 
 4244           do n = 1, update%recv(m)%count
 
 4245              if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) 
then 
 4246                 if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
 
 4247                 if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
 
 4253     if(nrecv_check>0) 
then 
 4254        check%nrecv = nrecv_check
 
 4255        if (
associated(check%recv)) 
deallocate(check%recv) 
 
 4256        allocate(check%recv(nrecv_check))
 
 4257        do m = 1, nrecv_check
 
 4262     call deallocate_overlap_type(overlap)
 
 4264        call deallocate_overlap_type(overlaplist(m))
 
 4265        if(debug_update_level .NE. no_check) 
call deallocate_overlap_type(checklist(m))
 
 4270     domain%initialized = .true.
 
 4280     type(domain2d), 
intent(inout) :: domain
 
 4281     integer, 
intent(in)           :: position, ishift, jshift
 
 4283     integer                          :: j, m, n, nlist, tMe, tNbr, dir
 
 4284     integer                          :: is, ie, js, je, isc, iec, jsc, jec, isd, ied, jsd
 
 4285     integer                          :: jed, isg, ieg, jsg, jeg, ioff, joff
 
 4286     integer                          :: list, middle, ni, nj, isgd, iegd, jsgd, jegd
 
 4287     integer                          :: ism, iem, jsm, jem, whalo, ehalo, shalo, nhalo
 
 4289     type(overlap_type)               :: overlap
 
 4290     type(overlapspec),   
pointer     :: update=>null()
 
 4291     type(overlap_type)               :: overlapList(MAXLIST)
 
 4292     type(overlap_type)               :: checkList(MAXLIST)
 
 4293     type(overlapspec),   
pointer     :: check =>null()
 
 4294     integer                          :: nsend, nrecv
 
 4295     integer                          :: nsend_check, nrecv_check
 
 4300     if(
size(domain%x(:)) > 1) 
return 
 4303     if(domain%whalo==0 .AND. domain%ehalo==0 .AND. domain%shalo==0 .AND. domain%nhalo==0) 
return 
 4306     nlist = 
size(domain%list(:))
 
 4308     select case(position)
 
 4310        update => domain%update_T
 
 4312        update => domain%update_C
 
 4313        check  => domain%check_C
 
 4315        update => domain%update_E
 
 4316        check  => domain%check_E
 
 4318        update => domain%update_N
 
 4319        check  => domain%check_N
 
 4321        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_east):"// &
 
 4322                            & 
" the value of position should be CENTER, EAST, CORNER or NORTH")
 
 4326     call allocate_update_overlap( overlap, maxoverlap)
 
 4329     call mpp_get_compute_domain( domain, isc, iec, jsc, jec, position=position )
 
 4330     call mpp_get_global_domain ( domain, isg, ieg, jsg, jeg, xsize=ni, ysize=nj, position=position ) 
 
 4331     call mpp_get_memory_domain ( domain, ism, iem, jsm, jem, position=position )
 
 4332     update%xbegin = ism; update%xend = iem
 
 4333     update%ybegin = jsm; update%yend = jem
 
 4334     if(
ASSOCIATED(check)) 
then 
 4335        check%xbegin  = ism; check%xend  = iem
 
 4336        check%ybegin  = jsm; check%yend  = jem
 
 4338     update%whalo  = domain%whalo; update%ehalo = domain%ehalo
 
 4339     update%shalo  = domain%shalo; update%nhalo = domain%nhalo
 
 4340     whalo         = domain%whalo; ehalo        = domain%ehalo
 
 4341     shalo         = domain%shalo; nhalo        = domain%nhalo
 
 4345     middle = (jsg+jeg)/2+1
 
 4348     if(.NOT. btest(domain%fold,east)) 
then 
 4349        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_east): "//&
 
 4350             "boundary condition in y-direction should be folded-east for "//trim(domain%name))
 
 4352     if(.NOT. domain%y(tme)%cyclic) 
then 
 4353        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_east): "//&
 
 4354             "boundary condition in y-direction should be cyclic for "//trim(domain%name))
 
 4356     if(.not. domain%symmetry) 
then 
 4357        call mpp_error(fatal, 
"mpp_domains_define.inc(compute_overlaps_fold_east): "//&
 
 4358             "when east boundary is folded, the domain must be symmetry for "//trim(domain%name))
 
 4364        m = mod( domain%pos+list, nlist )
 
 4365        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 4369           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 4370           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 4373              call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4378           if( (position == east .OR. position == corner ) .AND. ( jsc == je .or. jec == js ) ) 
then 
 4381              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4382                                          is, ie, js, je, isc, iec, jsc, jec, dir, folded, symmetry=domain%symmetry)
 
 4385           if(js .LT. jsg) 
then 
 4387              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4388                                          is, ie, js, js, isc, iec, jsc, jec, dir, folded)
 
 4394           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 4395           js = domain%list(m)%y(tnbr)%compute%begin-shalo;    je = domain%list(m)%y(tnbr)%compute%begin-1
 
 4396           if( jsg.GT.js .AND. je.LT.jsc )
then  
 4397              js = js+joff; je = je+joff
 
 4402              call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4405           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4406                                       is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
 4408           if(js .LT. jsg) 
then 
 4410              call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4411                                          is, ie, js, js, isc, iec, jsc, jec, dir, folded)
 
 4416           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 4417           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 4419           if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) 
then 
 4422              if( js.LT.jsg .AND. jsc.GT.je) 
then  
 4423                 js = js+joff; je = je+joff
 
 4427              if( ie == ieg .AND. (position == corner .OR. position == east) &
 
 4428                   .AND. ( domain%list(m)%y(tnbr)%compute%begin == jsg .OR. &
 
 4429                         domain%list(m)%y(tnbr)%compute%begin-1 .GE. middle  ) ) 
then 
 4430                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4431                                             is, ie-1, js, je, isc, iec, jsc, jec, dir)
 
 4434                 if(position == corner .AND. .NOT. domain%symmetry .AND. domain%list(m)%y(tnbr)%compute%begin==jsg)
then 
 4435                    call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4436                                               ie, ie, je, je, isc, iec, jsc, jec, dir, .true.)
 
 4439                 ie = domain%list(m)%x(tnbr)%compute%end+ishift; is = ie
 
 4440                 js = domain%list(m)%y(tnbr)%compute%begin-shalo;  je = domain%list(m)%y(tnbr)%compute%begin-1
 
 4441                 if ( domain%list(m)%y(tnbr)%compute%begin == jsg ) 
then 
 4442                    select case (position)
 
 4444                       j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
 
 4446                       j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
 
 4448                    if(je .GT. domain%y(tme)%compute%end+jshift) 
call mpp_error( fatal, &
 
 4449                         'mpp_domains_define.inc(compute_overlaps_fold_east: south edge ubound error send.' )
 
 4451                    select case (position)
 
 4453                       j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4455                       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4458                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4459                                             is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 4461                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4462                                             is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 4468           is = domain%list(m)%x(tnbr)%compute%begin-whalo; ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 4469           js = domain%list(m)%y(tnbr)%compute%begin-shalo; je = domain%list(m)%y(tnbr)%compute%begin-1
 
 4470           if( js.LT.jsg .AND. jsc.GT.je )
then  
 4471              js = js+joff; je = je+joff
 
 4473           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4474                                       is, ie, js, je, isc, iec, jsc, jec, dir)
 
 4478           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 4479           js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 4480           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4481                                       is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 4485           is = domain%list(m)%x(tnbr)%compute%begin-whalo;    ie = domain%list(m)%x(tnbr)%compute%begin-1
 
 4486           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 4487           if( je.GT.jeg .AND. jec.LT.js )
then  
 4488              js = js-joff; je = je-joff
 
 4490           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4491                                       is, ie, js, je, isc, iec, jsc, jec, dir)
 
 4496           is = domain%list(m)%x(tnbr)%compute%begin; ie = domain%list(m)%x(tnbr)%compute%end+ishift
 
 4497           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 4499           if( (position == east .OR. position == corner ) .AND. ( isc == ie .or. iec == is ) ) 
then 
 4502              if( je.GT.jeg .AND. jec.LT.js) 
then  
 4503                 js = js-joff; je = je-joff
 
 4507              if( ie == ieg .AND. (position == corner .OR. position == east) &
 
 4508                   .AND. ( js .GE. middle .AND. domain%list(m)%y(tnbr)%compute%end+nhalo+jshift .LE. jeg ) ) 
then 
 4509                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4510                                             is, ie-1, js, je, isc, iec, jsc, jec, dir)
 
 4511                 ie = domain%list(m)%x(tnbr)%compute%end+ishift; is = ie
 
 4512                 js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 4513                 select case (position)
 
 4515                    j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4517                    j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4519                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4520                                             is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 4522                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4523                                             is, ie, js, je, isc, iec, jsc, jec, dir, symmetry=domain%symmetry)
 
 4530           is = domain%list(m)%x(tnbr)%compute%end+1+ishift; ie = domain%list(m)%x(tnbr)%compute%end+ehalo+ishift
 
 4531           js = domain%list(m)%y(tnbr)%compute%end+1+jshift; je = domain%list(m)%y(tnbr)%compute%end+nhalo+jshift
 
 4532           if( je.GT.jeg .AND. jec.LT.js )
then  
 4533              js = js-joff; je = je-joff
 
 4537              call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4540           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4541                                       is, ie, js, je, isc, iec, jsc, jec, dir, folded)
 
 4545           if( ( position == east .OR. position == corner) ) 
then 
 4547              if( domain%x(tme)%domain_data%begin .LE. ieg .AND. ieg .LE. domain%x(tme)%domain_data%end+ishift )
then 
 4550                 if( domain%y(tme)%pos .LT. (
size(domain%y(tme)%list(:))+1)/2 )
then 
 4551                    ie = domain%list(m)%x(tnbr)%compute%end+ishift;   is = ie
 
 4553                       js = domain%list(m)%y(tnbr)%compute%begin; je = domain%list(m)%y(tnbr)%compute%end+jshift
 
 4554                       select case (position)
 
 4556                          js = max(js, middle)
 
 4557                          j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4559                          js = max(js, middle)
 
 4560                          j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4562                       call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4563                                                  is, ie, js, je, isc, iec, jsc, jec, dir, .true.)
 
 4564                       is = max(is, isc); ie = min(ie, iec)
 
 4565                       js = max(js, jsc); je = min(je, jec)
 
 4566                       if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )
then 
 4567                          nsend_check = nsend_check+1
 
 4568                          call allocate_check_overlap(checklist(nsend_check), 1)
 
 4569                          call insert_check_overlap(checklist(nsend_check), domain%list(m)%pe, &
 
 4570                                                    tme, 1, one_hundred_eighty, is, ie, js, je)
 
 4578        if( overlap%count > 0) 
then 
 4580          if(nsend > maxlist) 
call mpp_error(fatal,  &
 
 4581              "mpp_domains_define.inc(compute_overlaps_east): nsend is greater than MAXLIST, increase MAXLIST")
 
 4582          call add_update_overlap(overlaplist(nsend), overlap)
 
 4583          call init_overlap_type(overlap)
 
 4589        update%nsend = nsend
 
 4590        if (
associated(update%send)) 
deallocate(update%send) 
 
 4591        allocate(update%send(nsend))
 
 4593           call add_update_overlap( update%send(m), overlaplist(m) )
 
 4597    if(nsend_check>0) 
then 
 4598        check%nsend = nsend_check
 
 4599        if (
associated(check%send)) 
deallocate(check%send) 
 
 4600        allocate(check%send(nsend_check))
 
 4601        do m = 1, nsend_check
 
 4607        call deallocate_overlap_type(overlaplist(m))
 
 4608        if(debug_update_level .NE. no_check) 
call deallocate_overlap_type(checklist(m))
 
 4611     isgd = isg - domain%whalo
 
 4612     iegd = ieg + domain%ehalo
 
 4613     jsgd = jsg - domain%shalo
 
 4614     jegd = jeg + domain%nhalo
 
 4620        m = mod( domain%pos+nlist-list, nlist )
 
 4621        if(domain%list(m)%tile_id(tnbr) == domain%tile_id(tme) ) 
then   
 4622           isc = domain%list(m)%x(1)%compute%begin; iec = domain%list(m)%x(1)%compute%end+ishift
 
 4623           jsc = domain%list(m)%y(1)%compute%begin; jec = domain%list(m)%y(1)%compute%end+jshift
 
 4627           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 4628           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 4629           is=isc; ie=iec; js=jsc; je=jec
 
 4630           if( ied.GT.ieg )
then 
 4632              call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4634           if( (position == east .OR. position == corner ) .AND. (jsd == je .or. jed == js ) ) 
then 
 4637              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4638                                         is, ie, js, je, isd, ied, jsd, jed, dir, folded, symmetry=domain%symmetry)
 
 4641           if(js .LT. jsg ) 
then 
 4643              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4644                                         is, ie, js, js, isd, ied, jsd, jed, dir, folded)
 
 4650           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 4651           jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
 
 4652           is=isc; ie=iec; js=jsc; je=jec
 
 4653           if( ied.GT.ieg )
then 
 4655              call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4657           if( jsd.LT.jsg .AND. js.GT.jed ) 
then  
 4658              js = js-joff; je = je-joff
 
 4660           call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4661                                      is, ie, js, je, isd, ied, jsd, jed, dir, folded)
 
 4663           if(js .LT. jsg ) 
then 
 4665              call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4666                                         is, ie, js, js, isd, ied, jsd, jed, dir, folded )
 
 4672           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 4673           jsd = domain%y(tme)%domain_data%begin;    jed = domain%y(tme)%compute%begin-1
 
 4674           is=isc; ie=iec; js=jsc; je=jec
 
 4676           if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) 
then 
 4679              if( jsd.LT.jsg .AND. js .GT. jed)
then 
 4680                 js = js-joff; je = je-joff
 
 4684              if( ied == ieg .AND. (position == corner .OR. position == east) &
 
 4685                   .AND. ( jsd < jsg .OR. jed .GE. middle ) ) 
then 
 4686                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4687                                             is, ie, js, je, isd, ied-1, jsd, jed, dir)
 
 4688                 is=isc; ie=iec; js=jsc; je=jec
 
 4690                    select case (position)
 
 4692                       j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
 
 4694                       j=js; js = 2*jsg-je-2+2*jshift; je = 2*jsg-j-2+2*jshift
 
 4696                    if(je .GT. domain%y(tme)%compute%end+jshift) 
call mpp_error( fatal, &
 
 4697                         'mpp_domains_define.inc(compute_overlaps_fold_west: south edge ubound error recv.' )
 
 4699                    select case (position)
 
 4701                       j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4703                       j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4706                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4707                                             is, ie, js, je, ied, ied, jsd, jed, dir, .true.)
 
 4709                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4710                                             is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 4716           isd = domain%x(tme)%domain_data%begin; ied = domain%x(tme)%compute%begin-1
 
 4717           jsd = domain%y(tme)%domain_data%begin; jed = domain%y(tme)%compute%begin-1
 
 4718           is=isc; ie=iec; js=jsc; je=jec
 
 4719           if( jsd.LT.jsg .AND. js.GE.jed )
then  
 4720              js = js-joff; je = je-joff
 
 4722           call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4723                                      is, ie, js, je, isd, ied, jsd, jed, dir)
 
 4727           isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
 
 4728           jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 4729           is=isc; ie=iec; js=jsc; je=jec
 
 4730           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4731                                       is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 4736           isd = domain%x(tme)%domain_data%begin;    ied = domain%x(tme)%compute%begin-1
 
 4737           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 4738           is=isc; ie=iec; js=jsc; je=jec
 
 4739           if(  jed.GT.jeg .AND. je.LT.jsd )
then  
 4740              js = js+joff; je = je+joff
 
 4742           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4743                                       is, ie, js, je, isd, ied, jsd, jed, dir)
 
 4748           isd = domain%x(tme)%compute%begin; ied = domain%x(tme)%compute%end+ishift
 
 4749           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 4750           is=isc; ie=iec; js=jsc; je=jec
 
 4751           if( (position == east .OR. position == corner ) .AND. ( isd == ie .or. ied == is ) ) 
then 
 4754              if( jed.GT.jeg .AND. je.LT.jsd)
then 
 4755                 js = js+joff; je = je+joff
 
 4759              if( ied == ieg .AND. (position == corner .OR. position == east) &
 
 4760                   .AND. jsd .GE. middle .AND. jed .LE. jeg ) 
then 
 4761                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4762                                             is, ie, js, je, isd, ied-1, jsd, jed, dir)
 
 4763                 is=isc; ie=iec; js=jsc; je=jec
 
 4764                 select case (position)
 
 4766                    j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4768                    j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4770                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4771                                             is, ie, js, je, ied, ied, jsd, jed, dir, .true.)
 
 4773                 call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4774                                             is, ie, js, je, isd, ied, jsd, jed, dir, symmetry=domain%symmetry)
 
 4781           isd = domain%x(tme)%compute%end+1+ishift; ied = domain%x(tme)%domain_data%end+ishift
 
 4782           jsd = domain%y(tme)%compute%end+1+jshift; jed = domain%y(tme)%domain_data%end+jshift
 
 4783           is=isc; ie=iec; js=jsc; je=jec
 
 4784           if( ied.GT.ieg) 
then 
 4786              call get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4788           if( jed.GT.jeg .AND. je.LT.jsd )
then  
 4789              js = js+joff; je = je+joff
 
 4792           call insert_update_overlap( overlap, domain%list(m)%pe, &
 
 4793                                       is, ie, js, je, isd, ied, jsd, jed, dir)
 
 4797           if( ( position == east .OR. position == corner) ) 
then 
 4799              if( domain%x(tme)%domain_data%begin .LE. ieg .AND. ieg .LE. domain%x(tme)%domain_data%end+ishift )
then 
 4802                 if( domain%y(tme)%pos .GE. 
size(domain%y(tme)%list(:))/2 )
then 
 4803                    ied = domain%x(tme)%compute%end+ishift;   isd = ied
 
 4804                    if( ied == ieg )
then    
 4805                       jsd = domain%y(tme)%compute%begin; jed = domain%y(tme)%compute%end+jshift
 
 4806                       is=isc; ie=iec; js = jsc; je = jec
 
 4807                       select case (position)
 
 4809                          jsd = max(jsd, middle)
 
 4810                          j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4812                          jsd = max(jsd, middle)
 
 4813                          j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4815                       call insert_update_overlap(overlap, domain%list(m)%pe, &
 
 4816                                                  is, ie, js, je, isd, ied, jsd, jed, dir, .true.)
 
 4817                       is = max(is, isd); ie = min(ie, ied)
 
 4818                       js = max(js, jsd); je = min(je, jed)
 
 4819                       if(debug_update_level .NE. no_check .AND. ie.GE.is .AND. je.GE.js )
then 
 4820                          nrecv_check = nrecv_check+1
 
 4821                          call allocate_check_overlap(checklist(nrecv_check), 1)
 
 4822                          call insert_check_overlap(checklist(nrecv_check), domain%list(m)%pe, &
 
 4823                                                    tme, 3, one_hundred_eighty, is, ie, js, je)
 
 4831        if( overlap%count > 0) 
then 
 4833          if(nrecv > maxlist) 
call mpp_error(fatal,  &
 
 4834              "mpp_domains_define.inc(compute_overlaps_east): nrecv is greater than MAXLIST, increase MAXLIST")
 
 4835           call add_update_overlap( overlaplist(nrecv), overlap)
 
 4836           call init_overlap_type(overlap)
 
 4842        update%nrecv = nrecv
 
 4843        if (
associated(update%recv)) 
deallocate(update%recv) 
 
 4844        allocate(update%recv(nrecv))
 
 4846           call add_update_overlap( update%recv(m), overlaplist(m) )
 
 4847           do n = 1, update%recv(m)%count
 
 4848              if(update%recv(m)%tileNbr(n) == domain%tile_id(tme)) 
then 
 4849                 if(update%recv(m)%dir(n) == 1) domain%x(tme)%loffset = 0
 
 4850                 if(update%recv(m)%dir(n) == 7) domain%y(tme)%loffset = 0
 
 4856     if(nrecv_check>0) 
then 
 4857        check%nrecv = nrecv_check
 
 4858        if (
associated(check%recv)) 
deallocate(check%recv) 
 
 4859        allocate(check%recv(nrecv_check))
 
 4860        do m = 1, nrecv_check
 
 4865     call deallocate_overlap_type(overlap)
 
 4867        call deallocate_overlap_type(overlaplist(m))
 
 4868        if(debug_update_level .NE. no_check) 
call deallocate_overlap_type(checklist(m))
 
 4874     domain%initialized = .true.
 
 4879   subroutine get_fold_index_west(jsg, jeg, isg, jshift, position, is, ie, js, je)
 
 4880     integer,    
intent(in) :: jsg, jeg, isg, jshift, position
 
 4881     integer, 
intent(inout) :: is, ie, js, je
 
 4884     select case(position)
 
 4886        j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4887        i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
 
 4889        j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4890        i=is; is = 2*isg-ie; ie = 2*isg-i
 
 4892        j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4893        i=is; is = 2*isg-ie-1; ie = 2*isg-i-1
 
 4895        j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4896        i=is; is = 2*isg-ie; ie = 2*isg-i
 
 4899   end subroutine get_fold_index_west
 
 4902   subroutine get_fold_index_east(jsg, jeg, ieg, jshift, position, is, ie, js, je)
 
 4903     integer,    
intent(in) :: jsg, jeg, ieg, jshift, position
 
 4904     integer, 
intent(inout) :: is, ie, js, je
 
 4907     select case(position)
 
 4909        j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4910        i=is; is = 2*ieg-ie+1; ie = 2*ieg-i+1
 
 4912        j=js; js = jsg+jeg-je; je = jsg+jeg-j
 
 4913        i=is; is = 2*ieg-ie; ie = 2*ieg-i
 
 4915        j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4916        i=is; is = 2*ieg-ie+1; ie = 2*ieg-i+1
 
 4918        j=js; js = jsg+jeg-je-1+jshift; je = jsg+jeg-j-1+jshift
 
 4919        i=is; is = 2*ieg-ie; ie = 2*ieg-i
 
 4922   end subroutine get_fold_index_east
 
 4925   subroutine get_fold_index_south(isg, ieg, jsg, ishift, position, is, ie, js, je)
 
 4926     integer,    
intent(in) :: isg, ieg, jsg, ishift, position
 
 4927     integer, 
intent(inout) :: is, ie, js, je
 
 4930     select case(position)
 
 4932        i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 4933        j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
 
 4935        i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 4936        j=js; js = 2*jsg-je-1; je = 2*jsg-j-1
 
 4938        i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 4939        j=js; js = 2*jsg-je; je = 2*jsg-j
 
 4941        i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 4942        j=js; js = 2*jsg-je; je = 2*jsg-j
 
 4945   end subroutine get_fold_index_south
 
 4947   subroutine get_fold_index_north(isg, ieg, jeg, ishift, position, is, ie, js, je)
 
 4948     integer,    
intent(in) :: isg, ieg, jeg, ishift, position
 
 4949     integer, 
intent(inout) :: is, ie, js, je
 
 4952     select case(position)
 
 4954        i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 4955        j=js; js = 2*jeg-je+1; je = 2*jeg-j+1
 
 4957        i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 4958        j=js; js = 2*jeg-je+1; je = 2*jeg-j+1
 
 4960        i=is; is = isg+ieg-ie; ie = isg+ieg-i
 
 4961        j=js; js = 2*jeg-je; je = 2*jeg-j
 
 4963        i=is; is = isg+ieg-ie-1+ishift; ie = isg+ieg-i-1+ishift
 
 4964        j=js; js = 2*jeg-je; je = 2*jeg-j
 
 4967   end subroutine get_fold_index_north
 
 4973     integer, 
intent(inout) :: lstart, lend
 
 4974     integer, 
intent(in   ) :: offset, gstart, gend, gsize
 
 4976     lstart = lstart + offset
 
 4977     if(lstart > gend)   lstart = lstart - gsize
 
 4978     if(lstart < gstart) lstart = lstart + gsize
 
 4979     lend = lend + offset
 
 4980     if(lend > gend)     lend   = lend   - gsize
 
 4981     if(lend < gstart)   lend   = lend   + gsize
 
 4994   subroutine set_overlaps(domain, overlap_in, overlap_out, whalo_out, ehalo_out, shalo_out, nhalo_out)
 
 4995     type(domain2d),    
intent(in)    :: domain
 
 4996     type(overlapspec), 
intent(in)    :: overlap_in
 
 4997     type(overlapspec), 
intent(inout) :: overlap_out
 
 4998     integer,           
intent(in)    :: whalo_out, ehalo_out, shalo_out, nhalo_out
 
 4999     integer                          :: nlist, m, n, isoff, ieoff, jsoff, jeoff, rotation
 
 5000     integer                          :: whalo_in, ehalo_in, shalo_in, nhalo_in
 
 5002     type(overlap_type)               :: overlap
 
 5003     type(overlap_type), 
allocatable  :: send(:), recv(:)
 
 5004     type(overlap_type), 
pointer      :: ptrIn  => null()
 
 5005     integer                          :: nsend, nrecv, nsend_in, nrecv_in
 
 5007     if( domain%fold .NE. 0) 
call mpp_error(fatal, 
"mpp_domains_define.inc(set_overlaps):"// &
 
 5008                                & 
" folded domain is not implemented for arbitrary halo update, contact developer")
 
 5010     whalo_in = domain%whalo
 
 5011     ehalo_in = domain%ehalo
 
 5012     shalo_in = domain%shalo
 
 5013     nhalo_in = domain%nhalo
 
 5015     if( .NOT. domain%initialized) 
call mpp_error(fatal, &
 
 5016          "mpp_domains_define.inc: domain is not defined yet")
 
 5018     nlist = 
size(domain%list(:))
 
 5019     isoff = whalo_in - abs(whalo_out)
 
 5020     ieoff = ehalo_in - abs(ehalo_out)
 
 5021     jsoff = shalo_in - abs(shalo_out)
 
 5022     jeoff = nhalo_in - abs(nhalo_out)
 
 5025     nsend_in = overlap_in%nsend
 
 5026     nrecv_in = overlap_in%nrecv
 
 5027     if(nsend_in>0) 
allocate(send(nsend_in))
 
 5028     if(nrecv_in>0) 
allocate(recv(nrecv_in))
 
 5029     call allocate_update_overlap(overlap, maxoverlap)
 
 5031     overlap_out%whalo  = whalo_out
 
 5032     overlap_out%ehalo  = ehalo_out
 
 5033     overlap_out%shalo  = shalo_out
 
 5034     overlap_out%nhalo  = nhalo_out
 
 5035     overlap_out%xbegin = overlap_in%xbegin
 
 5036     overlap_out%xend   = overlap_in%xend
 
 5037     overlap_out%ybegin = overlap_in%ybegin
 
 5038     overlap_out%yend   = overlap_in%yend
 
 5042        ptrin  => overlap_in%send(m)
 
 5043        if(ptrin%count .LE. 0) 
call mpp_error(fatal, 
"mpp_domains_define.inc(set_overlaps):"// &
 
 5044                               " number of overlap for send should be a positive number for"//trim(domain%name) )
 
 5045        do n = 1, ptrin%count
 
 5047           rotation = ptrin%rotation(n)
 
 5050              if(ehalo_out > 0) 
then 
 5051                 call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, 0, n, dir, rotation)
 
 5052              else if(ehalo_out<0) 
then 
 5053                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, 0, n, dir, rotation)
 
 5056              if(ehalo_out>0 .AND. shalo_out > 0) 
then 
 5057                 call set_single_overlap(ptrin, overlap, 0, -ieoff, jsoff, 0, n, dir, rotation)
 
 5058              else if(ehalo_out<0 .AND. shalo_out < 0) 
then  
 5059                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, shalo_out, n, dir, rotation)
 
 5060                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, jsoff, 0, n, dir-1, rotation)
 
 5061                 call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, shalo_out, n, dir+1, rotation)
 
 5064              if(shalo_out > 0) 
then 
 5065                 call set_single_overlap(ptrin, overlap, 0, 0, jsoff, 0, n, dir, rotation)
 
 5066              else if(shalo_out<0) 
then 
 5067                 call set_single_overlap(ptrin, overlap, 0, 0, 0, shalo_out, n, dir, rotation)
 
 5070              if(whalo_out>0 .AND. shalo_out > 0) 
then 
 5071                 call set_single_overlap(ptrin, overlap, isoff, 0, jsoff, 0, n, dir, rotation)
 
 5072              else if(whalo_out<0 .AND. shalo_out < 0) 
then 
 5073                 call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, shalo_out, n, dir, rotation)
 
 5074                 call set_single_overlap(ptrin, overlap, isoff, 0, 0, shalo_out, n, dir-1, rotation)
 
 5075                 call set_single_overlap(ptrin, overlap, 0, whalo_out, jsoff, 0, n, dir+1, rotation)
 
 5078              if(whalo_out > 0) 
then 
 5079                 call set_single_overlap(ptrin, overlap, isoff, 0, 0, 0, n, dir, rotation)
 
 5080              else if(whalo_out<0) 
then 
 5081                 call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, 0, n, dir, rotation)
 
 5084              if(whalo_out>0 .AND. nhalo_out > 0) 
then 
 5085                 call set_single_overlap(ptrin, overlap, isoff, 0, 0, -jeoff, n, dir, rotation)
 
 5086              else if(whalo_out<0 .AND. nhalo_out < 0) 
then 
 5087                 call set_single_overlap(ptrin, overlap, 0, whalo_out, -nhalo_out, 0, n, dir, rotation)
 
 5088                 call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, -jeoff, n, dir-1, rotation)
 
 5089                 call set_single_overlap(ptrin, overlap, isoff, 0, -nhalo_out, 0, n, dir+1, rotation)
 
 5092              if(nhalo_out > 0) 
then 
 5093                 call set_single_overlap(ptrin, overlap, 0, 0, 0, -jeoff, n, dir, rotation)
 
 5094              else if(nhalo_out<0) 
then 
 5095                 call set_single_overlap(ptrin, overlap, 0, 0, -nhalo_out, 0, n, dir, rotation)
 
 5098              if(ehalo_out>0 .AND. nhalo_out > 0) 
then 
 5099                 call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, -jeoff, n, dir, rotation)
 
 5100              else if(ehalo_out<0 .AND. nhalo_out < 0) 
then 
 5101                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, -nhalo_out, 0, n, dir, rotation)
 
 5102                 call set_single_overlap(ptrin, overlap, 0, -ieoff, -nhalo_out, 0, n, dir-1, rotation)
 
 5103                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, -jeoff, n, 1, rotation)
 
 5107        if(overlap%count>0) 
then 
 5109           call add_update_overlap(send(nsend), overlap)
 
 5110           call init_overlap_type(overlap)
 
 5115        overlap_out%nsend = nsend
 
 5116        if (
associated(overlap_out%send)) 
deallocate(overlap_out%send) 
 
 5117        allocate(overlap_out%send(nsend));
 
 5119           call add_update_overlap(overlap_out%send(n), send(n) )
 
 5122        overlap_out%nsend = 0
 
 5131        ptrin  => overlap_in%recv(m)
 
 5132        if(ptrin%count .LE. 0) 
call mpp_error(fatal, &
 
 5133           "mpp_domains_define.inc(set_overlaps): number of overlap for recv should be a positive number")
 
 5135        do n = 1, ptrin%count
 
 5137           rotation = ptrin%rotation(n)
 
 5140              if(ehalo_out > 0) 
then 
 5141                 call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, 0, n, dir)
 
 5142              else if(ehalo_out<0) 
then 
 5143                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, 0, n, dir)
 
 5146              if(ehalo_out>0 .AND. shalo_out > 0) 
then 
 5147                 call set_single_overlap(ptrin, overlap, 0, -ieoff, jsoff, 0, n, dir)
 
 5148              else if(ehalo_out<0 .AND. shalo_out < 0) 
then 
 5149                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, shalo_out, n, dir)
 
 5150                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, jsoff, 0, n, dir-1)
 
 5151                 call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, shalo_out, n, dir+1)
 
 5154              if(shalo_out > 0) 
then 
 5155                 call set_single_overlap(ptrin, overlap, 0, 0, jsoff, 0, n, dir)
 
 5156              else if(shalo_out<0) 
then 
 5157                 call set_single_overlap(ptrin, overlap, 0, 0, 0, shalo_out, n, dir)
 
 5160              if(whalo_out>0 .AND. shalo_out > 0) 
then 
 5161                 call set_single_overlap(ptrin, overlap, isoff, 0, jsoff, 0, n, dir)
 
 5162              else if(whalo_out<0 .AND. shalo_out < 0) 
then 
 5163                 call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, shalo_out, n, dir)
 
 5164                 call set_single_overlap(ptrin, overlap, isoff, 0, 0, shalo_out, n, dir-1)
 
 5165                 call set_single_overlap(ptrin, overlap, 0, whalo_out, jsoff, 0, n, dir+1)
 
 5168              if(whalo_out > 0) 
then 
 5169                 call set_single_overlap(ptrin, overlap, isoff, 0, 0, 0, n, dir)
 
 5170              else if(whalo_out<0) 
then 
 5171                 call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, 0, n, dir)
 
 5174              if(whalo_out>0 .AND. nhalo_out > 0) 
then 
 5175                 call set_single_overlap(ptrin, overlap, isoff, 0, 0, -jeoff, n, dir)
 
 5176              else if(whalo_out<0 .AND. nhalo_out < 0) 
then 
 5177                 call set_single_overlap(ptrin, overlap, 0, whalo_out, -nhalo_out, 0, n, dir)
 
 5178                 call set_single_overlap(ptrin, overlap, 0, whalo_out, 0, -jeoff, n, dir-1)
 
 5179                 call set_single_overlap(ptrin, overlap, isoff, 0, -nhalo_out, 0, n, dir+1)
 
 5182              if(nhalo_out > 0) 
then 
 5183                 call set_single_overlap(ptrin, overlap, 0, 0, 0, -jeoff, n, dir)
 
 5184              else if(nhalo_out<0) 
then 
 5185                 call set_single_overlap(ptrin, overlap, 0, 0, -nhalo_out, 0, n, dir)
 
 5188              if(ehalo_out>0 .AND. nhalo_out > 0) 
then 
 5189                 call set_single_overlap(ptrin, overlap, 0, -ieoff, 0, -jeoff, n, dir)
 
 5190              else if(ehalo_out<0 .AND. nhalo_out < 0) 
then 
 5191                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, -nhalo_out, 0, n, dir)
 
 5192                 call set_single_overlap(ptrin, overlap, 0, -ieoff, -nhalo_out, 0, n, dir-1)
 
 5193                 call set_single_overlap(ptrin, overlap, -ehalo_out, 0, 0, -jeoff, n, 1)
 
 5197        if(overlap%count>0) 
then 
 5199           call add_update_overlap(recv(nrecv), overlap)
 
 5200           call init_overlap_type(overlap)
 
 5205        overlap_out%nrecv = nrecv
 
 5206        if (
associated(overlap_out%recv)) 
deallocate(overlap_out%recv) 
 
 5207        allocate(overlap_out%recv(nrecv));
 
 5209           call add_update_overlap(overlap_out%recv(n), recv(n) )
 
 5212        overlap_out%nrecv = 0
 
 5215     call deallocate_overlap_type(overlap)
 
 5217        call deallocate_overlap_type(send(n))
 
 5220        call deallocate_overlap_type(recv(n))
 
 5222     if(
allocated(send)) 
deallocate(send)
 
 5223     if(
allocated(recv)) 
deallocate(recv)
 
 5226     call  set_domain_comm_inf(overlap_out)
 
 5232   subroutine set_single_overlap(overlap_in, overlap_out, isoff, ieoff, jsoff, jeoff, index, dir, rotation)
 
 5233     type(overlap_type),    
intent(in) :: overlap_in
 
 5234     type(overlap_type), 
intent(inout) :: overlap_out
 
 5235     integer,               
intent(in) :: isoff, jsoff, ieoff, jeoff
 
 5236     integer,               
intent(in) :: index
 
 5237     integer,               
intent(in) :: dir
 
 5238     integer, 
optional,     
intent(in) :: rotation
 
 5242     if( overlap_out%pe == null_pe ) 
then 
 5243        overlap_out%pe  = overlap_in%pe
 
 5245        if(overlap_out%pe .NE. overlap_in%pe) 
call mpp_error(fatal,  &
 
 5246             "mpp_domains_define.inc(set_single_overlap): mismatch of pe between overlap_in and overlap_out")
 
 5249     if(isoff .NE. 0 .and. ieoff .NE. 0) 
call mpp_error(fatal,  &
 
 5250           "mpp_domains_define.inc(set_single_overlap): both isoff and ieoff are non-zero")
 
 5251     if(jsoff .NE. 0 .and. jeoff .NE. 0) 
call mpp_error(fatal,  &
 
 5252           "mpp_domains_define.inc(set_single_overlap): both jsoff and jeoff are non-zero")
 
 5255     overlap_out%count = overlap_out%count + 1
 
 5256     count = overlap_out%count
 
 5257     if(count > maxoverlap) 
call mpp_error(fatal, &
 
 5258          "set_single_overlap: number of overlap is greater than MAXOVERLAP, increase MAXOVERLAP")
 
 5260     if(
present(rotation)) rotate = rotation
 
 5261     overlap_out%rotation  (count) = overlap_in%rotation(index)
 
 5262     overlap_out%dir       (count) = dir
 
 5263     overlap_out%tileMe    (count) = overlap_in%tileMe(index)
 
 5264     overlap_out%tileNbr   (count) = overlap_in%tileNbr(index)
 
 5268        overlap_out%is(count)      = overlap_in%is(index) + isoff
 
 5269        overlap_out%ie(count)      = overlap_in%ie(index) + ieoff
 
 5270        overlap_out%js(count)      = overlap_in%js(index) + jsoff
 
 5271        overlap_out%je(count)      = overlap_in%je(index) + jeoff
 
 5273        overlap_out%is(count)      = overlap_in%is(index) - jeoff
 
 5274        overlap_out%ie(count)      = overlap_in%ie(index) - jsoff
 
 5275        overlap_out%js(count)      = overlap_in%js(index) + isoff
 
 5276        overlap_out%je(count)      = overlap_in%je(index) + ieoff
 
 5278        overlap_out%is(count)      = overlap_in%is(index) + jsoff
 
 5279        overlap_out%ie(count)      = overlap_in%ie(index) + jeoff
 
 5280        overlap_out%js(count)      = overlap_in%js(index) - ieoff
 
 5281        overlap_out%je(count)      = overlap_in%je(index) - isoff
 
 5283        call mpp_error(fatal, 
"mpp_domains_define.inc: the value of rotation should be ZERO, NINETY or MINUS_NINETY")
 
 5286   end subroutine set_single_overlap
 
 5291        refine1, refine2, istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2,        &
 
 5292        isgList, iegList, jsgList, jegList )
 
 5293     type(domain2d),     
intent(inout) :: domain
 
 5294     integer,               
intent(in) :: position
 
 5295     integer,               
intent(in) :: num_contact
 
 5296     integer, 
dimension(:), 
intent(in) :: tile1, tile2
 
 5297     integer, 
dimension(:), 
intent(in) :: align1, align2
 
 5298     real,    
dimension(:), 
intent(in) :: refine1, refine2
 
 5299     integer, 
dimension(:), 
intent(in) :: istart1, iend1
 
 5300     integer, 
dimension(:), 
intent(in) :: jstart1, jend1
 
 5301     integer, 
dimension(:), 
intent(in) :: istart2, iend2
 
 5302     integer, 
dimension(:), 
intent(in) :: jstart2, jend2
 
 5303     integer, 
dimension(:), 
intent(in) :: isgList, iegList
 
 5304     integer, 
dimension(:), 
intent(in) :: jsgList, jegList
 
 5306     integer              :: isc, iec, jsc, jec, isd, ied, jsd, jed
 
 5307     integer              :: isc1, iec1, jsc1, jec1, isc2, iec2, jsc2, jec2
 
 5308     integer              :: isd1, ied1, jsd1, jed1, isd2, ied2, jsd2, jed2
 
 5309     integer              :: is, ie, js, je, ioff, joff
 
 5310     integer              :: ntiles, max_contact
 
 5311     integer              :: nlist, list, m, n, l, count, numS, numR
 
 5312     integer              :: whalo, ehalo, shalo, nhalo
 
 5313     integer              :: t1, t2, tt, pos
 
 5314     integer              :: ntileMe, ntileNbr, tMe, tNbr, tileMe, dir
 
 5315     integer              :: nxd, nyd, nxc, nyc, ism, iem, jsm, jem
 
 5316     integer              :: dirlist(8)
 
 5319     integer, 
dimension(4*num_contact) :: is1Send, ie1Send, js1Send, je1Send
 
 5320     integer, 
dimension(4*num_contact) :: is2Send, ie2Send, js2Send, je2Send
 
 5321     integer, 
dimension(4*num_contact) :: is2Recv, ie2Recv, js2Recv, je2Recv
 
 5322     integer, 
dimension(4*num_contact) :: is1Recv, ie1Recv, js1Recv, je1Recv
 
 5323     integer, 
dimension(4*num_contact) :: align1Recv, align2Recv, align1Send, align2Send
 
 5324     real,    
dimension(4*num_contact) :: refineRecv, refineSend
 
 5325     integer, 
dimension(4*num_contact) :: rotateSend, rotateRecv, tileSend, tileRecv
 
 5326     integer                           :: nsend, nrecv, nsend2, nrecv2
 
 5327     type(contact_type), 
dimension(domain%ntiles)            :: eCont, wCont, sCont, nCont
 
 5328     type(overlap_type), 
dimension(0:size(domain%list(:))-1) :: overlapSend, overlapRecv
 
 5331     if( position .NE. center )  
call mpp_error(fatal,  
"mpp_domains_define.inc: " //&
 
 5332          "routine define_contact_point can only be used to calculate overlapping for cell center.")
 
 5334     ntiles  = domain%ntiles
 
 5336     econt(:)%ncontact = 0
 
 5339        econt(n)%ncontact = 0; scont(n)%ncontact = 0; wcont(n)%ncontact = 0; ncont(n)%ncontact = 0;
 
 5340        allocate(econt(n)%tile(num_contact), wcont(n)%tile(num_contact) )
 
 5341        allocate(ncont(n)%tile(num_contact), scont(n)%tile(num_contact) )
 
 5342        allocate(econt(n)%align1(num_contact), econt(n)%align2(num_contact) )
 
 5343        allocate(wcont(n)%align1(num_contact), wcont(n)%align2(num_contact) )
 
 5344        allocate(scont(n)%align1(num_contact), scont(n)%align2(num_contact) )
 
 5345        allocate(ncont(n)%align1(num_contact), ncont(n)%align2(num_contact) )
 
 5346        allocate(econt(n)%refine1(num_contact), econt(n)%refine2(num_contact) )
 
 5347        allocate(wcont(n)%refine1(num_contact), wcont(n)%refine2(num_contact) )
 
 5348        allocate(scont(n)%refine1(num_contact), scont(n)%refine2(num_contact) )
 
 5349        allocate(ncont(n)%refine1(num_contact), ncont(n)%refine2(num_contact) )
 
 5350        allocate(econt(n)%is1(num_contact), econt(n)%ie1(num_contact), econt(n)%js1(num_contact), &
 
 5351                &  econt(n)%je1(num_contact))
 
 5352        allocate(econt(n)%is2(num_contact), econt(n)%ie2(num_contact), econt(n)%js2(num_contact), &
 
 5353                &  econt(n)%je2(num_contact))
 
 5354        allocate(wcont(n)%is1(num_contact), wcont(n)%ie1(num_contact), wcont(n)%js1(num_contact), &
 
 5355                &  wcont(n)%je1(num_contact))
 
 5356        allocate(wcont(n)%is2(num_contact), wcont(n)%ie2(num_contact), wcont(n)%js2(num_contact), &
 
 5357                &  wcont(n)%je2(num_contact))
 
 5358        allocate(scont(n)%is1(num_contact), scont(n)%ie1(num_contact), scont(n)%js1(num_contact), &
 
 5359                &  scont(n)%je1(num_contact))
 
 5360        allocate(scont(n)%is2(num_contact), scont(n)%ie2(num_contact), scont(n)%js2(num_contact), &
 
 5361                &  scont(n)%je2(num_contact))
 
 5362        allocate(ncont(n)%is1(num_contact), ncont(n)%ie1(num_contact), ncont(n)%js1(num_contact), &
 
 5363                &  ncont(n)%je1(num_contact))
 
 5364        allocate(ncont(n)%is2(num_contact), ncont(n)%ie2(num_contact), ncont(n)%js2(num_contact), &
 
 5365                &  ncont(n)%je2(num_contact))
 
 5369     do n = 1, num_contact
 
 5372        select case(align1(n))
 
 5374           call fill_contact( econt(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
 
 5375                jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
 
 5377           call fill_contact( wcont(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
 
 5378                jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
 
 5380           call fill_contact( scont(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
 
 5381                jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
 
 5383           call fill_contact( ncont(t1), t2, istart1(n), iend1(n), jstart1(n), jend1(n), istart2(n), iend2(n), &
 
 5384                jstart2(n), jend2(n), align1(n), align2(n), refine1(n), refine2(n))
 
 5386        select case(align2(n))
 
 5388           call fill_contact( econt(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
 
 5389                jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
 
 5391           call fill_contact( wcont(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
 
 5392                jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
 
 5394           call fill_contact( scont(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
 
 5395                jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
 
 5397           call fill_contact( ncont(t2), t1, istart2(n), iend2(n), jstart2(n), jend2(n), istart1(n), iend1(n), &
 
 5398                jstart1(n), jend1(n), align2(n), align1(n), refine2(n), refine1(n))
 
 5403     whalo = domain%whalo
 
 5404     ehalo = domain%ehalo
 
 5405     shalo = domain%shalo
 
 5406     nhalo = domain%nhalo
 
 5409     nlist = 
size(domain%list(:))
 
 5411     max_contact = 4*num_contact 
 
 5413     ntileme = 
size(domain%x(:))
 
 5414     refinesend = 1; refinerecv = 1
 
 5420     do n = 1, domain%update_T%nsend
 
 5421        pos = domain%update_T%send(n)%pe - mpp_root_pe()
 
 5422        call add_update_overlap(overlapsend(pos), domain%update_T%send(n) )
 
 5424     do n = 1, domain%update_T%nrecv
 
 5425        pos = domain%update_T%recv(n)%pe - mpp_root_pe()
 
 5426        call add_update_overlap(overlaprecv(pos), domain%update_T%recv(n) )
 
 5429     call mpp_get_memory_domain(domain, ism, iem, jsm, jem)
 
 5430     domain%update_T%xbegin = ism;   domain%update_T%xend  = iem
 
 5431     domain%update_T%ybegin = jsm;   domain%update_T%yend  = jem
 
 5432     domain%update_T%whalo  = whalo; domain%update_T%ehalo = ehalo
 
 5433     domain%update_T%shalo  = shalo; domain%update_T%nhalo = nhalo
 
 5436        tileme = domain%tile_id(tme)
 
 5437        rotatesend = zero; rotaterecv = zero
 
 5441        do n = 1, econt(tileme)%ncontact  
 
 5443           tilerecv(count)   = econt(tileme)%tile(n);    tilesend(count)   = econt(tileme)%tile(n)
 
 5444           align1recv(count) = econt(tileme)%align1(n);  align2recv(count) = econt(tileme)%align2(n)
 
 5445           align1send(count) = econt(tileme)%align1(n);  align2send(count) = econt(tileme)%align2(n)
 
 5446           refinesend(count) = econt(tileme)%refine2(n); refinerecv(count) = econt(tileme)%refine1(n)
 
 5447           is1recv(count)    = econt(tileme)%is1(n) + 1; ie1recv(count)    = is1recv(count) + ehalo - 1
 
 5448           js1recv(count)    = econt(tileme)%js1(n);     je1recv(count)    = econt(tileme)%je1(n)
 
 5449           select case(econt(tileme)%align2(n))
 
 5451              is2recv(count) = econt(tileme)%is2(n);     ie2recv(count) = is2recv(count) + ehalo - 1
 
 5452              js2recv(count) = econt(tileme)%js2(n);     je2recv(count) = econt(tileme)%je2(n)
 
 5453              ie1send(count) = econt(tileme)%is1(n);     is1send(count) = ie1send(count) - whalo + 1
 
 5454              js1send(count) = econt(tileme)%js1(n);     je1send(count) = econt(tileme)%je1(n)
 
 5455              ie2send(count) = econt(tileme)%is2(n) - 1; is2send(count) = ie2send(count) - whalo + 1
 
 5456              js2send(count) = econt(tileme)%js2(n);     je2send(count) = econt(tileme)%je2(n)
 
 5458              rotaterecv(count) = ninety;                rotatesend(count) = minus_ninety
 
 5459              js2recv(count) = econt(tileme)%js2(n);     je2recv(count) = js2recv(count) + ehalo -1
 
 5460              is2recv(count) = econt(tileme)%is2(n);     ie2recv(count) = econt(tileme)%ie2(n)
 
 5461              ie1send(count) = econt(tileme)%is1(n);     is1send(count) = ie1send(count) - shalo + 1
 
 5462              js1send(count) = econt(tileme)%js1(n);     je1send(count) = econt(tileme)%je1(n)
 
 5463              is2send(count) = econt(tileme)%is2(n);     ie2send(count) = econt(tileme)%ie2(n)
 
 5464              je2send(count) = econt(tileme)%js2(n) - 1; js2send(count) = je2send(count) - shalo + 1
 
 5468        do n = 1, scont(tileme)%ncontact  
 
 5470           tilerecv(count)   = scont(tileme)%tile(n);    tilesend(count)   = scont(tileme)%tile(n)
 
 5471           align1recv(count) = scont(tileme)%align1(n);  align2recv(count) = scont(tileme)%align2(n);
 
 5472           align1send(count) = scont(tileme)%align1(n);  align2send(count) = scont(tileme)%align2(n);
 
 5473           refinesend(count) = scont(tileme)%refine2(n); refinerecv(count) = scont(tileme)%refine1(n)
 
 5474           is1recv(count)    = scont(tileme)%is1(n);     ie1recv(count)    = scont(tileme)%ie1(n)
 
 5475           je1recv(count)    = scont(tileme)%js1(n) - 1; js1recv(count)    = je1recv(count) - shalo + 1
 
 5476           select case(scont(tileme)%align2(n))
 
 5478              is2recv(count) = scont(tileme)%is2(n);   ie2recv(count) = scont(tileme)%ie2(n)
 
 5479              je2recv(count) = scont(tileme)%je2(n);   js2recv(count) = je2recv(count) - shalo + 1
 
 5480              is1send(count) = scont(tileme)%is1(n);   ie1send(count) = scont(tileme)%ie1(n)
 
 5481              js1send(count) = scont(tileme)%js1(n);   je1send(count) = js1send(count) + nhalo -1
 
 5482              is2send(count) = scont(tileme)%is2(n);   ie2send(count) = scont(tileme)%ie2(n)
 
 5483              js2send(count) = scont(tileme)%je2(n)+1; je2send(count) = js2send(count) + nhalo - 1
 
 5485              rotaterecv(count) = minus_ninety;        rotatesend(count) = ninety
 
 5486              ie2recv(count) = scont(tileme)%ie2(n);   is2recv(count) = ie2recv(count) - shalo + 1
 
 5487              js2recv(count) = scont(tileme)%js2(n);   je2recv(count) = scont(tileme)%je2(n)
 
 5488              is1send(count) = scont(tileme)%is1(n);   ie1send(count) = scont(tileme)%ie1(n)
 
 5489              js1send(count) = scont(tileme)%js1(n);   je1send(count) = js1send(count) + ehalo - 1
 
 5490              is2send(count) = scont(tileme)%ie2(n)+1; ie2send(count) = is2send(count) + ehalo - 1
 
 5491              js2send(count) = scont(tileme)%js2(n);   je2send(count) = scont(tileme)%je2(n)
 
 5495        do n = 1, wcont(tileme)%ncontact  
 
 5497           tilerecv(count)   = wcont(tileme)%tile(n);    tilesend(count)   = wcont(tileme)%tile(n)
 
 5498           align1recv(count) = wcont(tileme)%align1(n);  align2recv(count) = wcont(tileme)%align2(n);
 
 5499           align1send(count) = wcont(tileme)%align1(n);  align2send(count) = wcont(tileme)%align2(n);
 
 5500           refinesend(count) = wcont(tileme)%refine2(n); refinerecv(count) = wcont(tileme)%refine1(n)
 
 5501           ie1recv(count)    = wcont(tileme)%is1(n) - 1; is1recv(count)    = ie1recv(count) - whalo + 1
 
 5502           js1recv(count)    = wcont(tileme)%js1(n);     je1recv(count)    = wcont(tileme)%je1(n)
 
 5503           select case(wcont(tileme)%align2(n))
 
 5505              ie2recv(count) = wcont(tileme)%ie2(n);   is2recv(count) = ie2recv(count) - whalo + 1
 
 5506              js2recv(count) = wcont(tileme)%js2(n);   je2recv(count) = wcont(tileme)%je2(n)
 
 5507              is1send(count) = wcont(tileme)%is1(n);   ie1send(count) = is1send(count) + ehalo - 1
 
 5508              js1send(count) = wcont(tileme)%js1(n);   je1send(count) = wcont(tileme)%je1(n)
 
 5509              is2send(count) = wcont(tileme)%ie2(n)+1; ie2send(count) = is2send(count) + ehalo - 1
 
 5510              js2send(count) = wcont(tileme)%js2(n);   je2send(count) = wcont(tileme)%je2(n)
 
 5512              rotaterecv(count) = ninety;              rotatesend(count) = minus_ninety
 
 5513              je2recv(count) = wcont(tileme)%je2(n);   js2recv(count) = je2recv(count) - whalo + 1
 
 5514              is2recv(count) = wcont(tileme)%is2(n);   ie2recv(count) = wcont(tileme)%ie2(n)
 
 5515              is1send(count) = wcont(tileme)%is1(n);   ie1send(count) = is1send(count) + nhalo - 1
 
 5516              js1send(count) = wcont(tileme)%js1(n);   je1send(count) = wcont(tileme)%je1(n)
 
 5517              js2send(count) = wcont(tileme)%je2(n)+1; je2send(count) = js2send(count) + nhalo - 1
 
 5518              is2send(count) = wcont(tileme)%is2(n);   ie2send(count) = wcont(tileme)%ie2(n)
 
 5522        do n = 1, ncont(tileme)%ncontact  
 
 5524           tilerecv(count)   = ncont(tileme)%tile(n);   tilesend(count)   = ncont(tileme)%tile(n)
 
 5525           align1recv(count) = ncont(tileme)%align1(n); align2recv(count) = ncont(tileme)%align2(n);
 
 5526           align1send(count) = ncont(tileme)%align1(n); align2send(count) = ncont(tileme)%align2(n);
 
 5527           refinesend(count) = ncont(tileme)%refine2(n); refinerecv(count) = ncont(tileme)%refine1(n)
 
 5528           is1recv(count)    = ncont(tileme)%is1(n);    ie1recv(count)    = ncont(tileme)%ie1(n)
 
 5529           js1recv(count)    = ncont(tileme)%je1(n)+1;  je1recv(count)    = js1recv(count) + nhalo - 1
 
 5530           select case(ncont(tileme)%align2(n))
 
 5532              is2recv(count) = ncont(tileme)%is2(n);   ie2recv(count) = ncont(tileme)%ie2(n)
 
 5533              js2recv(count) = ncont(tileme)%js2(n);   je2recv(count) = js2recv(count) + nhalo - 1
 
 5534              is1send(count) = ncont(tileme)%is1(n);   ie1send(count) = ncont(tileme)%ie1(n)
 
 5535              je1send(count) = ncont(tileme)%je1(n);   js1send(count) = je1send(count) - shalo + 1
 
 5536              is2send(count) = ncont(tileme)%is2(n);   ie2send(count) = ncont(tileme)%ie2(n)
 
 5537              je2send(count) = ncont(tileme)%js2(n)-1; js2send(count) = je2send(count) - shalo + 1
 
 5539              rotaterecv(count) = minus_ninety;        rotatesend(count) = ninety
 
 5540              is2recv(count) = ncont(tileme)%ie2(n);   ie2recv(count) = is2recv(count) + nhalo - 1
 
 5541              js2recv(count) = ncont(tileme)%js2(n);   je2recv(count) = ncont(tileme)%je2(n)
 
 5542              is1send(count) = ncont(tileme)%is1(n);   ie1send(count) = ncont(tileme)%ie1(n)
 
 5543              je1send(count) = ncont(tileme)%je1(n);   js1send(count) = je1send(count) - whalo + 1
 
 5544              ie2send(count) = ncont(tileme)%is2(n)-1; is2send(count) = ie2send(count) - whalo + 1
 
 5545              js2send(count) = ncont(tileme)%js2(n);   je2send(count) = ncont(tileme)%je2(n)
 
 5554        if(.NOT. domain%rotated_ninety)  
then 
 5555           call fill_corner_contact(econt, scont, wcont, ncont, isglist, ieglist, jsglist, jeglist, numr, nums, &
 
 5556                tilerecv, tilesend, is1recv, ie1recv, js1recv, je1recv, is2recv, ie2recv,   &
 
 5557                js2recv, je2recv, is1send, ie1send, js1send, je1send, is2send, ie2send,     &
 
 5558                js2send, je2send, align1recv, align2recv, align1send, align2send,           &
 
 5559                whalo, ehalo, shalo, nhalo, tileme )
 
 5562        isc = domain%x(tme)%compute%begin; iec = domain%x(tme)%compute%end
 
 5563        jsc = domain%y(tme)%compute%begin; jec = domain%y(tme)%compute%end
 
 5567           do list = 0, nlist-1
 
 5568              m = mod( domain%pos+list, nlist )
 
 5569              ntilenbr = 
size(domain%list(m)%x(:))
 
 5570              do tnbr = 1, ntilenbr
 
 5571                 if( domain%list(m)%tile_id(tnbr) .NE. tilesend(n) ) cycle
 
 5572                 isc1 = max(isc, is1send(n)); iec1 = min(iec, ie1send(n))
 
 5573                 jsc1 = max(jsc, js1send(n)); jec1 = min(jec, je1send(n))
 
 5574                 if( isc1 > iec1 .OR. jsc1 > jec1 ) cycle
 
 5580                       if( align2send(n) .NE. east ) cycle
 
 5581                       isd = domain%list(m)%x(tnbr)%compute%end+1; ied = domain%list(m)%x(tnbr)%compute%end+ehalo
 
 5582                       jsd = domain%list(m)%y(tnbr)%compute%begin; jed = domain%list(m)%y(tnbr)%compute%end
 
 5584                       isd = domain%list(m)%x(tnbr)%compute%end+1; ied = domain%list(m)%x(tnbr)%compute%end+ehalo
 
 5585                       jsd = domain%list(m)%y(tnbr)%compute%begin-shalo;    jed = domain%list(m)%y(tnbr)%compute%begin-1
 
 5587                       if( align2send(n) .NE. south ) cycle
 
 5588                       isd = domain%list(m)%x(tnbr)%compute%begin; ied = domain%list(m)%x(tnbr)%compute%end
 
 5589                       jsd = domain%list(m)%y(tnbr)%compute%begin-shalo;    jed = domain%list(m)%y(tnbr)%compute%begin-1
 
 5591                       isd = domain%list(m)%x(tnbr)%compute%begin-whalo;    ied = domain%list(m)%x(tnbr)%compute%begin-1
 
 5592                       jsd = domain%list(m)%y(tnbr)%compute%begin-shalo;    jed = domain%list(m)%y(tnbr)%compute%begin-1
 
 5594                       if( align2send(n) .NE. west ) cycle
 
 5595                       isd = domain%list(m)%x(tnbr)%compute%begin-whalo;    ied = domain%list(m)%x(tnbr)%compute%begin-1
 
 5596                       jsd = domain%list(m)%y(tnbr)%compute%begin; jed = domain%list(m)%y(tnbr)%compute%end
 
 5598                       isd = domain%list(m)%x(tnbr)%compute%begin-whalo;    ied = domain%list(m)%x(tnbr)%compute%begin-1
 
 5599                       jsd = domain%list(m)%y(tnbr)%compute%end+1; jed = domain%list(m)%y(tnbr)%compute%end+nhalo
 
 5601                       if( align2send(n) .NE. north ) cycle
 
 5602                       isd = domain%list(m)%x(tnbr)%compute%begin; ied = domain%list(m)%x(tnbr)%compute%end
 
 5603                       jsd = domain%list(m)%y(tnbr)%compute%end+1; jed = domain%list(m)%y(tnbr)%compute%end+nhalo
 
 5605                       isd = domain%list(m)%x(tnbr)%compute%end+1; ied = domain%list(m)%x(tnbr)%compute%end+ehalo
 
 5606                       jsd = domain%list(m)%y(tnbr)%compute%end+1; jed = domain%list(m)%y(tnbr)%compute%end+nhalo
 
 5608                    isd = max(isd, is2send(n)); ied = min(ied, ie2send(n))
 
 5609                    jsd = max(jsd, js2send(n)); jed = min(jed, je2send(n))
 
 5610                    if( isd > ied .OR. jsd > jed ) cycle
 
 5614                    select case ( align2send(n) )
 
 5616                       ioff = isd - is2send(n)
 
 5617                       joff = jsd - js2send(n)
 
 5618                    case ( south, north )
 
 5619                       ioff = isd - is2send(n)
 
 5620                       joff = jsd - js2send(n)
 
 5624                    select case ( rotatesend(n) )
 
 5626                       isc2 = is1send(n) + ioff; iec2 = isc2 + nxd - 1
 
 5627                       jsc2 = js1send(n) + joff; jec2 = jsc2 + nyd - 1
 
 5629                       iec2 = ie1send(n) - joff; isc2 = iec2 - nyd + 1
 
 5630                       jsc2 = js1send(n) + ioff; jec2 = jsc2 + nxd - 1
 
 5631                    case ( minus_ninety )               
 
 5632                       isc2 = is1send(n) + joff; iec2 = isc2 + nyd - 1
 
 5633                       jec2 = je1send(n) - ioff; jsc2 = jec2 - nxd + 1
 
 5635                    is = max(isc1,isc2); ie = min(iec1,iec2)
 
 5636                    js = max(jsc1,jsc2); je = min(jec1,jec2)
 
 5637                    if(ie.GE.is .AND. je.GE.js )
then 
 5638                       if(.not. 
associated(overlapsend(m)%tileMe)) 
call allocate_update_overlap(overlapsend(m), &
 
 5640                     call insert_overlap_type(overlapsend(m), domain%list(m)%pe, tme, tnbr, &
 
 5641                          is, ie, js, je, dir, rotatesend(n), .true. )
 
 5650           do list = 0, nlist-1
 
 5651              m = mod( domain%pos+nlist-list, nlist )
 
 5652              ntilenbr = 
size(domain%list(m)%x(:))
 
 5653              do tnbr = 1, ntilenbr
 
 5654                 if( domain%list(m)%tile_id(tnbr) .NE. tilerecv(n) ) cycle
 
 5655                 isc = domain%list(m)%x(tnbr)%compute%begin; iec = domain%list(m)%x(tnbr)%compute%end
 
 5656                 jsc = domain%list(m)%y(tnbr)%compute%begin; jec = domain%list(m)%y(tnbr)%compute%end
 
 5657                 isc = max(isc, is2recv(n)); iec = min(iec, ie2recv(n))
 
 5658                 jsc = max(jsc, js2recv(n)); jec = min(jec, je2recv(n))
 
 5659                 if( isc > iec .OR. jsc > jec ) cycle
 
 5662                 nxc = iec - isc + 1; nyc = jec - jsc + 1
 
 5663                 select case ( align2recv(n) )
 
 5665                    if(align2recv(n) == west) 
then 
 5666                       ioff = isc - is2recv(n)
 
 5668                       ioff = ie2recv(n) - iec
 
 5670                    joff = jsc - js2recv(n)
 
 5671                 case ( north, south )
 
 5672                    ioff = isc - is2recv(n)
 
 5673                    if(align2recv(n) == south) 
then 
 5674                       joff = jsc - js2recv(n)
 
 5676                       joff = je2recv(n) - jec
 
 5681                 select case ( rotaterecv(n) )
 
 5683                    isd1 = is1recv(n) + ioff; ied1 = isd1 + nxc - 1
 
 5684                    jsd1 = js1recv(n) + joff; jed1 = jsd1 + nyc - 1
 
 5685                    if( align1recv(n) == west ) 
then 
 5686                       ied1 = ie1recv(n)-ioff;   isd1 = ied1 - nxc + 1
 
 5688                    if( align1recv(n) == south ) 
then 
 5689                       jed1 = je1recv(n)-joff;  jsd1 = jed1 - nyc + 1
 
 5692                    if( align1recv(n) == west ) 
then 
 5693                       ied1 = ie1recv(n)-joff;   isd1 = ied1 - nyc + 1
 
 5695                       isd1 = is1recv(n)+joff;   ied1 = isd1 + nyc - 1
 
 5697                    jed1 = je1recv(n) - ioff; jsd1 = jed1 - nxc + 1
 
 5698                 case ( minus_ninety )                
 
 5699                    ied1 = ie1recv(n) - joff; isd1 = ied1 - nyc + 1
 
 5700                    if( align1recv(n) == south ) 
then 
 5701                       jed1 = je1recv(n)-ioff;  jsd1 = jed1 - nxc + 1
 
 5703                       jsd1 = js1recv(n)+ioff;  jed1 = jsd1 + nxc - 1
 
 5711                       if( align1recv(n) .NE. east ) cycle
 
 5712                       isd2 = domain%x(tme)%compute%end+1; ied2 = domain%x(tme)%domain_data%end
 
 5713                       jsd2 = domain%y(tme)%compute%begin; jed2 = domain%y(tme)%compute%end
 
 5715                       isd2 = domain%x(tme)%compute%end+1; ied2 = domain%x(tme)%domain_data%end
 
 5716                       jsd2 = domain%y(tme)%domain_data%begin;    jed2 = domain%y(tme)%compute%begin-1
 
 5718                       if( align1recv(n) .NE. south ) cycle
 
 5719                       isd2 = domain%x(tme)%compute%begin; ied2 = domain%x(tme)%compute%end
 
 5720                       jsd2 = domain%y(tme)%domain_data%begin;    jed2 = domain%y(tme)%compute%begin-1
 
 5722                       isd2 = domain%x(tme)%domain_data%begin;    ied2 = domain%x(tme)%compute%begin-1
 
 5723                       jsd2 = domain%y(tme)%domain_data%begin;    jed2 = domain%y(tme)%compute%begin-1
 
 5725                       if( align1recv(n) .NE. west ) cycle
 
 5726                       isd2 = domain%x(tme)%domain_data%begin;    ied2 = domain%x(tme)%compute%begin-1
 
 5727                       jsd2 = domain%y(tme)%compute%begin; jed2 = domain%y(tme)%compute%end
 
 5729                       isd2 = domain%x(tme)%domain_data%begin;    ied2 = domain%x(tme)%compute%begin-1
 
 5730                       jsd2 = domain%y(tme)%compute%end+1; jed2 = domain%y(tme)%domain_data%end
 
 5732                       if( align1recv(n) .NE. north ) cycle
 
 5733                       isd2 = domain%x(tme)%compute%begin; ied2 = domain%x(tme)%compute%end
 
 5734                       jsd2 = domain%y(tme)%compute%end+1; jed2 = domain%y(tme)%domain_data%end
 
 5736                       isd2 = domain%x(tme)%compute%end+1; ied2 = domain%x(tme)%domain_data%end
 
 5737                       jsd2 = domain%y(tme)%compute%end+1; jed2 = domain%y(tme)%domain_data%end
 
 5739                    is = max(isd1,isd2); ie = min(ied1,ied2)
 
 5740                    js = max(jsd1,jsd2); je = min(jed1,jed2)
 
 5741                    if(ie.GE.is .AND. je.GE.js )
then 
 5742                       if(.not. 
associated(overlaprecv(m)%tileMe)) 
call allocate_update_overlap(overlaprecv(m), &
 
 5744                     call insert_overlap_type(overlaprecv(m), domain%list(m)%pe, tme, tnbr, &
 
 5745                          is, ie, js, je, dir, rotaterecv(n), .true.)
 
 5746                       count                              = overlaprecv(m)%count
 
 5755     nsend = 0; nsend2 = 0
 
 5756     do list = 0, nlist-1
 
 5757        m = mod( domain%pos+list, nlist )
 
 5758        if(overlapsend(m)%count>0) nsend = nsend + 1
 
 5761     if(debug_message_passing) 
then 
 5764        do list = 0, nlist-1
 
 5765           m = mod( domain%pos+list, nlist )
 
 5766           if(overlapsend(m)%count==0) cycle
 
 5767           write(iunit, *) 
"********to_pe = " ,overlapsend(m)%pe, 
" count = ",overlapsend(m)%count
 
 5768           do n = 1, overlapsend(m)%count
 
 5769              write(iunit, *) overlapsend(m)%is(n), overlapsend(m)%ie(n), overlapsend(m)%js(n), overlapsend(m)%je(n), &
 
 5770                   overlapsend(m)%dir(n), overlapsend(m)%rotation(n)
 
 5773        if(nsend >0) 
flush(iunit)
 
 5776     dirlist(1) = 1; dirlist(2) = 3; dirlist(3) = 5; dirlist(4) = 7
 
 5777     dirlist(5) = 2; dirlist(6) = 4; dirlist(7) = 6; dirlist(8) = 8
 
 5781        if(
associated(domain%update_T%send)) 
then 
 5782           do m = 1, domain%update_T%nsend
 
 5783              call deallocate_overlap_type(domain%update_T%send(m))
 
 5785           deallocate(domain%update_T%send)
 
 5787        domain%update_T%nsend = nsend
 
 5788        allocate(domain%update_T%send(nsend))
 
 5789        do list = 0, nlist-1
 
 5790           m = mod( domain%pos+list, nlist )
 
 5791           ntilenbr = 
size(domain%list(m)%x(:))
 
 5793           if(overlapsend(m)%count > 0) 
then 
 5795              if(nsend2>nsend) 
call mpp_error(fatal, &
 
 5796                   "mpp_domains_define.inc(define_contact_point): nsend2 is greater than nsend")
 
 5797              call allocate_update_overlap(domain%update_T%send(nsend2), overlapsend(m)%count)
 
 5799              do tnbr = 1, ntilenbr
 
 5801                    if(domain%list(m)%pe == domain%pe) 
then  
 5803                       if(tme > ntileme) tme = tme - ntileme
 
 5808                       do l = 1, overlapsend(m)%count
 
 5809                          if(overlapsend(m)%tileMe(l) .NE. tme) cycle
 
 5810                          if(overlapsend(m)%tileNbr(l) .NE. tnbr) cycle
 
 5811                          if(overlapsend(m)%dir(l) .NE. dirlist(n) ) cycle
 
 5812                        call insert_overlap_type(domain%update_T%send(nsend2), overlapsend(m)%pe, &
 
 5813                               overlapsend(m)%tileMe(l), overlapsend(m)%tileNbr(l), overlapsend(m)%is(l), &
 
 5814                               overlapsend(m)%ie(l), overlapsend(m)%js(l), overlapsend(m)%je(l), overlapsend(m)%dir(l),&
 
 5815                               overlapsend(m)%rotation(l), overlapsend(m)%from_contact(l)  )
 
 5824     if(nsend2 .NE. nsend) 
call mpp_error(fatal, &
 
 5825          "mpp_domains_define.inc(define_contact_point): nsend2 does not equal to nsend")
 
 5827     nrecv = 0; nrecv2 = 0
 
 5828     do list = 0, nlist-1
 
 5829        m = mod( domain%pos+list, nlist )
 
 5830        if(overlaprecv(m)%count>0) nrecv = nrecv + 1
 
 5833     if(debug_message_passing) 
then 
 5834        do list = 0, nlist-1
 
 5835           m = mod( domain%pos+list, nlist )
 
 5836           if(overlaprecv(m)%count==0) cycle
 
 5837           write(iunit, *) 
"********from_pe = " ,overlaprecv(m)%pe, 
" count = ",overlaprecv(m)%count
 
 5838           do n = 1, overlaprecv(m)%count
 
 5839              write(iunit, *) overlaprecv(m)%is(n), overlaprecv(m)%ie(n), overlaprecv(m)%js(n), overlaprecv(m)%je(n), &
 
 5840                   overlaprecv(m)%dir(n), overlaprecv(m)%rotation(n)
 
 5843        if(nrecv >0) 
flush(iunit)
 
 5847        if(
associated(domain%update_T%recv)) 
then 
 5848           do m = 1, domain%update_T%nrecv
 
 5849              call deallocate_overlap_type(domain%update_T%recv(m))
 
 5851           deallocate(domain%update_T%recv)
 
 5853        domain%update_T%nrecv = nrecv
 
 5854        allocate(domain%update_T%recv(nrecv))
 
 5856        do list = 0, nlist-1
 
 5857           m = mod( domain%pos+nlist-list, nlist )
 
 5858           ntilenbr = 
size(domain%list(m)%x(:))
 
 5859           if(overlaprecv(m)%count > 0) 
then 
 5861              if(nrecv2>nrecv) 
call mpp_error(fatal, &
 
 5862                    "mpp_domains_define.inc(define_contact_point): nrecv2 is greater than nrecv")
 
 5863              call allocate_update_overlap(domain%update_T%recv(nrecv2), overlaprecv(m)%count)
 
 5867                    if(domain%list(m)%pe == domain%pe) 
then  
 5869                       if(tnbr>ntilenbr) tnbr = tnbr - ntilenbr
 
 5874                       do l = 1, overlaprecv(m)%count
 
 5875                          if(overlaprecv(m)%tileMe(l) .NE. tme) cycle
 
 5876                          if(overlaprecv(m)%tileNbr(l) .NE. tnbr) cycle
 
 5877                          if(overlaprecv(m)%dir(l) .NE. dirlist(n) ) cycle
 
 5878                        call insert_overlap_type(domain%update_T%recv(nrecv2), overlaprecv(m)%pe, &
 
 5879                               overlaprecv(m)%tileMe(l), overlaprecv(m)%tileNbr(l), overlaprecv(m)%is(l), &
 
 5880                               overlaprecv(m)%ie(l), overlaprecv(m)%js(l), overlaprecv(m)%je(l), overlaprecv(m)%dir(l),&
 
 5881                               overlaprecv(m)%rotation(l), overlaprecv(m)%from_contact(l))
 
 5882                          count = domain%update_T%recv(nrecv2)%count
 
 5891     if(nrecv2 .NE. nrecv) 
call mpp_error(fatal, &
 
 5892     "mpp_domains_define.inc(define_contact_point): nrecv2 does not equal to nrecv")
 
 5895        call deallocate_overlap_type(overlapsend(m))
 
 5896        call deallocate_overlap_type(overlaprecv(m))
 
 5900        deallocate(econt(n)%tile, wcont(n)%tile, scont(n)%tile, ncont(n)%tile )
 
 5901        deallocate(econt(n)%align1, wcont(n)%align1, scont(n)%align1, ncont(n)%align1)
 
 5902        deallocate(econt(n)%align2, wcont(n)%align2, scont(n)%align2, ncont(n)%align2)
 
 5903        deallocate(econt(n)%refine1, wcont(n)%refine1, scont(n)%refine1, ncont(n)%refine1)
 
 5904        deallocate(econt(n)%refine2, wcont(n)%refine2, scont(n)%refine2, ncont(n)%refine2)
 
 5905        deallocate(econt(n)%is1, econt(n)%ie1, econt(n)%js1, econt(n)%je1 )
 
 5906        deallocate(econt(n)%is2, econt(n)%ie2, econt(n)%js2, econt(n)%je2 )
 
 5907        deallocate(wcont(n)%is1, wcont(n)%ie1, wcont(n)%js1, wcont(n)%je1 )
 
 5908        deallocate(wcont(n)%is2, wcont(n)%ie2, wcont(n)%js2, wcont(n)%je2 )
 
 5909        deallocate(scont(n)%is1, scont(n)%ie1, scont(n)%js1, scont(n)%je1 )
 
 5910        deallocate(scont(n)%is2, scont(n)%ie2, scont(n)%js2, scont(n)%je2 )
 
 5911        deallocate(ncont(n)%is1, ncont(n)%ie1, ncont(n)%js1, ncont(n)%je1 )
 
 5912        deallocate(ncont(n)%is2, ncont(n)%ie2, ncont(n)%js2, ncont(n)%je2 )
 
 5915     domain%initialized = .true.
 
 5922 subroutine fill_contact(Contact, tile, is1, ie1, js1, je1, is2, ie2, js2, je2, align1, align2, refine1, refine2 )
 
 5923   type(contact_type), 
intent(inout) :: Contact
 
 5924   integer,            
intent(in)    :: tile
 
 5925   integer,            
intent(in)    :: is1, ie1, js1, je1
 
 5926   integer,            
intent(in)    :: is2, ie2, js2, je2
 
 5927   integer,            
intent(in)    :: align1, align2
 
 5928   real,               
intent(in)    :: refine1, refine2
 
 5931   do pos = 1, contact%ncontact
 
 5934         if( js1 < contact%js1(pos) ) 
exit 
 5936         if( is1 < contact%is1(pos) ) 
exit 
 5940   contact%ncontact = contact%ncontact + 1
 
 5941   do n = contact%ncontact, pos+1, -1  
 
 5942      contact%tile(n)   = contact%tile(n-1)
 
 5943      contact%align1(n) = contact%align1(n-1)
 
 5944      contact%align2(n) = contact%align2(n-1)
 
 5945      contact%is1(n) = contact%is1(n-1); contact%ie1(n) = contact%ie1(n-1)
 
 5946      contact%js1(n) = contact%js1(n-1); contact%je1(n) = contact%je1(n-1)
 
 5947      contact%is2(n) = contact%is2(n-1); contact%ie2(n) = contact%ie2(n-1)
 
 5948      contact%js2(n) = contact%js2(n-1); contact%je2(n) = contact%je2(n-1)
 
 5951   contact%tile(pos)    = tile
 
 5952   contact%align1(pos)  = align1
 
 5953   contact%align2(pos)  = align2
 
 5954   contact%refine1(pos) = refine1
 
 5955   contact%refine2(pos) = refine2
 
 5956   contact%is1(pos) = is1; contact%ie1(pos) = ie1
 
 5957   contact%js1(pos) = js1; contact%je1(pos) = je1
 
 5958   contact%is2(pos) = is2; contact%ie2(pos) = ie2
 
 5959   contact%js2(pos) = js2; contact%je2(pos) = je2
 
 5966   type(domain2d), 
intent(inout) :: domain
 
 5967   integer,           
intent(in) :: position
 
 5969   integer                         :: ishift, jshift, nlist, list, m, n
 
 5970   integer                         :: ntileMe, tMe, dir, count, pos, nsend, nrecv
 
 5971   integer                         :: isoff1, ieoff1, jsoff1, jeoff1
 
 5972   type(overlap_type),  
pointer    :: ptrIn  => null()
 
 5973   type(overlapspec),   
pointer    :: update_in  => null()
 
 5974   type(overlapspec),   
pointer    :: update_out => null()
 
 5975   type(overlap_type)              :: overlapList(0:size(domain%list(:))-1)
 
 5976   type(overlap_type)              :: overlap
 
 5979   update_in => domain%update_T
 
 5980   select case(position)
 
 5982      update_out => domain%update_C
 
 5984      update_out => domain%update_E
 
 5986      update_out => domain%update_N
 
 5988      call mpp_error(fatal, 
"mpp_domains_define.inc(set_contact_point): the position should be CORNER, EAST or NORTH")
 
 5991   update_out%xbegin = update_in%xbegin; update_out%xend = update_in%xend + ishift
 
 5992   update_out%ybegin = update_in%ybegin; update_out%yend = update_in%yend + jshift
 
 5993   update_out%whalo  = update_in%whalo;  update_out%ehalo  = update_in%ehalo
 
 5994   update_out%shalo  = update_in%shalo;  update_out%nhalo  = update_in%nhalo
 
 5996   nlist = 
size(domain%list(:))
 
 5997   ntileme = 
size(domain%x(:))
 
 5998   call allocate_update_overlap(overlap, maxoverlap)
 
 6000      call init_overlap_type(overlaplist(m))
 
 6004   nsend = update_out%nsend
 
 6006      pos = update_out%send(m)%pe - mpp_root_pe()
 
 6007      call add_update_overlap(overlaplist(pos), update_out%send(m))
 
 6008      call deallocate_overlap_type(update_out%send(m))
 
 6010   if(
ASSOCIATED(update_out%send) )
deallocate(update_out%send)
 
 6013   nsend = update_in%nsend
 
 6015      ptrin  => update_in%send(m)
 
 6016      pos  = ptrin%pe - mpp_root_pe()
 
 6017      do n = 1, ptrin%count
 
 6020         if(ptrin%from_contact(n)) 
then 
 6023               select case(ptrin%rotation(n))
 
 6025                  isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = jshift
 
 6027                  isoff1 = 0;      ieoff1 = jshift; jsoff1 = ishift; jeoff1 = ishift
 
 6030               select case(ptrin%rotation(n))
 
 6032                  isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
 
 6034                  isoff1 = jshift; ieoff1 = jshift; jsoff1 = ishift; jeoff1 = ishift
 
 6036                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
 
 6039               select case(ptrin%rotation(n))
 
 6041                  isoff1 = 0;      ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
 
 6043                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = ishift
 
 6046               select case(ptrin%rotation(n))
 
 6048                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
 
 6050                  isoff1 = jshift; ieoff1 = jshift; jsoff1 = 0;      jeoff1 = 0
 
 6052                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = ishift; jeoff1 = ishift
 
 6055               select case(ptrin%rotation(n))
 
 6057                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = jshift
 
 6059                  isoff1 = 0;      ieoff1 = jshift; jsoff1 = 0;      jeoff1 = 0
 
 6062               select case(ptrin%rotation(n))
 
 6064                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = jshift; jeoff1 = jshift
 
 6066                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
 
 6068                  isoff1 = jshift; ieoff1 = jshift; jsoff1 = ishift; jeoff1 = ishift
 
 6071               select case(ptrin%rotation(n))
 
 6073                  isoff1 = 0;      ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
 
 6075                  isoff1 = jshift; ieoff1 = jshift; jsoff1 = 0;      jeoff1 = ishift
 
 6078               select case(ptrin%rotation(n))
 
 6080                  isoff1 = ishift; ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
 
 6082                  isoff1 = 0;      ieoff1 = 0;      jsoff1 = ishift; jeoff1 = ishift
 
 6084                  isoff1 = jshift; ieoff1 = jshift; jsoff1 = 0;      jeoff1 = 0
 
 6087            call insert_overlap_type(overlap, ptrin%pe, ptrin%tileMe(n), ptrin%tileNbr(n), &
 
 6088                                              ptrin%is(n) + isoff1, ptrin%ie(n) + ieoff1, ptrin%js(n) + jsoff1, &
 
 6089                 ptrin%je(n) + jeoff1, ptrin%dir(n), ptrin%rotation(n), ptrin%from_contact(n))
 
 6092      if(overlap%count > 0) 
then 
 6093         call add_update_overlap(overlaplist(pos), overlap)
 
 6094         call init_overlap_type(overlap)
 
 6099   do list = 0, nlist-1
 
 6100      m = mod( domain%pos+list, nlist )
 
 6101      if(overlaplist(m)%count>0) nsend = nsend+1
 
 6104   update_out%nsend = nsend
 
 6106    if (
associated(update_out%send)) 
deallocate(update_out%send) 
 
 6107      allocate(update_out%send(nsend))
 
 6109      do list = 0, nlist-1
 
 6110         m = mod( domain%pos+list, nlist )
 
 6111         if(overlaplist(m)%count>0) 
then 
 6113            if(pos>nsend) 
call mpp_error(fatal, &
 
 6114                 "mpp_domains_define.inc(set_contact_point): pos should be no larger than nsend")
 
 6115            call add_update_overlap(update_out%send(pos), overlaplist(m))
 
 6116            call deallocate_overlap_type(overlaplist(m))
 
 6119      if(pos .NE. nsend) 
call mpp_error(fatal, &
 
 6120           "mpp_domains_define.inc(set_contact_point): pos should equal to nsend")
 
 6126   nrecv = update_out%nrecv
 
 6128      pos = update_out%recv(m)%pe - mpp_root_pe()
 
 6129      call add_update_overlap(overlaplist(pos), update_out%recv(m))
 
 6130      call deallocate_overlap_type(update_out%recv(m))
 
 6132   if(
ASSOCIATED(update_out%recv) )
deallocate(update_out%recv)
 
 6135   nrecv = update_in%nrecv
 
 6137      ptrin  => update_in%recv(m)
 
 6138      pos  = ptrin%pe - mpp_root_pe()
 
 6139      do n = 1, ptrin%count
 
 6142         if(ptrin%from_contact(n)) 
then 
 6145               isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = jshift
 
 6147               isoff1 = ishift; ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
 
 6149               isoff1 = 0;      ieoff1 = ishift; jsoff1 = 0;      jeoff1 = 0
 
 6151               isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = 0
 
 6153               isoff1 = 0;      ieoff1 = 0;      jsoff1 = 0;      jeoff1 = jshift
 
 6155               isoff1 = 0;       ieoff1 = 0;      jsoff1 = jshift; jeoff1 = jshift
 
 6157               isoff1 = 0;      ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
 
 6159               isoff1 = ishift; ieoff1 = ishift; jsoff1 = jshift; jeoff1 = jshift
 
 6161            call insert_overlap_type(overlap, ptrin%pe, ptrin%tileMe(n), ptrin%tileNbr(n), &
 
 6162                                              ptrin%is(n) + isoff1, ptrin%ie(n) + ieoff1, ptrin%js(n) + jsoff1, &
 
 6163                 ptrin%je(n) + jeoff1, ptrin%dir(n), ptrin%rotation(n), ptrin%from_contact(n))
 
 6164            count                     = overlap%count
 
 6167      if(overlap%count > 0) 
then 
 6168         call add_update_overlap(overlaplist(pos), overlap)
 
 6169         call init_overlap_type(overlap)
 
 6171      do tme = 1, 
size(domain%x(:))
 
 6172         do n = 1, overlap%count
 
 6173            if(overlap%tileMe(n) == tme) 
then 
 6174               if(overlap%dir(n) == 1 ) domain%x(tme)%loffset = 0
 
 6175               if(overlap%dir(n) == 7 ) domain%y(tme)%loffset = 0
 
 6182   do list = 0, nlist-1
 
 6183      m = mod( domain%pos+nlist-list, nlist )
 
 6184      if(overlaplist(m)%count>0) nrecv = nrecv+1
 
 6187   update_out%nrecv = nrecv
 
 6189    if (
associated(update_out%recv)) 
deallocate(update_out%recv) 
 
 6190      allocate(update_out%recv(nrecv))
 
 6192      do list = 0, nlist-1
 
 6193         m = mod( domain%pos+nlist-list, nlist )
 
 6194         if(overlaplist(m)%count>0) 
then 
 6196            if(pos>nrecv) 
call mpp_error(fatal, &
 
 6197                 "mpp_domains_define.inc(set_contact_point): pos should be no larger than nrecv")
 
 6198            call  add_update_overlap(update_out%recv(pos), overlaplist(m))
 
 6199            call deallocate_overlap_type(overlaplist(m))
 
 6202      if(pos .NE. nrecv) 
call mpp_error(fatal, &
 
 6203           "mpp_domains_define.inc(set_contact_point): pos should equal to nrecv")
 
 6206   call deallocate_overlap_type(overlap)
 
 6214 type(domain2d),    
intent(in) :: domain
 
 6215 integer,           
intent(in) :: position
 
 6216 integer                       :: nlist, m, n
 
 6217 integer, 
parameter            :: MAXCOUNT = 100
 
 6218 integer                       :: is, ie, js, je
 
 6219 integer                       :: nsend, nrecv, pos, maxsize, rotation
 
 6220 type(overlap_type)            :: overlap
 
 6221 type(overlapspec),   
pointer  :: update  => null()
 
 6222 type(overlapspec),   
pointer  :: check   => null()
 
 6224 select case(position)
 
 6226    update => domain%update_C
 
 6227    check  => domain%check_C
 
 6229    update => domain%update_E
 
 6230    check  => domain%check_E
 
 6232    update => domain%update_N
 
 6233    check  => domain%check_N
 
 6235    call mpp_error(fatal, 
"mpp_domains_define.inc(set_check_overlap): position should be CORNER, EAST or NORTH")
 
 6238 check%xbegin = update%xbegin; check%xend = update%xend
 
 6239 check%ybegin = update%ybegin; check%yend = update%yend
 
 6242 if( .NOT. domain%symmetry ) 
return 
 6246 do m = 1, update%nsend
 
 6247     do n = 1, update%send(m)%count
 
 6248        if( update%send(m)%rotation(n) == one_hundred_eighty ) cycle
 
 6249        if( ( (position == east .OR. position == corner) .AND. update%send(m)%dir(n) == 1 ) .OR. &
 
 6250             ( (position == north .OR. position == corner) .AND. update%send(m)%dir(n) == 7 ) ) 
then 
 6251             maxsize = max(maxsize, update%send(m)%count)
 
 6259    if (
associated(check%send)) 
deallocate(check%send) 
 
 6260    allocate(check%send(nsend))
 
 6261    call allocate_check_overlap(overlap, maxsize)
 
 6265 nlist = 
size(domain%list(:))
 
 6268 do m = 1, update%nsend
 
 6269  do n = 1, update%send(m)%count
 
 6270     if( update%send(m)%rotation(n) == one_hundred_eighty ) cycle
 
 6272     if( (position == east .OR. position == corner) .AND. update%send(m)%dir(n) == 1 ) 
then 
 6273        rotation = update%send(m)%rotation(n)
 
 6274        select case( rotation )
 
 6276           is = update%send(m)%is(n) - 1
 
 6278           js = update%send(m)%js(n)
 
 6279           je = update%send(m)%je(n)
 
 6281           is = update%send(m)%is(n)
 
 6282           ie = update%send(m)%ie(n)
 
 6283           js = update%send(m)%js(n) - 1
 
 6286        call insert_check_overlap(overlap, update%send(m)%pe, &
 
 6287                                  update%send(m)%tileMe(n), 1, rotation, is, ie, js, je)
 
 6291     if( (position == north .OR. position == corner) .AND. update%send(m)%dir(n) == 7 ) 
then 
 6292        rotation = update%send(m)%rotation(n)
 
 6293        select case( rotation )
 
 6295           is = update%send(m)%is(n)
 
 6296           ie = update%send(m)%ie(n)
 
 6297           js = update%send(m)%js(n) - 1
 
 6299        case( minus_ninety ) 
 
 6300           is = update%send(m)%is(n) - 1
 
 6302           js = update%send(m)%js(n)
 
 6303           je = update%send(m)%je(n)
 
 6305        call insert_check_overlap(overlap, update%send(m)%pe, &
 
 6306             update%send(m)%tileMe(n), 4, rotation, is, ie, js, je)
 
 6309  if(overlap%count>0) 
then 
 6311    if(pos>nsend)
call mpp_error(fatal, 
"mpp_domains_define.inc(set_check_overlap): pos is greater than nsend")
 
 6313    call init_overlap_type(overlap)
 
 6317 if(pos .NE. nsend)
call mpp_error(fatal, 
"mpp_domains_define.inc(set_check_overlap): pos is greater than nsend")
 
 6321 do m = 1, update%nrecv
 
 6322     do n = 1, update%recv(m)%count
 
 6323        if( update%recv(m)%rotation(n) == one_hundred_eighty ) cycle
 
 6324        if( ( (position == east .OR. position == corner) .AND. update%recv(m)%dir(n) == 1 ) .OR. &
 
 6325             ( (position == north .OR. position == corner) .AND. update%recv(m)%dir(n) == 7 ) ) 
then 
 6326             maxsize = max(maxsize, update%recv(m)%count)
 
 6333 if(nsend>0) 
call deallocate_overlap_type(overlap)
 
 6336    if (
associated(check%recv)) 
deallocate(check%recv) 
 
 6337    allocate(check%recv(nrecv))
 
 6338    call allocate_check_overlap(overlap, maxsize)
 
 6342 do m = 1, update%nrecv
 
 6343  do n = 1, update%recv(m)%count
 
 6344     if( update%recv(m)%rotation(n) == one_hundred_eighty ) cycle
 
 6345     if( (position == east .OR. position == corner) .AND. update%recv(m)%dir(n) == 1 ) 
then 
 6346        is = update%recv(m)%is(n) - 1
 
 6348        js = update%recv(m)%js(n)
 
 6349        je = update%recv(m)%je(n)
 
 6350        call insert_check_overlap(overlap, update%recv(m)%pe, &
 
 6351                                  update%recv(m)%tileMe(n), 1, update%recv(m)%rotation(n), is, ie, js, je)
 
 6353     if( (position == north .OR. position == corner) .AND. update%recv(m)%dir(n) == 7 ) 
then 
 6354        is = update%recv(m)%is(n)
 
 6355        ie = update%recv(m)%ie(n)
 
 6356        js = update%recv(m)%js(n) - 1
 
 6358        call insert_check_overlap(overlap, update%recv(m)%pe, &
 
 6359             update%recv(m)%tileMe(n), 3, update%recv(m)%rotation(n), is, ie, js, je)
 
 6362  if(overlap%count>0) 
then 
 6364    if(pos>nrecv)
call mpp_error(fatal, 
"mpp_domains_define.inc(set_check_overlap): pos is greater than nrecv")
 
 6366    call init_overlap_type(overlap)
 
 6370 if(pos .NE. nrecv)
call mpp_error(fatal, 
"mpp_domains_define.inc(set_check_overlap): pos is greater than nrecv")
 
 6371 if(nrecv>0) 
call deallocate_overlap_type(overlap)
 
 6378   type(domain2d), 
intent(inout) :: domain
 
 6379   integer,        
intent(in)    :: position
 
 6380   integer                       :: m, n, l, count, dr, tMe
 
 6381   integer, 
parameter            :: MAXCOUNT = 100
 
 6382   integer, 
dimension(MAXCOUNT)  :: dir, rotation, is, ie, js, je, tileMe, index
 
 6383   integer, 
dimension(size(domain%x(:)), 4)           :: nrecvl
 
 6384   integer, 
dimension(size(domain%x(:)), 4, MAXCOUNT) :: isl, iel, jsl, jel
 
 6385   type(overlap_type),  
pointer   :: overlap => null()
 
 6386   type(overlapspec),   
pointer   :: update => null()
 
 6387   type(overlapspec),   
pointer   :: bound => null()
 
 6388   integer                        :: nlist_send, nlist_recv, ishift, jshift
 
 6389   integer                        :: ism, iem, jsm, jem, nsend, nrecv
 
 6390   integer                        :: isg, ieg, jsg, jeg, nlist, list
 
 6391   integer                        :: npes_x, npes_y, ipos, jpos, inbr, jnbr
 
 6392   integer                        :: isc, iec, jsc, jec, my_pe
 
 6393   integer                        :: pe_south1, pe_south2, pe_west0, pe_west1, pe_west2
 
 6394   integer                        :: is_south1, ie_south1, js_south1, je_south1
 
 6395   integer                        :: is_south2, ie_south2, js_south2, je_south2
 
 6396   integer                        :: is_west0, ie_west0, js_west0, je_west0
 
 6397   integer                        :: is_west1, ie_west1, js_west1, je_west1
 
 6398   integer                        :: is_west2, ie_west2, js_west2, je_west2
 
 6399   logical                        :: x_cyclic, y_cyclic, folded_north
 
 6401   is_south1=0; ie_south1=0; js_south1=0; je_south1=0
 
 6402   is_south2=0; ie_south2=0; js_south2=0; je_south2=0
 
 6403   is_west0=0; ie_west0=0; js_west0=0; je_west0=0
 
 6404   is_west1=0; ie_west1=0; js_west1=0; je_west1=0
 
 6405   is_west2=0; ie_west2=0; js_west2=0; je_west2=0
 
 6408   if( position == center .OR. .NOT. domain%symmetry ) 
return 
 6410   call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)
 
 6411   call mpp_get_memory_domain ( domain, ism, iem, jsm, jem )
 
 6413   select case(position)
 
 6415      update => domain%update_C
 
 6416      bound  => domain%bound_C
 
 6418      update => domain%update_E
 
 6419      bound  => domain%bound_E
 
 6421      update => domain%update_N
 
 6422      bound  => domain%bound_N
 
 6424      call mpp_error( fatal, 
"mpp_domains_mod(set_bound_overlap): invalid option of position")
 
 6427   bound%xbegin = ism; bound%xend = iem + ishift
 
 6428   bound%ybegin = jsm; bound%yend = jem + jshift
 
 6430   nlist_send = max(update%nsend,4)
 
 6431   nlist_recv = max(update%nrecv,4)
 
 6432   bound%nsend = nlist_send
 
 6433   bound%nrecv = nlist_recv
 
 6434   if(nlist_send >0) 
then 
 6435    if (
associated(bound%send)) 
deallocate(bound%send) 
 
 6436      allocate(bound%send(nlist_send))
 
 6437      bound%send(:)%count = 0
 
 6439   if(nlist_recv >0) 
then 
 6440    if (
associated(bound%recv)) 
deallocate(bound%recv) 
 
 6441      allocate(bound%recv(nlist_recv))
 
 6442      bound%recv(:)%count = 0
 
 6445   nlist = 
size(domain%list(:))
 
 6447   npes_x = 
size(domain%x(1)%list(:))
 
 6448   npes_y = 
size(domain%y(1)%list(:))
 
 6449   x_cyclic = domain%x(1)%cyclic
 
 6450   y_cyclic = domain%y(1)%cyclic
 
 6451   folded_north = btest(domain%fold,north)
 
 6452   ipos = domain%x(1)%pos
 
 6453   jpos = domain%y(1)%pos
 
 6454   isc  = domain%x(1)%compute%begin; iec = domain%x(1)%compute%end
 
 6455   jsc  = domain%y(1)%compute%begin; jec = domain%y(1)%compute%end
 
 6458   if(domain%ntiles == 1) 
then   
 6462      pe_south1 = null_pe; pe_south2 = null_pe
 
 6463      if( position == north .OR. position == corner ) 
then 
 6464         inbr = ipos; jnbr = jpos + 1
 
 6465         if( jnbr == npes_y .AND. y_cyclic) jnbr = 0
 
 6466         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6467            pe_south1 = domain%pearray(inbr,jnbr)
 
 6468            is_south1 = isc + ishift; ie_south1 = iec+ishift
 
 6469            js_south1 = jec + jshift; je_south1 = js_south1
 
 6473      if( position == corner ) 
then 
 6474         inbr = ipos + 1; jnbr = jpos + 1
 
 6475         if( inbr == npes_x .AND. x_cyclic) inbr = 0
 
 6476         if( jnbr == npes_y .AND. y_cyclic) jnbr = 0
 
 6477         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6478            pe_south2 = domain%pearray(inbr,jnbr)
 
 6479            is_south2 = iec + ishift; ie_south2 = is_south2
 
 6480            js_south2 = jec + jshift; je_south2 = js_south2
 
 6485      pe_west0 = null_pe; pe_west1 = null_pe; pe_west2 = null_pe
 
 6486      if( position == east ) 
then 
 6487         inbr = ipos+1; jnbr = jpos
 
 6488         if( inbr == npes_x .AND. x_cyclic) inbr = 0
 
 6489         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6490            pe_west1 = domain%pearray(inbr,jnbr)
 
 6491            is_west1 = iec + ishift; ie_west1 = is_west1
 
 6492            js_west1 = jsc + jshift; je_west1 = jec + jshift
 
 6494      else if ( position == corner ) 
then   
 6496         if( folded_north .AND. jec == jeg .AND. ipos .LT. (npes_x-1)/2 ) 
then 
 6497            inbr = npes_x - ipos - 1; jnbr = jpos
 
 6498            if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6499                pe_west0 = domain%pearray(inbr,jnbr)
 
 6500                is_west0 = iec+ishift; ie_west0 = is_west0
 
 6501                js_west0 = jec+jshift; je_west0 = js_west0
 
 6505         if( folded_north .AND. jec == jeg .AND. ipos .GE. npes_x/2 .AND. ipos .LT. (npes_x-1) ) 
then 
 6506            inbr = ipos+1; jnbr = jpos
 
 6507            if( inbr == npes_x .AND. x_cyclic) inbr = 0
 
 6508            if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6509               pe_west1 = domain%pearray(inbr,jnbr)
 
 6510               is_west1 = iec + ishift; ie_west1 = is_west1
 
 6511               js_west1 = jsc + jshift; je_west1 = jec
 
 6514            inbr = ipos+1; jnbr = jpos
 
 6515            if( inbr == npes_x .AND. x_cyclic) inbr = 0
 
 6516            if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6517               pe_west1 = domain%pearray(inbr,jnbr)
 
 6518               is_west1 = iec + ishift; ie_west1 = is_west1
 
 6519               js_west1 = jsc + jshift; je_west1 = jec + jshift
 
 6524      if( position == corner ) 
then 
 6525         inbr = ipos + 1; jnbr = jpos + 1
 
 6526         if( inbr == npes_x .AND. x_cyclic) inbr = 0
 
 6527         if( jnbr == npes_y .AND. y_cyclic) jnbr = 0
 
 6528         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6529            pe_west2 = domain%pearray(inbr,jnbr)
 
 6530            is_west2 = iec + ishift; ie_west2 = is_west2
 
 6531            js_west2 = jec + jshift; je_west2 = js_west2
 
 6536         m = mod( domain%pos+list, nlist )
 
 6538         my_pe = domain%list(m)%pe
 
 6539         if(my_pe == pe_south1) 
then 
 6541            is(count) = is_south1; ie(count) = ie_south1
 
 6542            js(count) = js_south1; je(count) = je_south1
 
 6544            rotation(count) = zero
 
 6546         if(my_pe == pe_south2) 
then 
 6548            is(count) = is_south2; ie(count) = ie_south2
 
 6549            js(count) = js_south2; je(count) = je_south2
 
 6551            rotation(count) = zero
 
 6554         if(my_pe == pe_west0) 
then 
 6556            is(count) = is_west0; ie(count) = ie_west0
 
 6557            js(count) = js_west0; je(count) = je_west0
 
 6559            rotation(count) = one_hundred_eighty
 
 6561         if(my_pe == pe_west1) 
then 
 6563            is(count) = is_west1; ie(count) = ie_west1
 
 6564            js(count) = js_west1; je(count) = je_west1
 
 6566            rotation(count) = zero
 
 6568         if(my_pe == pe_west2) 
then 
 6570            is(count) = is_west2; ie(count) = ie_west2
 
 6571            js(count) = js_west2; je(count) = je_west2
 
 6573            rotation(count) = zero
 
 6578            if(nsend > nlist_send)  
call mpp_error(fatal, 
"set_bound_overlap: nsend > nlist_send")
 
 6579            bound%send(nsend)%count = count
 
 6580            bound%send(nsend)%pe    = my_pe
 
 6581            if (
associated(bound%send(nsend)%is)) 
deallocate(bound%send(nsend)%is) 
 
 6582            if (
associated(bound%send(nsend)%ie)) 
deallocate(bound%send(nsend)%ie) 
 
 6583            if (
associated(bound%send(nsend)%js)) 
deallocate(bound%send(nsend)%js) 
 
 6584            if (
associated(bound%send(nsend)%je)) 
deallocate(bound%send(nsend)%je) 
 
 6585            if (
associated(bound%send(nsend)%dir)) 
deallocate(bound%send(nsend)%dir) 
 
 6586            if (
associated(bound%send(nsend)%rotation)) 
deallocate(bound%send(nsend)%rotation) 
 
 6587            if (
associated(bound%send(nsend)%tileMe)) 
deallocate(bound%send(nsend)%tileMe) 
 
 6588            allocate(bound%send(nsend)%is(count),  bound%send(nsend)%ie(count) )
 
 6589            allocate(bound%send(nsend)%js(count),  bound%send(nsend)%je(count) )
 
 6590            allocate(bound%send(nsend)%dir(count), bound%send(nsend)%rotation(count) )
 
 6591            allocate(bound%send(nsend)%tileMe(count))
 
 6592            bound%send(nsend)%is(:)       = is(1:count)
 
 6593            bound%send(nsend)%ie(:)       = ie(1:count)
 
 6594            bound%send(nsend)%js(:)       = js(1:count)
 
 6595            bound%send(nsend)%je(:)       = je(1:count)
 
 6596            bound%send(nsend)%dir(:)      = dir(1:count)
 
 6597            bound%send(nsend)%tileMe(:)   = 1
 
 6598            bound%send(nsend)%rotation(:) = rotation(1:count)
 
 6603      do m = 1, update%nsend
 
 6604         overlap => update%send(m)
 
 6605         if( overlap%count == 0 ) cycle
 
 6607         do n = 1, overlap%count
 
 6609            if( overlap%rotation(n) == one_hundred_eighty ) cycle
 
 6610            if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 1) 
then  
 6613               rotation(count) = overlap%rotation(n)
 
 6614               tileme(count)   = overlap%tileMe(n)
 
 6615               select case( rotation(count) )
 
 6617                  is(count) = overlap%is(n) - 1
 
 6618                  ie(count) = is(count)
 
 6619                  js(count) = overlap%js(n)
 
 6620                  je(count) = overlap%je(n)
 
 6622                  is(count) = overlap%is(n)
 
 6623                  ie(count) = overlap%ie(n)
 
 6624                  js(count) = overlap%js(n) - 1
 
 6625                  je(count) = js(count)
 
 6628            if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 3 ) 
then  
 6631               rotation(count) = overlap%rotation(n)
 
 6632               tileme(count)   = overlap%tileMe(n)
 
 6633               select case( rotation(count) )
 
 6635                  is(count) = overlap%is(n)
 
 6636                  ie(count) = overlap%ie(n)
 
 6637                  js(count) = overlap%je(n) + 1
 
 6638                  je(count) = js(count)
 
 6639               case( minus_ninety ) 
 
 6640                  is(count) = overlap%ie(n) + 1
 
 6641                  ie(count) = is(count)
 
 6642                  js(count) = overlap%js(n)
 
 6643                  je(count) = overlap%je(n)
 
 6646            if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 5 ) 
then  
 6649               rotation(count) = overlap%rotation(n)
 
 6650               tileme(count) = overlap%tileMe(n)
 
 6651               select case( rotation(count) )
 
 6653                  is(count) = overlap%ie(n) + 1
 
 6654                  ie(count) = is(count)
 
 6655                  js(count) = overlap%js(n)
 
 6656                  je(count) = overlap%je(n)
 
 6658                  is(count) = overlap%is(n)
 
 6659                  ie(count) = overlap%ie(n)
 
 6660                  js(count) = overlap%je(n) + 1
 
 6661                  je(count) = js(count)
 
 6664            if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 7 ) 
then  
 6667               rotation(count) = overlap%rotation(n)
 
 6668               tileme(count) = overlap%tileMe(n)
 
 6669               select case( rotation(count) )
 
 6671                  is(count) = overlap%is(n)
 
 6672                  ie(count) = overlap%ie(n)
 
 6673                  js(count) = overlap%js(n) - 1
 
 6674                  je(count) = js(count)
 
 6675               case( minus_ninety ) 
 
 6676                  is(count) = overlap%is(n) - 1
 
 6677                  ie(count) = is(count)
 
 6678                  js(count) = overlap%js(n)
 
 6679                  je(count) = overlap%je(n)
 
 6685         bound%send(nsend)%count = count
 
 6686         bound%send(nsend)%pe    = overlap%pe
 
 6687         if (
associated(bound%send(nsend)%is)) 
deallocate(bound%send(nsend)%is) 
 
 6688         if (
associated(bound%send(nsend)%ie)) 
deallocate(bound%send(nsend)%ie) 
 
 6689         if (
associated(bound%send(nsend)%js)) 
deallocate(bound%send(nsend)%js) 
 
 6690         if (
associated(bound%send(nsend)%je)) 
deallocate(bound%send(nsend)%je) 
 
 6691         if (
associated(bound%send(nsend)%dir)) 
deallocate(bound%send(nsend)%dir) 
 
 6692         if (
associated(bound%send(nsend)%rotation)) 
deallocate(bound%send(nsend)%rotation) 
 
 6693         if (
associated(bound%send(nsend)%tileMe)) 
deallocate(bound%send(nsend)%tileMe) 
 
 6694         allocate(bound%send(nsend)%is(count),  bound%send(nsend)%ie(count) )
 
 6695         allocate(bound%send(nsend)%js(count),  bound%send(nsend)%je(count) )
 
 6696         allocate(bound%send(nsend)%dir(count), bound%send(nsend)%rotation(count) )
 
 6697         allocate(bound%send(nsend)%tileMe(count))
 
 6698         bound%send(nsend)%is(:)       = is(1:count)
 
 6699         bound%send(nsend)%ie(:)       = ie(1:count)
 
 6700         bound%send(nsend)%js(:)       = js(1:count)
 
 6701         bound%send(nsend)%je(:)       = je(1:count)
 
 6702         bound%send(nsend)%dir(:)      = dir(1:count)
 
 6703         bound%send(nsend)%tileMe(:)   = tileme(1:count)
 
 6704         bound%send(nsend)%rotation(:) = rotation(1:count)
 
 6715   if( domain%ntiles == 1 ) 
then 
 6719      pe_south1 = null_pe; pe_south2 = null_pe
 
 6720      if( position == north .OR. position == corner ) 
then 
 6721         inbr = ipos; jnbr = jpos - 1
 
 6722         if( jnbr == -1 .AND. y_cyclic) jnbr = npes_y-1
 
 6723         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6724            pe_south1 = domain%pearray(inbr,jnbr)
 
 6725            is_south1 = isc + ishift; ie_south1 = iec+ishift
 
 6726            js_south1 = jsc;          je_south1 = js_south1
 
 6731      if( position == corner ) 
then 
 6732         inbr = ipos - 1; jnbr = jpos - 1
 
 6733         if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
 
 6734         if( jnbr == -1 .AND. y_cyclic) jnbr = npes_y-1
 
 6735         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6736            pe_south2 = domain%pearray(inbr,jnbr)
 
 6737            is_south2 = isc; ie_south2 = is_south2
 
 6738            js_south2 = jsc; je_south2 = js_south2
 
 6744      pe_west0 = null_pe; pe_west1 = null_pe; pe_west2 = null_pe
 
 6745      if( position == east ) 
then 
 6746         inbr = ipos-1; jnbr = jpos
 
 6747         if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
 
 6748         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6749            pe_west1 = domain%pearray(inbr,jnbr)
 
 6750            is_west1 = isc;          ie_west1 = is_west1
 
 6751            js_west1 = jsc + jshift; je_west1 = jec + jshift
 
 6753      else if ( position == corner ) 
then   
 6755         if( folded_north .AND. jec == jeg .AND. ipos .GT. npes_x/2 ) 
then 
 6756            inbr = npes_x - ipos - 1; jnbr = jpos
 
 6757            if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6758                pe_west0 = domain%pearray(inbr,jnbr)
 
 6759                is_west0 = isc;        ie_west0 = is_west0
 
 6760                js_west0 = jec+jshift; je_west0 = js_west0
 
 6762            inbr = ipos-1; jnbr = jpos
 
 6763            if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
 
 6764            if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6765               pe_west1 = domain%pearray(inbr,jnbr)
 
 6766               is_west1 = isc;          ie_west1 = is_west1
 
 6767               js_west1 = jsc + jshift; je_west1 = jec
 
 6770            inbr = ipos-1; jnbr = jpos
 
 6771            if( inbr == -1 .AND. x_cyclic) inbr = npes_x-1
 
 6772            if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6773               pe_west1 = domain%pearray(inbr,jnbr)
 
 6774               is_west1 = isc;          ie_west1 = is_west1
 
 6775               js_west1 = jsc + jshift; je_west1 = jec+jshift
 
 6781      if( position == corner ) 
then 
 6782         inbr = ipos - 1; jnbr = jpos - 1
 
 6783         if( inbr == -1 .AND. x_cyclic) inbr = npes_x - 1
 
 6784         if( jnbr == -1 .AND. y_cyclic) jnbr = npes_y - 1
 
 6785         if( inbr .GE. 0 .AND. inbr .LT. npes_x .AND. jnbr .GE. 0 .AND. jnbr .LT. npes_y ) 
then 
 6786            pe_west2 = domain%pearray(inbr,jnbr)
 
 6787            is_west2 = isc; ie_west2 = is_west2
 
 6788            js_west2 = jsc; je_west2 = js_west2
 
 6794         m = mod( domain%pos+nlist-list, nlist )
 
 6796         my_pe = domain%list(m)%pe
 
 6797         if(my_pe == pe_south1) 
then 
 6799            is(count) = is_south1; ie(count) = ie_south1
 
 6800            js(count) = js_south1; je(count) = je_south1
 
 6802            rotation(count) = zero
 
 6803            index(count) = 1 + ishift
 
 6805         if(my_pe == pe_south2) 
then 
 6807            is(count) = is_south2; ie(count) = ie_south2
 
 6808            js(count) = js_south2; je(count) = je_south2
 
 6810            rotation(count) = zero
 
 6813         if(my_pe == pe_west0) 
then 
 6815            is(count) = is_west0; ie(count) = ie_west0
 
 6816            js(count) = js_west0; je(count) = je_west0
 
 6818            rotation(count) = one_hundred_eighty
 
 6819            index(count) = jec-jsc+1+jshift
 
 6821         if(my_pe == pe_west1) 
then 
 6823            is(count) = is_west1; ie(count) = ie_west1
 
 6824            js(count) = js_west1; je(count) = je_west1
 
 6826            rotation(count) = zero
 
 6827            index(count) = 1 + jshift
 
 6829         if(my_pe == pe_west2) 
then 
 6831            is(count) = is_west2; ie(count) = ie_west2
 
 6832            js(count) = js_west2; je(count) = je_west2
 
 6834            rotation(count) = zero
 
 6840            if(nrecv > nlist_recv) 
call mpp_error(fatal, 
"set_bound_overlap: nrecv > nlist_recv")
 
 6841            bound%recv(nrecv)%count = count
 
 6842            bound%recv(nrecv)%pe    = my_pe
 
 6843            if (
associated(bound%recv(nrecv)%is)) 
deallocate(bound%recv(nrecv)%is) 
 
 6844            if (
associated(bound%recv(nrecv)%ie)) 
deallocate(bound%recv(nrecv)%ie) 
 
 6845            if (
associated(bound%recv(nrecv)%js)) 
deallocate(bound%recv(nrecv)%js) 
 
 6846            if (
associated(bound%recv(nrecv)%je)) 
deallocate(bound%recv(nrecv)%je) 
 
 6847            if (
associated(bound%recv(nrecv)%dir)) 
deallocate(bound%recv(nrecv)%dir) 
 
 6848            if (
associated(bound%recv(nrecv)%index)) 
deallocate(bound%recv(nrecv)%index) 
 
 6849            if (
associated(bound%recv(nrecv)%tileMe)) 
deallocate(bound%recv(nrecv)%tileMe) 
 
 6850            if (
associated(bound%recv(nrecv)%rotation)) 
deallocate(bound%recv(nrecv)%rotation) 
 
 6851            allocate(bound%recv(nrecv)%is(count),     bound%recv(nrecv)%ie(count) )
 
 6852            allocate(bound%recv(nrecv)%js(count),     bound%recv(nrecv)%je(count) )
 
 6853            allocate(bound%recv(nrecv)%dir(count),    bound%recv(nrecv)%index(count)  )
 
 6854            allocate(bound%recv(nrecv)%tileMe(count), bound%recv(nrecv)%rotation(count) )
 
 6856            bound%recv(nrecv)%is(:)       = is(1:count)
 
 6857            bound%recv(nrecv)%ie(:)       = ie(1:count)
 
 6858            bound%recv(nrecv)%js(:)       = js(1:count)
 
 6859            bound%recv(nrecv)%je(:)       = je(1:count)
 
 6860            bound%recv(nrecv)%dir(:)      = dir(1:count)
 
 6861            bound%recv(nrecv)%tileMe(:)   = 1
 
 6862            bound%recv(nrecv)%rotation(:) = rotation(1:count)
 
 6863            bound%recv(nrecv)%index(:)        = index(1:count)
 
 6867      do m = 1, update%nrecv
 
 6868         overlap => update%recv(m)
 
 6869         if( overlap%count == 0 ) cycle
 
 6871         do n = 1, overlap%count
 
 6873            if( overlap%rotation(n) == one_hundred_eighty ) cycle
 
 6874            if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 1) 
then  
 6877               rotation(count) = overlap%rotation(n)
 
 6878               tileme(count)   = overlap%tileMe(n)
 
 6879               is(count) = overlap%is(n) - 1
 
 6880               ie(count) = is(count)
 
 6881               js(count) = overlap%js(n)
 
 6882               je(count) = overlap%je(n)
 
 6884               nrecvl(tme, 1) = nrecvl(tme,1) + 1
 
 6885               isl(tme,1,nrecvl(tme, 1)) = is(count)
 
 6886               iel(tme,1,nrecvl(tme, 1)) = ie(count)
 
 6887               jsl(tme,1,nrecvl(tme, 1)) = js(count)
 
 6888               jel(tme,1,nrecvl(tme, 1)) = je(count)
 
 6891            if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 3) 
then  
 6894               rotation(count) = overlap%rotation(n)
 
 6895               tileme(count)   = overlap%tileMe(n)
 
 6896               is(count) = overlap%is(n)
 
 6897               ie(count) = overlap%ie(n)
 
 6898               js(count) = overlap%je(n) + 1
 
 6899               je(count) = js(count)
 
 6901               nrecvl(tme, 2) = nrecvl(tme,2) + 1
 
 6902               isl(tme,2,nrecvl(tme, 2)) = is(count)
 
 6903               iel(tme,2,nrecvl(tme, 2)) = ie(count)
 
 6904               jsl(tme,2,nrecvl(tme, 2)) = js(count)
 
 6905               jel(tme,2,nrecvl(tme, 2)) = je(count)
 
 6908            if( (position == east .OR. position == corner) .AND. overlap%dir(n) == 5) 
then  
 6911               rotation(count) = overlap%rotation(n)
 
 6912               tileme(count)   = overlap%tileMe(n)
 
 6913               is(count) = overlap%ie(n) + 1
 
 6914               ie(count) = is(count)
 
 6915               js(count) = overlap%js(n)
 
 6916               je(count) = overlap%je(n)
 
 6918               nrecvl(tme, 3) = nrecvl(tme,3) + 1
 
 6919               isl(tme,3,nrecvl(tme, 3)) = is(count)
 
 6920               iel(tme,3,nrecvl(tme, 3)) = ie(count)
 
 6921               jsl(tme,3,nrecvl(tme, 3)) = js(count)
 
 6922               jel(tme,3,nrecvl(tme, 3)) = je(count)
 
 6925            if( (position == north .OR. position == corner) .AND. overlap%dir(n) == 7) 
then  
 6928               rotation(count) = overlap%rotation(n)
 
 6929               tileme(count) = overlap%tileMe(n)
 
 6930               is(count) = overlap%is(n)
 
 6931               ie(count) = overlap%ie(n)
 
 6932               js(count) = overlap%js(n) - 1
 
 6933               je(count) = js(count)
 
 6935               nrecvl(tme, 4) = nrecvl(tme,4) + 1
 
 6936               isl(tme,4,nrecvl(tme, 4)) = is(count)
 
 6937               iel(tme,4,nrecvl(tme, 4)) = ie(count)
 
 6938               jsl(tme,4,nrecvl(tme, 4)) = js(count)
 
 6939               jel(tme,4,nrecvl(tme, 4)) = je(count)
 
 6944            bound%recv(nrecv)%count = count
 
 6945            bound%recv(nrecv)%pe    = overlap%pe
 
 6946            if (
associated(bound%recv(nrecv)%is)) 
deallocate(bound%recv(nrecv)%is) 
 
 6947            if (
associated(bound%recv(nrecv)%ie)) 
deallocate(bound%recv(nrecv)%ie) 
 
 6948            if (
associated(bound%recv(nrecv)%js)) 
deallocate(bound%recv(nrecv)%js) 
 
 6949            if (
associated(bound%recv(nrecv)%je)) 
deallocate(bound%recv(nrecv)%je) 
 
 6950            if (
associated(bound%recv(nrecv)%dir)) 
deallocate(bound%recv(nrecv)%dir) 
 
 6951            if (
associated(bound%recv(nrecv)%index)) 
deallocate(bound%recv(nrecv)%index) 
 
 6952            if (
associated(bound%recv(nrecv)%tileMe)) 
deallocate(bound%recv(nrecv)%tileMe) 
 
 6953            if (
associated(bound%recv(nrecv)%rotation)) 
deallocate(bound%recv(nrecv)%rotation) 
 
 6954            allocate(bound%recv(nrecv)%is(count),     bound%recv(nrecv)%ie(count) )
 
 6955            allocate(bound%recv(nrecv)%js(count),     bound%recv(nrecv)%je(count) )
 
 6956            allocate(bound%recv(nrecv)%dir(count),    bound%recv(nrecv)%index(count)  )
 
 6957            allocate(bound%recv(nrecv)%tileMe(count), bound%recv(nrecv)%rotation(count) )
 
 6958            bound%recv(nrecv)%is(:)       = is(1:count)
 
 6959            bound%recv(nrecv)%ie(:)       = ie(1:count)
 
 6960            bound%recv(nrecv)%js(:)       = js(1:count)
 
 6961            bound%recv(nrecv)%je(:)       = je(1:count)
 
 6962            bound%recv(nrecv)%dir(:)      = dir(1:count)
 
 6963            bound%recv(nrecv)%tileMe(:)   = tileme(1:count)
 
 6964            bound%recv(nrecv)%rotation(:) = rotation(1:count)
 
 6969         do n = 1, bound%recv(m)%count
 
 6970            tme = bound%recv(m)%tileMe(n)
 
 6971            dr = bound%recv(m)%dir(n)
 
 6972            bound%recv(m)%index(n) = 1
 
 6973            do l = 1, nrecvl(tme,dr)
 
 6974               if(dr == 1 .OR. dr == 3) 
then   
 6975                  if( bound%recv(m)%js(n) > jsl(tme, dr, l) ) 
then 
 6976                     if( bound%recv(m)%rotation(n) == one_hundred_eighty ) 
then 
 6977                        bound%recv(m)%index(n) = bound%recv(m)%index(n)                  + &
 
 6978                             max(abs(jel(tme, dr, l)-jsl(tme, dr, l))+1, &
 
 6979                             abs(iel(tme, dr, l)-isl(tme, dr, l))+1)
 
 6981                        bound%recv(m)%index(n) = bound%recv(m)%index(n)                  + &
 
 6982                             max(abs(jel(tme, dr, l)-jsl(tme, dr, l)), &
 
 6983                             abs(iel(tme, dr, l)-isl(tme, dr, l))) + 1 - jshift
 
 6987                  if( bound%recv(m)%is(n) > isl(tme, dr, l) ) 
then 
 6988                     bound%recv(m)%index(n) = bound%recv(m)%index(n)                  + &
 
 6989                          max(abs(jel(tme, dr, l)-jsl(tme, dr, l)), &
 
 6990                          abs(iel(tme, dr, l)-isl(tme, dr, l))) + 1 - ishift
 
 7006 subroutine fill_corner_contact(eCont, sCont, wCont, nCont, isg, ieg, jsg, jeg, numR, numS, tileRecv, tileSend, &
 
 7007  is1Recv, ie1Recv, js1Recv, je1Recv, is2Recv, ie2Recv, js2Recv, je2Recv,         &
 
 7008  is1Send, ie1Send, js1Send, je1Send, is2Send, ie2Send, js2Send, je2Send,         &
 
 7009  align1Recv, align2Recv, align1Send, align2Send,                                 &
 
 7010  whalo, ehalo, shalo, nhalo, tileMe)
 
 7011 type(contact_type), 
dimension(:), 
intent(in) :: eCont, sCont, wCont, nCont
 
 7012 integer, 
dimension(:),            
intent(in) :: isg, ieg, jsg, jeg
 
 7013 integer,                       
intent(inout) :: numR, numS
 
 7014 integer, 
dimension(:),         
intent(inout) :: tileRecv, tileSend
 
 7015 integer, 
dimension(:),         
intent(inout) :: is1Recv, ie1Recv, js1Recv, je1Recv
 
 7016 integer, 
dimension(:),         
intent(inout) :: is2Recv, ie2Recv, js2Recv, je2Recv
 
 7017 integer, 
dimension(:),         
intent(inout) :: is1Send, ie1Send, js1Send, je1Send
 
 7018 integer, 
dimension(:),         
intent(inout) :: is2Send, ie2Send, js2Send, je2Send
 
 7019 integer, 
dimension(:),         
intent(inout) :: align1Recv, align2Recv, align1Send, align2Send
 
 7020 integer,                          
intent(in) :: tileMe, whalo, ehalo, shalo, nhalo
 
 7021 integer                                      :: is1, ie1, js1, je1, is2, ie2, js2, je2
 
 7022 integer                                      :: tn, tc, n, m
 
 7023 logical                                      :: found_corner
 
 7025 found_corner = .false.
 
 7027 if(econt(tileme)%ncontact > 0) 
then 
 7028  if(econt(tileme)%js1(1) == jsg(tileme) ) 
then 
 7029     tn = econt(tileme)%tile(1)
 
 7030     if(econt(tileme)%js2(1) > jsg(tn) ) 
then   
 7031        if( econt(tileme)%js2(1) - jsg(tn) < shalo ) 
call mpp_error(fatal, &
 
 7032             "mpp_domains_define.inc: southeast tile for recv 1 is not tiled properly")
 
 7033        found_corner = .true.; tc = tn
 
 7034        is1 = econt(tileme)%ie1(1) + 1; je1 = econt(tileme)%js1(1) - 1
 
 7035        is2 = econt(tileme)%is2(1);     je2 = econt(tileme)%js2(1) - 1
 
 7036     else if(scont(tn)%ncontact >0) 
then  
 7037        if(scont(tn)%is1(1) == isg(tn)) 
then  
 7038           found_corner = .true.; tc = scont(tn)%tile(1)
 
 7039           is1 = econt(tileme)%ie1(1) + 1; je1 = econt(tileme)%js1(1) - 1
 
 7040           is2 = scont(tn)%is2(1);         je2 = scont(tn)%je2(1)
 
 7045 if( .not. found_corner ) 
then   
 7046  n = scont(tileme)%ncontact
 
 7048     if( scont(tileme)%ie1(n) == ieg(tileme)) 
then 
 7049        tn = scont(tileme)%tile(n)
 
 7050        if(scont(tileme)%ie2(n) < ieg(tn) ) 
then   
 7051           if(ieg(tn) - scont(tileme)%ie2(n) < ehalo ) 
call mpp_error(fatal, &
 
 7052                "mpp_domains_define.inc: southeast tile for recv 2 is not tiled properly")
 
 7053           found_corner = .true.; tc = tn
 
 7054           is1 = scont(tileme)%ie1(n) + 1; je1 = scont(tileme)%js1(n) - 1
 
 7055           is2 = scont(tileme)%ie2(n) + 1; je2 = scont(tileme)%je2(n)
 
 7056        else if(econt(tn)%ncontact >0) 
then  
 7057           m = econt(tn)%ncontact
 
 7058           if(econt(tn)%je1(m) == jeg(tn)) 
then  
 7059              found_corner = .true.; tc = econt(tn)%tile(m)
 
 7060              is1 = scont(tileme)%ie1(n) + 1; je1 = scont(tileme)%js1(n) - 1
 
 7061              is2 = econt(tn)%is2(m);         je2 = econt(tn)%je2(m)
 
 7067 if(found_corner) 
then 
 7069  tilerecv(numr) = tc; align1recv(numr) = south_east;  align2recv(numr) = north_west
 
 7070  is1recv(numr) = is1;             ie1recv(numr) = is1 + ehalo - 1
 
 7071  js1recv(numr) = je1 - shalo + 1; je1recv(numr) = je1
 
 7072  is2recv(numr) = is2;             ie2recv(numr) = is2 + ehalo - 1
 
 7073  js2recv(numr) = je2 - shalo + 1; je2recv(numr) = je2
 
 7077 found_corner = .false.
 
 7078 if(wcont(tileme)%ncontact > 0) 
then 
 7079  if(wcont(tileme)%js1(1) == jsg(tileme) ) 
then 
 7080     tn = wcont(tileme)%tile(1)
 
 7081     if(wcont(tileme)%js2(1) > jsg(tn) ) 
then   
 7082        if( wcont(tileme)%js2(1) - jsg(tn) < shalo ) 
call mpp_error(fatal, &
 
 7083             "mpp_domains_define.inc: southwest tile for recv 1 is not tiled properly")
 
 7084        found_corner = .true.; tc = tn
 
 7085        ie1 = wcont(tileme)%is1(1) - 1; je1 = wcont(tileme)%js1(1) - 1
 
 7086        ie2 = wcont(tileme)%is2(1);     je2 = wcont(tileme)%js2(1) - 1
 
 7087     else if(scont(tn)%ncontact >0) 
then  
 7088        n = scont(tn)%ncontact
 
 7089        if(scont(tn)%ie1(n) == ieg(tn)) 
then  
 7090           found_corner = .true.;  tc = scont(tn)%tile(n)
 
 7091           ie1 = wcont(tileme)%is1(1) - 1; je1 = wcont(tileme)%js1(1) - 1
 
 7092           ie2 = scont(tn)%ie2(1);         je2 = scont(tn)%je2(1)
 
 7097 if( .not. found_corner ) 
then   
 7098  n = scont(tileme)%ncontact
 
 7100     if( scont(tileme)%is1(1) == isg(tileme)) 
then 
 7101        tn = scont(tileme)%tile(1)
 
 7102        if(scont(tileme)%is2(1) > isg(tn) ) 
then   
 7103           if( scont(tileme)%is2(1)-isg(tn) < whalo ) 
call mpp_error(fatal, &
 
 7104                "mpp_domains_define.inc: southwest tile for recv 1 is not tiled properly")
 
 7105           found_corner = .true.; tc = tn
 
 7106           ie1 = scont(tileme)%is1(1) - 1; je1 = scont(tileme)%js1(1) - 1
 
 7107           ie2 = scont(tileme)%is2(1) - 1; je2 = scont(tileme)%js2(1)
 
 7108        else if(wcont(tn)%ncontact >0) 
then  
 7109           m = wcont(tn)%ncontact
 
 7110           if(wcont(tn)%je1(m) == jeg(tn)) 
then  
 7111              found_corner = .true.; tc = wcont(tn)%tile(m)
 
 7112              ie1 = scont(tileme)%is1(1) - 1; je1 = scont(tileme)%js1(1) - 1
 
 7113              ie2 = wcont(tn)%ie2(m);         je2 = wcont(tn)%je2(m)
 
 7119 if(found_corner) 
then 
 7121  tilerecv(numr) = tc; align1recv(numr) = south_west; align2recv(numr) = north_east
 
 7122  is1recv(numr) = ie1 - whalo + 1; ie1recv(numr) = ie1
 
 7123  js1recv(numr) = je1 - shalo + 1; je1recv(numr) = je1
 
 7124  is2recv(numr) = ie2 - whalo + 1; ie2recv(numr) = ie2
 
 7125  js2recv(numr) = je2 - shalo + 1; je2recv(numr) = je2
 
 7129 found_corner = .false.
 
 7130 n = wcont(tileme)%ncontact
 
 7132  if(wcont(tileme)%je1(n) == jeg(tileme) ) 
then 
 7133     tn = wcont(tileme)%tile(n)
 
 7134     if(wcont(tileme)%je2(n) < jeg(tn) ) 
then   
 7135        if( jeg(tn) - wcont(tileme)%je2(n) < nhalo ) 
call mpp_error(fatal, &
 
 7136             "mpp_domains_define.inc: northwest tile for recv 1 is not tiled properly")
 
 7137        found_corner = .true.; tc = tn
 
 7138        ie1 = wcont(tileme)%is1(n) - 1; js1 = wcont(tileme)%je1(n) + 1
 
 7139        ie2 = wcont(tileme)%is2(n);     js2 = wcont(tileme)%je2(n) + 1
 
 7140     else if(ncont(tn)%ncontact >0) 
then  
 7141        m = ncont(tn)%ncontact
 
 7142        if(ncont(tn)%ie1(m) == ieg(tn)) 
then  
 7143           found_corner = .true.; tc = ncont(tn)%tile(m)
 
 7144           ie1 = wcont(tileme)%is1(n) - 1; js1 = wcont(tileme)%je1(n) + 1
 
 7145           ie2 = ncont(tn)%ie2(m);         js2 = ncont(tn)%js2(m)
 
 7150 if( .not. found_corner ) 
then   
 7151  if( ncont(tileme)%ncontact > 0) 
then 
 7152     if( ncont(tileme)%is1(1) == isg(tileme)) 
then 
 7153        tn = ncont(tileme)%tile(1)
 
 7154        if(ncont(tileme)%is2(1) > isg(tn) ) 
then   
 7155           if( ncont(tileme)%is2(1)-isg(tn) < whalo ) 
call mpp_error(fatal, &
 
 7156                "mpp_domains_define.inc: northwest tile for recv 2 is not tiled properly")
 
 7157           found_corner = .true.; tc = tn
 
 7158           ie1 = ncont(tileme)%is1(1) - 1; js1 = ncont(tileme)%je1(1) + 1
 
 7159           ie2 = ncont(tileme)%is2(1) - 1; js2 = ncont(tileme)%js2(1)
 
 7160        else if(wcont(tn)%ncontact >0) 
then  
 7161           if(wcont(tn)%js1(1) == jsg(tn)) 
then  
 7162              found_corner = .true.; tc = wcont(tn)%tile(1)
 
 7163              ie1 = ncont(tileme)%is1(1) - 1; js1 = ncont(tileme)%je1(1) + 1
 
 7164              ie2 = wcont(tn)%ie2(1);         js2 = wcont(tn)%js2(1)
 
 7170 if(found_corner) 
then 
 7172  tilerecv(numr) = tc; align1recv(numr) =north_west;  align2recv(numr) = south_east
 
 7173  is1recv(numr) = ie1 - whalo + 1; ie1recv(numr) = ie1
 
 7174  js1recv(numr) = js1;             je1recv(numr) = js1 + nhalo - 1
 
 7175  is2recv(numr) = ie2 - whalo + 1; ie2recv(numr) = ie2
 
 7176  js2recv(numr) = js2;             je2recv(numr) = js2 + nhalo - 1
 
 7180 found_corner = .false.
 
 7181 n = econt(tileme)%ncontact
 
 7183  if(econt(tileme)%je1(n) == jeg(tileme) ) 
then 
 7184     tn = econt(tileme)%tile(n)
 
 7185     if(econt(tileme)%je2(n) < jeg(tn) ) 
then   
 7186        if( jeg(tn) - econt(tileme)%je2(n) < nhalo ) 
call mpp_error(fatal, &
 
 7187             "mpp_domains_define.inc: northeast tile for recv 1 is not tiled properly")
 
 7188        found_corner = .true.; tc = tn
 
 7189        is1 = econt(tileme)%ie1(n) + 1; js1 = econt(tileme)%je1(n) + 1
 
 7190        is2 = econt(tileme)%is2(1);     js2 = econt(tileme)%je2(1) + 1
 
 7191     else if(ncont(tn)%ncontact >0) 
then  
 7192        if(ncont(tn)%is1(1) == isg(tn)) 
then  
 7193           found_corner = .true.; tc = ncont(tn)%tile(1)
 
 7194           is1 = econt(tileme)%ie1(n) + 1; js1 = econt(tileme)%je1(n) + 1
 
 7195           is2 = ncont(tn)%is2(1);         js2 = ncont(tn)%js2(1)
 
 7200 if( .not. found_corner ) 
then   
 7201  n = ncont(tileme)%ncontact
 
 7203     if( ncont(tileme)%ie1(n) == ieg(tileme)) 
then 
 7204        tn = ncont(tileme)%tile(n)
 
 7205        if(ncont(tileme)%ie2(n) < ieg(tn) ) 
then   
 7206           if(ieg(tn) - scont(tileme)%ie2(n) < ehalo ) 
call mpp_error(fatal, &
 
 7207                "mpp_domains_define.inc: northeast tile for recv 2 is not tiled properly")
 
 7208           found_corner = .true.; tc = tn
 
 7209           is1 = scont(tileme)%ie1(n) + 1; js1 = scont(tileme)%je1(n) + 1
 
 7210           is2 = scont(tileme)%ie2(n) + 1; js2 = scont(tileme)%js2(n)
 
 7211        else if(econt(tn)%ncontact >0) 
then  
 7212           if(econt(tn)%js1(1) == jsg(tn)) 
then  
 7213              found_corner = .true.; tc = econt(tn)%tile(1)
 
 7214              is1 = scont(tileme)%ie1(n) + 1; js1 = scont(tileme)%je1(n) + 1
 
 7215              is2 = econt(tn)%is2(m);         js2 = econt(tn)%js2(m)
 
 7221 if(found_corner) 
then 
 7223  tilerecv(numr) = tc; align1recv(numr) =north_east;  align2recv(numr) = south_west
 
 7224  is1recv(numr) = is1; ie1recv(numr) = is1 + ehalo - 1
 
 7225  js1recv(numr) = js1; je1recv(numr) = js1 + nhalo - 1
 
 7226  is2recv(numr) = is2; ie2recv(numr) = is2 + ehalo - 1
 
 7227  js2recv(numr) = js2; je2recv(numr) = js2 + nhalo - 1
 
 7231 do n = 1, wcont(tileme)%ncontact
 
 7232  tn = wcont(tileme)%tile(n)
 
 7233  if(wcont(tileme)%js2(n) == jsg(tn) ) 
then 
 7234     if(wcont(tileme)%js1(n) > jsg(tileme) ) 
then   
 7235        if( wcont(tileme)%js1(n) - jsg(tileme) < shalo ) 
call mpp_error(fatal, &
 
 7236             "mpp_domains_define.inc: southeast tile for send 1 is not tiled properly")
 
 7237        nums = nums+1; tilesend(nums) = tn
 
 7238        align1send(nums) = north_west;  align2send(nums) = south_east
 
 7239        is1send(nums) = wcont(tileme)%is1(n);     ie1send(nums) = is1send(nums) + ehalo - 1
 
 7240        je1send(nums) = wcont(tileme)%js1(n) - 1; js1send(nums) = je1send(nums) - shalo + 1
 
 7241        is2send(nums) = wcont(tileme)%ie2(n) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 
 7242        je2send(nums) = wcont(tileme)%js2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
 
 7246 do n = 1, ncont(tileme)%ncontact
 
 7247  tn = ncont(tileme)%tile(n)
 
 7248  if(ncont(tileme)%ie2(n) == ieg(tn) ) 
then 
 7249     if(ncont(tileme)%ie1(n) < ieg(tileme) ) 
then   
 7250        if( ieg(tileme) - ncont(tileme)%ie1(n) < ehalo ) 
call mpp_error(fatal, &
 
 7251             "mpp_domains_define.inc: southeast tile for send 2 is not tiled properly")
 
 7252        nums = nums+1; tilesend(nums) = tn
 
 7253        align1send(nums) = north_west;  align2send(nums) = south_east
 
 7254        is1send(nums) = ncont(tileme)%ie1(n) + 1; ie1send(nums) = is1send(nums) + ehalo - 1
 
 7255        je1send(nums) = ncont(tileme)%je1(n)    ; js1send(nums) = je1send(nums) - shalo + 1
 
 7256        is2send(nums) = ncont(tileme)%ie2(n) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 
 7257        je2send(nums) = ncont(tileme)%je2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
 
 7263 n = wcont(tileme)%ncontact
 
 7264 found_corner = .false.
 
 7266  tn = wcont(tileme)%tile(n)
 
 7267  if( wcont(tileme)%je1(n) == jeg(tileme) .AND. wcont(tileme)%je2(n) == jeg(tn) ) 
then 
 7268     m = ncont(tn)%ncontact
 
 7270        tc = ncont(tn)%tile(m)
 
 7271        if( ncont(tn)%ie1(m) == ieg(tn) .AND. ncont(tn)%ie2(m) == ieg(tc) ) found_corner = .true.
 
 7275 if( .not. found_corner ) 
then   
 7276  if( ncont(tileme)%ncontact > 0) 
then 
 7277     tn = ncont(tileme)%tile(1)
 
 7278     if( ncont(tileme)%is1(1) == isg(tileme) .AND. ncont(tileme)%is2(1) == isg(tn) ) 
then 
 7279        if(wcont(tn)%ncontact >0) 
then 
 7280           tc = wcont(tn)%tile(1)
 
 7281           if( wcont(tn)%js1(1) == jsg(tn) .AND. wcont(tn)%js2(1) == jsg(tc) ) found_corner = .true.
 
 7287 if(found_corner) 
then 
 7288  nums = nums+1; tilesend(nums) = tc
 
 7289  align1send(nums) = north_west;  align2send(nums) = south_east
 
 7290  is1send(nums) = isg(tileme); ie1send(nums) = is1send(nums) + ehalo - 1
 
 7291  je1send(nums) = jeg(tileme); js1send(nums) = je1send(nums) - shalo + 1
 
 7292  is2send(nums) = ieg(tc) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 
 7293  je2send(nums) = jsg(tc) - 1; js2send(nums) = je2send(nums) - shalo + 1
 
 7297 do n = 1, econt(tileme)%ncontact
 
 7298  tn = econt(tileme)%tile(n)
 
 7299  if(econt(tileme)%js2(n) == jsg(tn) ) 
then 
 7300     if(econt(tileme)%js1(n) > jsg(tileme) ) 
then   
 7301        if( econt(tileme)%js1(n) - jsg(tileme) < shalo ) 
call mpp_error(fatal, &
 
 7302             "mpp_domains_define.inc: southwest tile for send 1 is not tiled properly")
 
 7303        nums = nums+1; tilesend(nums) = tn
 
 7304        align1send(nums) = north_east;  align2send(nums) = south_west
 
 7305        ie1send(nums) = econt(tileme)%ie1(n);     is1send(nums) = ie1send(nums) - whalo + 1
 
 7306        je1send(nums) = econt(tileme)%js1(n) - 1; js1send(nums) = je1send(nums) - shalo + 1
 
 7307        ie2send(nums) = econt(tileme)%is2(n) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 
 7308        je2send(nums) = econt(tileme)%js2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
 
 7312 do n = 1, ncont(tileme)%ncontact
 
 7313  tn = ncont(tileme)%tile(n)
 
 7314  if(ncont(tileme)%is2(n) == isg(tn) ) 
then 
 7315     if(ncont(tileme)%is1(n) > isg(tileme) ) 
then   
 7316        if( ncont(tileme)%is1(n) - isg(tileme) < whalo ) 
call mpp_error(fatal, &
 
 7317             "mpp_domains_define.inc: southwest tile for send 2 is not tiled properly")
 
 7318        nums = nums+1; tilesend(nums) = tn
 
 7319        align1send(nums) = north_east;  align2send(nums) = south_west
 
 7320        ie1send(nums) = ncont(tileme)%is1(n) - 1; is1send(nums) = ie1send(nums) - whalo + 1
 
 7321        ie1send(nums) = ncont(tileme)%je1(n)    ; js1send(nums) = je1send(nums) - shalo + 1
 
 7322        ie2send(nums) = ncont(tileme)%is2(n) - 1; is2send(nums) = je2send(nums) - whalo + 1
 
 7323        je2send(nums) = ncont(tileme)%js2(n) - 1; js2send(nums) = je2send(nums) - shalo + 1
 
 7329 n = econt(tileme)%ncontact
 
 7330 found_corner = .false.
 
 7332  tn = econt(tileme)%tile(n)
 
 7333  if( econt(tileme)%je1(n) == jeg(tileme) .AND. econt(tileme)%je2(n) == jeg(tn) ) 
then 
 7334     if(ncont(tn)%ncontact >0) 
then 
 7335        tc = ncont(tn)%tile(1)
 
 7336        if( ncont(tn)%is1(1) == isg(tn) .AND. ncont(tn)%is2(n) == isg(tc) ) found_corner = .true.
 
 7340 if( .not. found_corner ) 
then   
 7341  n = ncont(tileme)%ncontact
 
 7343     tn = ncont(tileme)%tile(n)
 
 7344     if( ncont(tileme)%ie1(n) == ieg(tileme) .AND. ncont(tileme)%ie2(n) == ieg(tn) ) 
then 
 7345        if(econt(tn)%ncontact >0) 
then 
 7346           tc = econt(tn)%tile(1)
 
 7347           if( econt(tn)%js1(1) == jsg(tn) .AND. econt(tn)%js2(n) == jsg(tc) ) found_corner = .true.
 
 7353 if(found_corner) 
then 
 7354  nums = nums+1; tilesend(nums) = tc
 
 7355  align1send(nums) = north_east;  align2send(nums) = south_west
 
 7356  ie1send(nums) = ieg(tileme); is1send(nums) = ie1send(nums) - whalo + 1
 
 7357  je1send(nums) = jeg(tileme); js1send(nums) = je1send(nums) - shalo + 1
 
 7358  ie2send(nums) = isg(tc) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 
 7359  je2send(nums) = jsg(tc) - 1; js2send(nums) = je2send(nums) - shalo + 1
 
 7363 do n = 1, econt(tileme)%ncontact
 
 7364  tn = econt(tileme)%tile(n)
 
 7365  if(econt(tileme)%je2(n) == jeg(tn) ) 
then 
 7366     if(econt(tileme)%je1(n) < jeg(tileme) ) 
then   
 7367        if( jeg(tileme) - econt(tileme)%je1(n) < nhalo ) 
call mpp_error(fatal, &
 
 7368             "mpp_domains_define.inc: northwest tile for send 1 is not tiled properly")
 
 7369        nums = nums+1; tilesend(nums) = tn
 
 7370        align1send(nums) = south_east;  align2send(nums) = north_west
 
 7371        ie1send(nums) = econt(tileme)%ie1(n)    ; is1send(nums) = ie1send(nums) - whalo + 1
 
 7372        js1send(nums) = econt(tileme)%je1(n) + 1; je1send(nums) = js1send(nums) + nhalo - 1
 
 7373        ie2send(nums) = econt(tileme)%is2(n) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 
 7374        js2send(nums) = econt(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
 
 7379 do n = 1, scont(tileme)%ncontact
 
 7380  tn = scont(tileme)%tile(n)
 
 7381  if(scont(tileme)%is2(n) == isg(tn) ) 
then 
 7382     if(scont(tileme)%is1(n) > isg(tileme) ) 
then   
 7383        if( scont(tileme)%is1(n) - isg(tileme) < whalo ) 
call mpp_error(fatal, &
 
 7384             "mpp_domains_define.inc: southwest tile for send 2 is not tiled properly")
 
 7385        nums = nums+1; tilesend(nums) = tn
 
 7386        align1send(nums) = south_east;  align2send(nums) = north_west
 
 7387        ie1send(nums) = ncont(tileme)%is1(n) - 1; is1send(nums) = ie1send(nums) - whalo + 1
 
 7388        js1send(nums) = ncont(tileme)%je1(n)    ; je1send(nums) = js1send(nums) + nhalo - 1
 
 7389        ie2send(nums) = ncont(tileme)%is2(n) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 
 7390        js2send(nums) = ncont(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
 
 7396 n = econt(tileme)%ncontact
 
 7397 found_corner = .false.
 
 7399  tn = econt(tileme)%tile(1)
 
 7400  if( econt(tileme)%js1(1) == jsg(tileme) .AND. econt(tileme)%js2(1) == jsg(tn) ) 
then 
 7401     if(scont(tn)%ncontact >0) 
then 
 7402        tc = scont(tn)%tile(1)
 
 7403        if( scont(tn)%is1(1) == isg(tn) .AND. scont(tn)%is2(1) == isg(tc) ) found_corner = .true.
 
 7407 if( .not. found_corner ) 
then   
 7408  n = scont(tileme)%ncontact
 
 7409  found_corner = .false.
 
 7411     tn = scont(tileme)%tile(n)
 
 7412     if( scont(tileme)%ie1(n) == ieg(tileme) .AND. scont(tileme)%ie2(n) == ieg(tn) ) 
then 
 7413        if(econt(tn)%ncontact >0) 
then 
 7414           tc = econt(tn)%tile(n)
 
 7415           if( econt(tn)%je1(n) == jeg(tn) .AND. econt(tn)%je2(n) == jeg(tc) ) found_corner = .true.
 
 7421 if(found_corner) 
then 
 7422  nums = nums+1; tilesend(nums) = tc
 
 7423  align1send(nums) = south_east;  align2send(nums) = north_west
 
 7424  ie1send(nums) = ieg(tileme); is1send(nums) = ie1send(nums) - whalo + 1
 
 7425  js1send(nums) = jsg(tileme); je1send(nums) = js1send(nums) + nhalo - 1
 
 7426  ie2send(nums) = isg(tc) - 1; is2send(nums) = ie2send(nums) - whalo + 1
 
 7427  js2send(nums) = jeg(tc) + 1; je2send(nums) = js2send(nums) + nhalo - 1
 
 7431 do n = 1, wcont(tileme)%ncontact
 
 7432  tn = wcont(tileme)%tile(n)
 
 7433  if(wcont(tileme)%je2(n) == jeg(tn) ) 
then 
 7434     if(wcont(tileme)%je1(n) < jeg(tileme) ) 
then   
 7435        if( jeg(tileme) - wcont(tileme)%je1(n) < nhalo ) 
call mpp_error(fatal, &
 
 7436             "mpp_domains_define.inc: northeast tile for send 1 is not tiled properly")
 
 7437        nums = nums+1; tilesend(nums) = tn
 
 7438        align1send(nums) = south_west;  align2send(nums) = north_east
 
 7439        is1send(nums) = wcont(tileme)%is1(n)    ; ie1send(nums) = is1send(nums) + ehalo - 1
 
 7440        js1send(nums) = wcont(tileme)%je1(n) + 1; je1send(nums) = js1send(nums) + nhalo - 1
 
 7441        is2send(nums) = wcont(tileme)%ie2(n) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 
 7442        js2send(nums) = wcont(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
 
 7447 do n = 1, scont(tileme)%ncontact
 
 7448  tn = scont(tileme)%tile(n)
 
 7449  if(scont(tileme)%ie2(n) == ieg(tn) ) 
then 
 7450     if(scont(tileme)%ie1(n) < ieg(tileme) ) 
then   
 7451        if( ieg(tileme) - scont(tileme)%ie1(n) < ehalo ) 
call mpp_error(fatal, &
 
 7452             "mpp_domains_define.inc: southeast tile for send 2 is not tiled properly")
 
 7453        nums = nums+1; tilesend(nums) = tn
 
 7454        align1send(nums) = south_west;  align2send(nums) = north_east
 
 7455        is1send(nums) = scont(tileme)%ie1(n) + 1; ie1send(nums) = is1send(nums) + ehalo - 1
 
 7456        js1send(nums) = scont(tileme)%js1(n)    ; je1send(nums) = js1send(nums) + nhalo - 1
 
 7457        is2send(nums) = scont(tileme)%ie2(n) + 1; ie2send(nums) = is1send(nums) + ehalo - 1
 
 7458        js2send(nums) = scont(tileme)%je2(n) + 1; je2send(nums) = js2send(nums) + nhalo - 1
 
 7464 n = wcont(tileme)%ncontact
 
 7465 found_corner = .false.
 
 7467  tn = wcont(tileme)%tile(1)
 
 7468  if( wcont(tileme)%js1(n) == jsg(tileme) .AND. wcont(tileme)%js2(n) == jsg(tn) ) 
then 
 7469     m = scont(tn)%ncontact
 
 7471        tc = scont(tn)%tile(m)
 
 7472        if( scont(tn)%ie1(m) == ieg(tn) .AND. scont(tn)%ie2(m) == ieg(tc) ) found_corner = .true.
 
 7476 if( .not. found_corner ) 
then   
 7477  n = scont(tileme)%ncontact
 
 7478  found_corner = .false.
 
 7480     tn = scont(tileme)%tile(1)
 
 7481     if( scont(tileme)%is1(1) == isg(tileme) .AND. scont(tileme)%is2(1) == isg(tn) ) 
then 
 7482        m = wcont(tn)%ncontact
 
 7484           tc = wcont(tn)%tile(m)
 
 7485           if( wcont(tn)%je1(m) == jeg(tn) .AND. wcont(tn)%je2(m) == jeg(tc) ) found_corner = .true.
 
 7490 if(found_corner) 
then 
 7491  nums = nums+1; tilesend(nums) = tc
 
 7492  align1send(nums) = south_west;  align2send(nums) = north_east
 
 7493  is1send(nums) = isg(tileme); ie1send(nums) = is1send(nums) + ehalo - 1
 
 7494  js1send(nums) = jsg(tileme); je1send(nums) = js1send(nums) + nhalo - 1
 
 7495  is2send(nums) = ieg(tc) + 1; ie2send(nums) = is2send(nums) + ehalo - 1
 
 7496  js2send(nums) = jeg(tc) + 1; je2send(nums) = js2send(nums) + nhalo - 1
 
 7499 end subroutine fill_corner_contact
 
 7502 subroutine check_alignment( is, ie, js, je, isg, ieg, jsg, jeg, alignment )
 
 7503 integer, 
intent(inout) :: is, ie, js, je, isg, ieg, jsg, jeg
 
 7504 integer, 
intent(out)   :: alignment
 
 7508 if ( is == ie ) 
then       
 7509  if ( is == isg ) 
then 
 7511  else if ( is == ieg ) 
then 
 7514     call mpp_error(fatal, 
'mpp_domains_define.inc: The contact region is not on the x-boundary of the tile')
 
 7517     j = js; js = je; je = j
 
 7519 else if ( js == je ) 
then  
 7520  if ( js == jsg ) 
then 
 7522  else if ( js == jeg ) 
then 
 7525     call mpp_error(fatal, 
'mpp_domains_define.inc: The contact region is not on the y-boundary of the tile')
 
 7528     i = is; is = ie; ie = i
 
 7531  call mpp_error(fatal, 
'mpp_domains_define.inc: The contact region should be line contact' )
 
 7534 end subroutine check_alignment
 
 7546 type(domain1d), 
intent(in)    :: domain_in
 
 7547 type(domain1d), 
intent(inout) :: domain_out
 
 7548 integer, 
intent(in), 
optional :: hbegin, hend
 
 7549 integer, 
intent(in), 
optional :: cbegin, cend
 
 7551 integer, 
intent(in), 
optional :: gbegin, gend
 
 7553 integer :: ndivs, global_indices(2) 
 
 7556 global_indices(1) = domain_in%global%begin;  global_indices(2) = domain_in%global%end
 
 7559 ndivs = 
size(domain_in%list(:))
 
 7563 if(domain_in%cyclic) flag = flag + cyclic_global_domain
 
 7564 if(domain_in%domain_data%is_global) flag = flag + global_data_domain
 
 7566 call mpp_define_domains( global_indices, ndivs, domain_out, pelist = domain_in%list(:)%pe, &
 
 7567    flags = flag, begin_halo = hbegin, end_halo = hend, extent = domain_in%list(:)%compute%size )
 
 7569 if(
present(cbegin)) domain_out%compute%begin = cbegin
 
 7570 if(
present(cend))   domain_out%compute%end = cend
 
 7571 domain_out%compute%size = domain_out%compute%end - domain_out%compute%begin + 1
 
 7572 if(
present(gbegin)) domain_out%global%begin = gbegin
 
 7573 if(
present(gend))   domain_out%global%end = gend
 
 7574 domain_out%global%size = domain_out%global%end - domain_out%global%begin + 1
 
 7580 subroutine mpp_modify_domain2d(domain_in, domain_out, isc, iec, jsc, jec, isg, ieg, jsg, jeg, whalo, ehalo, &
 
 7583 type(domain2d), 
intent(in)    :: domain_in
 
 7584 type(domain2d), 
intent(inout) :: domain_out
 
 7585 integer, 
intent(in), 
optional :: isc, iec, jsc, jec
 
 7587 integer, 
intent(in), 
optional :: isg, ieg, jsg, jeg
 
 7589 integer, 
intent(in), 
optional :: whalo, ehalo, shalo, nhalo
 
 7590 integer                       :: global_indices(4), layout(2)
 
 7591 integer                       :: xflag, yflag, nlist, i
 
 7593 if(
present(whalo) .or. 
present(ehalo) .or. 
present(shalo) .or. 
present(nhalo) ) 
then 
 7595  global_indices(1) = domain_in%x(1)%global%begin;  global_indices(2) = domain_in%x(1)%global%end
 
 7596  global_indices(3) = domain_in%y(1)%global%begin;  global_indices(4) = domain_in%y(1)%global%end
 
 7599  layout(1) = 
size(domain_in%x(1)%list(:)); layout(2) = 
size(domain_in%y(1)%list(:))
 
 7602  xflag = 0; yflag = 0
 
 7603  if(domain_in%x(1)%cyclic) xflag = xflag + cyclic_global_domain
 
 7604  if(domain_in%x(1)%domain_data%is_global) xflag = xflag + global_data_domain
 
 7605  if(domain_in%y(1)%cyclic) yflag = yflag + cyclic_global_domain
 
 7606  if(domain_in%y(1)%domain_data%is_global) yflag = yflag + global_data_domain
 
 7608  call mpp_define_domains( global_indices, layout, domain_out, pelist = domain_in%list(:)%pe, &
 
 7609       xflags = xflag, yflags = yflag,  whalo = whalo, ehalo = ehalo,     &
 
 7610       shalo = shalo, nhalo = nhalo,                                      &
 
 7611       xextent = domain_in%x(1)%list(:)%compute%size,                     &
 
 7612       yextent = domain_in%y(1)%list(:)%compute%size,                     &
 
 7613       symmetry=domain_in%symmetry,                                       &
 
 7614       maskmap = domain_in%pearray .NE. null_pe )
 
 7615  domain_out%ntiles = domain_in%ntiles
 
 7616  domain_out%tile_id = domain_in%tile_id
 
 7618  call mpp_define_null_domain(domain_out)
 
 7619  nlist = 
size(domain_in%list(:))
 
 7620  if (
associated(domain_out%list)) 
deallocate(domain_out%list) 
 
 7621  allocate(domain_out%list(0:nlist-1) )
 
 7623     allocate(domain_out%list(i)%tile_id(1))
 
 7624     domain_out%list(i)%tile_id(1) = 1
 
 7626  call mpp_modify_domain(domain_in%x(1), domain_out%x(1), isc, iec, isg, ieg)
 
 7627  call mpp_modify_domain(domain_in%y(1), domain_out%y(1), jsc, jec, jsg, jeg)
 
 7628  domain_out%ntiles = domain_in%ntiles
 
 7629  domain_out%tile_id = domain_in%tile_id
 
 7638 subroutine mpp_define_null_domain1d(domain)
 
 7639 type(domain1d), 
intent(inout) :: domain
 
 7641 domain%global%begin  = -1; domain%global%end  = -1; domain%global%size = 0
 
 7642 domain%domain_data%begin    = -1; domain%domain_data%end    = -1; domain%domain_data%size = 0
 
 7643 domain%compute%begin = -1; domain%compute%end = -1; domain%compute%size = 0
 
 7646 end subroutine mpp_define_null_domain1d
 
 7651 subroutine mpp_define_null_domain2d(domain)
 
 7652 type(domain2d), 
intent(inout) :: domain
 
 7654 allocate(domain%x(1), domain%y(1), domain%tile_id(1))
 
 7655 call mpp_define_null_domain(domain%x(1))
 
 7656 call mpp_define_null_domain(domain%y(1))
 
 7658 domain%tile_id(1)   = 1
 
 7660 domain%max_ntile_pe = 1
 
 7661 domain%ncontacts    = 0
 
 7663 end subroutine mpp_define_null_domain2d
 
 7667 subroutine mpp_deallocate_domain1d(domain)
 
 7668   type(domain1d), 
intent(inout) :: domain
 
 7670   if(
ASSOCIATED(domain%list)) 
deallocate(domain%list)
 
 7672 end subroutine mpp_deallocate_domain1d
 
 7676 subroutine mpp_deallocate_domain2d(domain)
 
 7677   type(domain2d), 
intent(inout) :: domain
 
 7679   call deallocate_domain2d_local(domain)
 
 7680   if(
ASSOCIATED(domain%io_domain) ) 
then 
 7681      call deallocate_domain2d_local(domain%io_domain)
 
 7682      deallocate(domain%io_domain)
 
 7685 end subroutine mpp_deallocate_domain2d
 
 7689 subroutine deallocate_domain2d_local(domain)
 
 7690 type(domain2d), 
intent(inout) :: domain
 
 7691 integer :: i, ntileMe
 
 7693 ntileme = 
size(domain%x(:))
 
 7695 if(
ASSOCIATED(domain%pearray))
deallocate(domain%pearray)
 
 7697    call mpp_deallocate_domain1d(domain%x(i))
 
 7698    call mpp_deallocate_domain1d(domain%y(i))
 
 7700 deallocate(domain%x, domain%y, domain%tile_id)
 
 7703 if(
ASSOCIATED(domain%tileList)) 
deallocate(domain%tileList)
 
 7704 if(
ASSOCIATED(domain%tile_id_all)) 
deallocate(domain%tile_id_all)
 
 7706 if(
ASSOCIATED(domain%list)) 
then 
 7707  do i = 0, 
size(domain%list(:))-1
 
 7708     deallocate(domain%list(i)%x, domain%list(i)%y, domain%list(i)%tile_id)
 
 7710  deallocate(domain%list)
 
 7713 if(
ASSOCIATED(domain%check_C)) 
then 
 7714   call deallocate_overlapspec(domain%check_C)
 
 7715   deallocate(domain%check_C)
 
 7718 if(
ASSOCIATED(domain%check_E)) 
then 
 7719   call deallocate_overlapspec(domain%check_E)
 
 7720   deallocate(domain%check_E)
 
 7723 if(
ASSOCIATED(domain%check_N)) 
then 
 7724   call deallocate_overlapspec(domain%check_N)
 
 7725   deallocate(domain%check_N)
 
 7728 if(
ASSOCIATED(domain%bound_C)) 
then 
 7729   call deallocate_overlapspec(domain%bound_C)
 
 7730   deallocate(domain%bound_C)
 
 7733 if(
ASSOCIATED(domain%bound_E)) 
then 
 7734   call deallocate_overlapspec(domain%bound_E)
 
 7735   deallocate(domain%bound_E)
 
 7738 if(
ASSOCIATED(domain%bound_N)) 
then 
 7739   call deallocate_overlapspec(domain%bound_N)
 
 7740   deallocate(domain%bound_N)
 
 7743 if(
ASSOCIATED(domain%update_T)) 
then 
 7744   call deallocate_overlapspec(domain%update_T)
 
 7745   deallocate(domain%update_T)
 
 7748 if(
ASSOCIATED(domain%update_E)) 
then 
 7749   call deallocate_overlapspec(domain%update_E)
 
 7750   deallocate(domain%update_E)
 
 7753 if(
ASSOCIATED(domain%update_C)) 
then 
 7754   call deallocate_overlapspec(domain%update_C)
 
 7755   deallocate(domain%update_C)
 
 7758 if(
ASSOCIATED(domain%update_N)) 
then 
 7759   call deallocate_overlapspec(domain%update_N)
 
 7760   deallocate(domain%update_N)
 
 7763 end subroutine deallocate_domain2d_local
 
 7767 subroutine allocate_check_overlap(overlap, count)
 
 7768   type(overlap_type), 
intent(inout) :: overlap
 
 7769   integer,            
intent(in   ) :: count
 
 7772   overlap%pe    = null_pe
 
 7773   if(
associated(overlap%tileMe)) 
call mpp_error(fatal, &
 
 7774        "allocate_check_overlap(mpp_domains_define): overlap is already been allocated")
 
 7775   if(count < 1)  
call mpp_error(fatal, &
 
 7776        "allocate_check_overlap(mpp_domains_define): count should be a positive integer")
 
 7777   allocate(overlap%tileMe  (count), overlap%dir(count) )
 
 7778   allocate(overlap%is      (count), overlap%ie (count) )
 
 7779   allocate(overlap%js      (count), overlap%je (count) )
 
 7780   allocate(overlap%rotation(count)                     )
 
 7781   overlap%rotation     =  zero
 
 7783 end subroutine allocate_check_overlap
 
 7786 subroutine insert_check_overlap(overlap, pe, tileMe, dir, rotation, is, ie, js, je)
 
 7787   type(overlap_type), 
intent(inout) :: overlap
 
 7788   integer,            
intent(in   ) :: pe
 
 7789   integer,            
intent(in   ) :: tileMe, dir, rotation
 
 7790   integer,            
intent(in   ) :: is, ie, js, je
 
 7793   overlap%count = overlap%count + 1
 
 7794   count = overlap%count
 
 7795   if(.NOT. 
associated(overlap%tileMe)) 
call mpp_error(fatal, &
 
 7796      "mpp_domains_define.inc(insert_check_overlap): overlap is not assigned any memory")
 
 7797   if(count > 
size(overlap%tileMe(:)) ) 
call mpp_error(fatal, &
 
 7798      "mpp_domains_define.inc(insert_check_overlap): overlap%count is greater than size(overlap%tileMe)")
 
 7799   if( overlap%pe == null_pe ) 
then 
 7802      if(overlap%pe .NE. pe) 
call mpp_error(fatal,  &
 
 7803            "mpp_domains_define.inc(insert_check_overlap): mismatch on pe")
 
 7805   overlap%tileMe  (count) = tileme
 
 7806   overlap%dir     (count) = dir
 
 7807   overlap%rotation(count) = rotation
 
 7808   overlap%is      (count) = is
 
 7809   overlap%ie      (count) = ie
 
 7810   overlap%js      (count) = js
 
 7811   overlap%je      (count) = je
 
 7813 end subroutine insert_check_overlap
 
 7818   type(overlap_type), 
intent(inout) :: overlap_out
 
 7819   type(overlap_type), 
intent(in   ) :: overlap_in
 
 7820   type(overlap_type)                :: overlap
 
 7821   integer                          :: count, count_in, count_out
 
 7824   count_in  = overlap_in %count
 
 7825   count_out = overlap_out%count
 
 7826   count     = count_in+count_out
 
 7827   if(count_in == 0) 
call mpp_error(fatal, &
 
 7828        "add_check_overlap(mpp_domains_define): overlap_in%count is zero")
 
 7830   if(count_out == 0) 
then 
 7831      if(
associated(overlap_out%tileMe)) 
call mpp_error(fatal, &
 
 7832           "add_check_overlap(mpp_domains_define): overlap is already been allocated but count=0")
 
 7833      call allocate_check_overlap(overlap_out, count_in)
 
 7834      overlap_out%pe  = overlap_in%pe
 
 7836      call allocate_check_overlap(overlap, count_out)
 
 7837      if(overlap_out%pe .NE. overlap_in%pe) 
call mpp_error(fatal, &
 
 7838          "mpp_domains_define.inc(add_check_overlap): mismatch of pe between overlap_in and overlap_out")
 
 7839      overlap%tileMe      (1:count_out) = overlap_out%tileMe      (1:count_out)
 
 7840      overlap%is          (1:count_out) = overlap_out%is          (1:count_out)
 
 7841      overlap%ie          (1:count_out) = overlap_out%ie          (1:count_out)
 
 7842      overlap%js          (1:count_out) = overlap_out%js          (1:count_out)
 
 7843      overlap%je          (1:count_out) = overlap_out%je          (1:count_out)
 
 7844      overlap%dir         (1:count_out) = overlap_out%dir         (1:count_out)
 
 7845      overlap%rotation    (1:count_out) = overlap_out%rotation    (1:count_out)
 
 7846      call deallocate_overlap_type(overlap_out)
 
 7847      call allocate_check_overlap(overlap_out, count)
 
 7848      overlap_out%tileMe      (1:count_out) = overlap%tileMe      (1:count_out)
 
 7849      overlap_out%is          (1:count_out) = overlap%is          (1:count_out)
 
 7850      overlap_out%ie          (1:count_out) = overlap%ie          (1:count_out)
 
 7851      overlap_out%js          (1:count_out) = overlap%js          (1:count_out)
 
 7852      overlap_out%je          (1:count_out) = overlap%je          (1:count_out)
 
 7853      overlap_out%dir         (1:count_out) = overlap%dir         (1:count_out)
 
 7854      overlap_out%rotation    (1:count_out) = overlap%rotation    (1:count_out)
 
 7855      call deallocate_overlap_type(overlap)
 
 7857   overlap_out%count                           = count
 
 7858   overlap_out%tileMe      (count_out+1:count) = overlap_in%tileMe      (1:count_in)
 
 7859   overlap_out%is          (count_out+1:count) = overlap_in%is          (1:count_in)
 
 7860   overlap_out%ie          (count_out+1:count) = overlap_in%ie          (1:count_in)
 
 7861   overlap_out%js          (count_out+1:count) = overlap_in%js          (1:count_in)
 
 7862   overlap_out%je          (count_out+1:count) = overlap_in%je          (1:count_in)
 
 7863   overlap_out%dir         (count_out+1:count) = overlap_in%dir         (1:count_in)
 
 7864   overlap_out%rotation    (count_out+1:count) = overlap_in%rotation    (1:count_in)
 
 7869 subroutine init_overlap_type(overlap)
 
 7870   type(overlap_type), 
intent(inout) :: overlap
 
 7873   overlap%pe    = null_pe
 
 7875 end subroutine init_overlap_type
 
 7879 subroutine allocate_update_overlap( overlap, count)
 
 7880   type(overlap_type), 
intent(inout) :: overlap
 
 7881   integer,           
intent(in   ) :: count
 
 7884   overlap%pe    = null_pe
 
 7885   if(
associated(overlap%tileMe)) 
call mpp_error(fatal, &
 
 7886        "allocate_update_overlap(mpp_domains_define): overlap is already been allocated")
 
 7887   if(count < 1)  
call mpp_error(fatal, &
 
 7888        "allocate_update_overlap(mpp_domains_define): count should be a positive integer")
 
 7889   allocate(overlap%tileMe      (count), overlap%tileNbr (count) )
 
 7890   allocate(overlap%is          (count), overlap%ie      (count) )
 
 7891   allocate(overlap%js          (count), overlap%je      (count) )
 
 7892   allocate(overlap%dir         (count), overlap%rotation(count) )
 
 7893   allocate(overlap%from_contact(count), overlap%msgsize (count) )
 
 7894   overlap%rotation     =  zero
 
 7895   overlap%from_contact = .false.
 
 7897 end subroutine allocate_update_overlap
 
 7900   subroutine insert_update_overlap(overlap, pe, is1, ie1, js1, je1, is2, ie2, js2, je2, dir, reverse, symmetry)
 
 7901     type(overlap_type), 
intent(inout) :: overlap
 
 7902     integer,            
intent(in   ) :: pe
 
 7903     integer,            
intent(in   ) :: is1, ie1, js1, je1, is2, ie2, js2, je2
 
 7904     integer,            
intent(in   ) :: dir
 
 7905     logical, 
optional,  
intent(in   ) :: reverse, symmetry
 
 7907     logical :: is_reverse, is_symmetry, is_overlapped
 
 7908     integer :: is, ie, js, je, count
 
 7910     is_reverse = .false.
 
 7911     if(
PRESENT(reverse)) is_reverse = reverse
 
 7912     is_symmetry = .false.
 
 7913     if(
PRESENT(symmetry)) is_symmetry = symmetry
 
 7915     is = max(is1,is2); ie = min(ie1,ie2)
 
 7916     js = max(js1,js2); je = min(je1,je2)
 
 7917     is_overlapped = .false.
 
 7919     if(is_symmetry .AND. (dir == 1 .OR. dir == 5)) 
then   
 7920        if( ie .GE. is .AND. je .GT. js ) is_overlapped = .true.
 
 7921     else if(is_symmetry .AND. (dir == 3 .OR. dir == 7)) 
then  
 7922        if( ie .GT. is .AND. je .GE. js ) is_overlapped = .true.
 
 7923     else if(ie.GE.is .AND. je.GE.js )
then 
 7924        is_overlapped = .true.
 
 7927     if(is_overlapped) 
then 
 7928      if( overlap%count == 0 ) 
then 
 7931           if(overlap%pe .NE. pe) 
call mpp_error(fatal,  &
 
 7932                "mpp_domains_define.inc(insert_update_overlap): mismatch on pe")
 
 7934        overlap%count = overlap%count+1
 
 7935        count = overlap%count
 
 7936        if(count > maxoverlap) 
call mpp_error(fatal, 
"mpp_domains_define.inc(insert_update_overlap):"//&
 
 7937                               & 
" number of overlap is greater than MAXOVERLAP, increase MAXOVERLAP")
 
 7938        overlap%is(count) = is
 
 7939        overlap%ie(count) = ie
 
 7940        overlap%js(count) = js
 
 7941        overlap%je(count) = je
 
 7942        overlap%tileMe (count) = 1
 
 7943        overlap%tileNbr(count) = 1
 
 7944        overlap%dir(count) = dir
 
 7946           overlap%rotation(count) = one_hundred_eighty
 
 7948           overlap%rotation(count) = zero
 
 7952   end subroutine insert_update_overlap
 
 7955 subroutine insert_overlap_type(overlap, pe, tileMe, tileNbr, is, ie, js, je, dir, &
 
 7956      rotation, from_contact)
 
 7957     type(overlap_type), 
intent(inout) :: overlap
 
 7958     integer,            
intent(in   ) :: tileMe, tileNbr, pe
 
 7959     integer,            
intent(in   ) :: is, ie, js, je
 
 7960     integer,            
intent(in   ) :: dir, rotation
 
 7961   logical,            
intent(in   ) :: from_contact
 
 7964   if( overlap%count == 0 ) 
then 
 7967        if(overlap%pe .NE. pe) 
call mpp_error(fatal,  &
 
 7968           "mpp_domains_define.inc(insert_overlap_type): mismatch on pe")
 
 7970     overlap%count = overlap%count+1
 
 7971     count = overlap%count
 
 7972     if(count > maxoverlap) 
call mpp_error(fatal, 
"mpp_domains_define.inc(insert_overlap_type):"//&
 
 7973                            & 
" number of overlap is greater than MAXOVERLAP, increase MAXOVERLAP")
 
 7974     overlap%tileMe      (count) = tileme
 
 7975     overlap%tileNbr     (count) = tilenbr
 
 7976     overlap%is          (count) = is
 
 7977     overlap%ie          (count) = ie
 
 7978     overlap%js          (count) = js
 
 7979     overlap%je          (count) = je
 
 7980     overlap%dir         (count) = dir
 
 7981     overlap%rotation    (count) = rotation
 
 7982     overlap%from_contact(count) = from_contact
 
 7983     overlap%msgsize     (count) = (ie-is+1)*(je-js+1)
 
 7985 end subroutine insert_overlap_type
 
 7989 subroutine deallocate_overlap_type( overlap)
 
 7990   type(overlap_type), 
intent(inout) :: overlap
 
 7992   if(overlap%count == 0) 
then 
 7993      if( .NOT. 
associated(overlap%tileMe)) 
return 
 7995      if( .NOT. 
associated(overlap%tileMe)) 
call mpp_error(fatal, &
 
 7996           "deallocate_overlap_type(mpp_domains_define): overlap is not been allocated")
 
 7998   if(
ASSOCIATED(overlap%tileMe)) 
deallocate(overlap%tileMe)
 
 7999   if(
ASSOCIATED(overlap%tileNbr)) 
deallocate(overlap%tileNbr)
 
 8000   if(
ASSOCIATED(overlap%is)) 
deallocate(overlap%is)
 
 8001   if(
ASSOCIATED(overlap%ie)) 
deallocate(overlap%ie)
 
 8002   if(
ASSOCIATED(overlap%js)) 
deallocate(overlap%js)
 
 8003   if(
ASSOCIATED(overlap%je)) 
deallocate(overlap%je)
 
 8004   if(
ASSOCIATED(overlap%dir)) 
deallocate(overlap%dir)
 
 8005   if(
ASSOCIATED(overlap%index)) 
deallocate(overlap%index)
 
 8006   if(
ASSOCIATED(overlap%rotation)) 
deallocate(overlap%rotation)
 
 8007   if(
ASSOCIATED(overlap%from_contact)) 
deallocate(overlap%from_contact)
 
 8008   if(
ASSOCIATED(overlap%msgsize)) 
deallocate(overlap%msgsize)
 
 8011 end subroutine deallocate_overlap_type
 
 8014 subroutine deallocate_overlapspec(overlap)
 
 8015 type(overlapspec), 
intent(inout) :: overlap
 
 8018    if(
ASSOCIATED(overlap%send)) 
then 
 8019       do n = 1, 
size(overlap%send(:))
 
 8020          call deallocate_overlap_type(overlap%send(n))
 
 8022       deallocate(overlap%send)
 
 8024    if(
ASSOCIATED(overlap%recv)) 
then 
 8025       do n = 1, 
size(overlap%recv(:))
 
 8026          call deallocate_overlap_type(overlap%recv(n))
 
 8028       deallocate(overlap%recv)
 
 8032 end subroutine deallocate_overlapspec
 
 8036 subroutine add_update_overlap( overlap_out, overlap_in)
 
 8037   type(overlap_type), 
intent(inout) :: overlap_out
 
 8038   type(overlap_type), 
intent(in   ) :: overlap_in
 
 8039   type(overlap_type)                :: overlap
 
 8040   integer                          :: count, count_in, count_out, n
 
 8043   count_in  = overlap_in %count
 
 8044   count_out = overlap_out%count
 
 8045   count     = count_in+count_out
 
 8046   if(count_in == 0) 
call mpp_error(fatal, &
 
 8047        "mpp_domains_define.inc(add_update_overlap): overlap_in%count is zero")
 
 8049   if(count_out == 0) 
then 
 8050      if(
associated(overlap_out%tileMe)) 
call mpp_error(fatal, &
 
 8051           "mpp_domains_define.inc(add_update_overlap): overlap is already been allocated but count=0")
 
 8052      call allocate_update_overlap(overlap_out, count_in)
 
 8053      overlap_out%pe  = overlap_in%pe
 
 8055      if(overlap_in%pe .NE. overlap_out%pe) 
call mpp_error(fatal, &
 
 8056           "mpp_domains_define.inc(add_update_overlap): mismatch of pe between overlap_in and overlap_out")
 
 8058      call allocate_update_overlap(overlap, count_out)
 
 8059      overlap%tileMe      (1:count_out) = overlap_out%tileMe      (1:count_out)
 
 8060      overlap%tileNbr     (1:count_out) = overlap_out%tileNbr     (1:count_out)
 
 8061      overlap%is          (1:count_out) = overlap_out%is          (1:count_out)
 
 8062      overlap%ie          (1:count_out) = overlap_out%ie          (1:count_out)
 
 8063      overlap%js          (1:count_out) = overlap_out%js          (1:count_out)
 
 8064      overlap%je          (1:count_out) = overlap_out%je          (1:count_out)
 
 8065      overlap%dir         (1:count_out) = overlap_out%dir         (1:count_out)
 
 8066      overlap%rotation    (1:count_out) = overlap_out%rotation    (1:count_out)
 
 8067      overlap%from_contact(1:count_out) = overlap_out%from_contact(1:count_out)
 
 8068      call deallocate_overlap_type(overlap_out)
 
 8069      call allocate_update_overlap(overlap_out, count)
 
 8070      overlap_out%tileMe      (1:count_out) = overlap%tileMe      (1:count_out)
 
 8071      overlap_out%tileNbr     (1:count_out) = overlap%tileNbr     (1:count_out)
 
 8072      overlap_out%is          (1:count_out) = overlap%is          (1:count_out)
 
 8073      overlap_out%ie          (1:count_out) = overlap%ie          (1:count_out)
 
 8074      overlap_out%js          (1:count_out) = overlap%js          (1:count_out)
 
 8075      overlap_out%je          (1:count_out) = overlap%je          (1:count_out)
 
 8076      overlap_out%dir         (1:count_out) = overlap%dir         (1:count_out)
 
 8077      overlap_out%rotation    (1:count_out) = overlap%rotation    (1:count_out)
 
 8078      overlap_out%index       (1:count_out) = overlap%index       (1:count_out)
 
 8079      overlap_out%from_contact(1:count_out) = overlap%from_contact(1:count_out)
 
 8080      overlap_out%msgsize     (1:count_out) = overlap%msgsize     (1:count_out)
 
 8081      call deallocate_overlap_type(overlap)
 
 8083   overlap_out%count                           = count
 
 8084   overlap_out%tileMe      (count_out+1:count) = overlap_in%tileMe      (1:count_in)
 
 8085   overlap_out%tileNbr     (count_out+1:count) = overlap_in%tileNbr     (1:count_in)
 
 8086   overlap_out%is          (count_out+1:count) = overlap_in%is          (1:count_in)
 
 8087   overlap_out%ie          (count_out+1:count) = overlap_in%ie          (1:count_in)
 
 8088   overlap_out%js          (count_out+1:count) = overlap_in%js          (1:count_in)
 
 8089   overlap_out%je          (count_out+1:count) = overlap_in%je          (1:count_in)
 
 8090   overlap_out%dir         (count_out+1:count) = overlap_in%dir         (1:count_in)
 
 8091   overlap_out%rotation    (count_out+1:count) = overlap_in%rotation    (1:count_in)
 
 8092   overlap_out%from_contact(count_out+1:count) = overlap_in%from_contact(1:count_in)
 
 8094   do n = count_out+1, count
 
 8095      overlap_out%msgsize(n) = (overlap_out%ie(n)-overlap_out%is(n)+1)*(overlap_out%je(n)-overlap_out%js(n)+1)
 
 8099 end subroutine add_update_overlap
 
 8102 subroutine expand_update_overlap_list(overlapList, npes)
 
 8103   type(overlap_type), 
pointer :: overlapList(:)
 
 8104   integer,      
intent(in   ) :: npes
 
 8105   type(overlap_type), 
pointer,
save           :: newlist(:) => null()
 
 8106   integer                                    :: nlist_old, nlist, m
 
 8108   nlist_old = 
size(overlaplist(:))
 
 8109   if(nlist_old .GE. npes) 
call mpp_error(fatal, &
 
 8110      'mpp_domains_define.inc(expand_update_overlap_list): size of overlaplist should be smaller than npes')
 
 8111   nlist = min(npes, 2*nlist_old)
 
 8112   allocate(newlist(nlist))
 
 8114      call add_update_overlap(newlist(m), overlaplist(m))
 
 8115      call deallocate_overlap_type(overlaplist(m))
 
 8118   deallocate(overlaplist)
 
 8119   overlaplist => newlist
 
 8124 end subroutine expand_update_overlap_list
 
 8127 subroutine expand_check_overlap_list(overlaplist, npes)
 
 8128   type(overlap_type), 
pointer :: overlaplist(:)
 
 8129   integer,         
intent(in) :: npes
 
 8130   type(overlap_type), 
pointer,
save           :: newlist(:) => null()
 
 8131   integer                                    :: nlist_old, nlist, m
 
 8133   nlist_old = 
size(overlaplist(:))
 
 8134   if(nlist_old .GE. npes) 
call mpp_error(fatal, &
 
 8135      'mpp_domains_define.inc(expand_check_overlap_list): size of overlaplist should be smaller than npes')
 
 8136   nlist = min(npes, 2*nlist_old)
 
 8137   allocate(newlist(nlist))
 
 8138   do m = 1,
size(overlaplist(:))
 
 8140      call deallocate_overlap_type(overlaplist(m))
 
 8142   deallocate(overlaplist)
 
 8143   overlaplist => newlist
 
 8148 end subroutine expand_check_overlap_list
 
 8152 subroutine check_overlap_pe_order(domain, overlap, name)
 
 8153   type(domain2d),    
intent(in) :: domain
 
 8154   type(overlapspec), 
intent(in) :: overlap
 
 8155   character(len=*),  
intent(in) :: name
 
 8160   if( overlap%nsend > maxlist) 
call mpp_error(fatal, &
 
 8161              "mpp_domains_define.inc(check_overlap_pe_order): overlap%nsend > MAXLIST, increase MAXLIST")
 
 8162   if( overlap%nrecv > maxlist) 
call mpp_error(fatal, &
 
 8163              "mpp_domains_define.inc(check_overlap_pe_order): overlap%nrecv > MAXLIST, increase MAXLIST")
 
 8165   do m = 2, overlap%nsend
 
 8166      pe1 = overlap%send(m-1)%pe
 
 8167      pe2 = overlap%send(m)%pe
 
 8169      if( pe2 == domain%pe ) 
then 
 8170         print*, trim(name)//
" at pe = ", domain%pe, 
": send pe is ", pe1, pe2
 
 8171         call mpp_error(fatal, &
 
 8172              "mpp_domains_define.inc(check_overlap_pe_order): send pe2 can not equal to domain%pe")
 
 8173      else if( (pe1 > domain%pe .AND. pe2 > domain%pe) .OR. (pe1 < domain%pe .AND. pe2 < domain%pe)) 
then 
 8174         if( pe2 < pe1 ) 
then 
 8175            print*, trim(name)//
" at pe = ", domain%pe, 
": send pe is ", pe1, pe2
 
 8176            call mpp_error(fatal, &
 
 8177              "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for send 1")
 
 8179      else if ( pe2 > domain%pe .AND. pe1 < domain%pe ) 
then 
 8180         print*, trim(name)//
" at pe = ", domain%pe, 
": send pe is ", pe1, pe2
 
 8181         call mpp_error(fatal, &
 
 8182              "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for send 2")
 
 8187   do m = 2, overlap%nrecv
 
 8188      pe1 = overlap%recv(m-1)%pe
 
 8189      pe2 = overlap%recv(m)%pe
 
 8191      if( pe2 == domain%pe ) 
then 
 8192         print*, trim(name)//
" at pe = ", domain%pe, 
": recv pe is ", pe1, pe2
 
 8193         call mpp_error(fatal, &
 
 8194              "mpp_domains_define.inc(check_overlap_pe_order): recv pe2 can not equal to domain%pe")
 
 8195      else if( (pe1 > domain%pe .AND. pe2 > domain%pe) .OR. (pe1 < domain%pe .AND. pe2 < domain%pe)) 
then 
 8196         if( pe2 > pe1 ) 
then 
 8197            print*, trim(name)//
" at pe = ", domain%pe, 
": recv pe is ", pe1, pe2
 
 8198            call mpp_error(fatal, &
 
 8199              "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for recv 1")
 
 8201      else if ( pe2 < domain%pe .AND. pe1 > domain%pe ) 
then 
 8202         print*, trim(name)//
" at pe = ", domain%pe, 
": recv pe is ", pe1, pe2
 
 8203         call mpp_error(fatal, &
 
 8204              "mpp_domains_define.inc(check_overlap_pe_order): pe is not in right order for recv 2")
 
 8209 end subroutine check_overlap_pe_order
 
 8213 subroutine set_domain_comm_inf(update)
 
 8214   type(overlapspec), 
intent(inout) :: update
 
 8216   integer :: m, totsize, n
 
 8222      do m = 1, update%nrecv
 
 8224         do n = 1, update%recv(m)%count
 
 8225            totsize = totsize + update%recv(m)%msgsize(n)
 
 8227         update%recv(m)%totsize = totsize
 
 8229            update%recv(m)%start_pos = 0
 
 8231            update%recv(m)%start_pos = update%recv(m-1)%start_pos + update%recv(m-1)%totsize
 
 8233         update%recvsize = update%recvsize + totsize
 
 8236      do m = 1, update%nsend
 
 8238         do n = 1, update%send(m)%count
 
 8239            totsize = totsize + update%send(m)%msgsize(n)
 
 8241         update%send(m)%totsize = totsize
 
 8243            update%send(m)%start_pos = 0
 
 8245            update%send(m)%start_pos = update%send(m-1)%start_pos + update%send(m-1)%totsize
 
 8247         update%sendsize = update%sendsize + totsize
 
 8253 end subroutine set_domain_comm_inf
 
subroutine mpp_modify_domain2d(domain_in, domain_out, isc, iec, jsc, jec, isg, ieg, jsg, jeg, whalo, ehalo, shalo, nhalo)
subroutine set_check_overlap(domain, position)
set up the overlapping for boundary check if the domain is symmetry. The check will be done on curren...
subroutine apply_cyclic_offset(lstart, lend, offset, gstart, gend, gsize)
add offset to the index
logical function mpp_mosaic_defined()
Accessor function for value of mosaic_defined.
subroutine set_contact_point(domain, position)
this routine sets the overlapping between tiles for E,C,N-cell based on T-cell overlapping
subroutine mpp_define_domains1d(global_indices, ndivs, domain, pelist, flags, halo, extent, maskmap, memory_size, begin_halo, end_halo)
Define data and computational domains on a 1D set of data (isg:ieg) and assign them to PEs.
subroutine set_bound_overlap(domain, position)
set up the overlapping for boundary if the domain is symmetry.
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)
compute the overlapping between tiles for the T-cell.
subroutine mpp_define_mosaic_pelist(sizes, pe_start, pe_end, pelist, costpertile)
Defines a pelist for use with mosaic tiles.
subroutine mpp_define_io_domain(domain, io_layout)
Define the layout for IO pe's for the given domain.
subroutine mpp_compute_extent(isg, ieg, ndivs, ibegin, iend, extent)
Computes extents for a grid decomposition with the given indices and divisions.
subroutine mpp_modify_domain1d(domain_in, domain_out, cbegin, cend, gbegin, gend, hbegin, hend)
Modifies the exents of a domain.
subroutine compute_overlaps_fold_west(domain, position, ishift, jshift)
Computes remote domain overlaps assumes only one in each direction will calculate the overlapping for...
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)
Defines a domain for mosaic tile grids.
subroutine fill_contact(Contact, tile, is1, ie1, js1, je1, is2, ie2, js2, je2, align1, align2, refine1, refine2)
always fill the contact according to index order.
subroutine mpp_define_layout2d(global_indices, ndivs, layout)
subroutine add_check_overlap(overlap_out, overlap_in)
this routine adds the overlap_in into overlap_out
subroutine mpp_compute_block_extent(isg, ieg, ndivs, ibegin, iend)
Computes the extents of a grid block.
subroutine compute_overlaps(domain, position, update, check, ishift, jshift, x_cyclic_offset, y_cyclic_offset, whalo, ehalo, shalo, nhalo)
Computes remote domain overlaps.
subroutine mpp_get_domain_shift(domain, ishift, jshift, position)
Returns the shift value in x and y-direction according to domain position..
subroutine compute_overlaps_fold_east(domain, position, ishift, jshift)
computes remote domain overlaps assumes only one in each direction will calculate the overlapping for...
subroutine compute_overlaps_fold_south(domain, position, ishift, jshift)
Computes remote domain overlaps assumes only one in each direction will calculate the overlapping for...
subroutine set_overlaps(domain, overlap_in, overlap_out, whalo_out, ehalo_out, shalo_out, nhalo_out)
this routine sets up the overlapping for mpp_update_domains for arbitrary halo update....
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)
Define 2D data and computational domain on global rectilinear cartesian domain (isg:ieg,...
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
integer function stdout()
This function returns the current standard fortran unit numbers for output.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
subroutine mpp_declare_pelist(pelist, name, commID)
Declare a pelist.
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
integer function mpp_npes()
Returns processor count for current pelist.
integer function mpp_pe()
Returns processor ID.