!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
!BOP
! !MODULE: ice_blocks


 module ice_blocks 40,5

!
! !DESCRIPTION: 
!  This module contains data types and tools for decomposing a global
!  horizontal domain into a set of blocks.  It contains a data type 
!  for describing each block and contains routines for creating and 
!  querying the block decomposition for a global domain.
!
! !REVISION HISTORY:
!  SVN:$Id: ice_blocks.F90 100 2008-01-29 00:25:32Z eclare $
!
! author: Phil Jones, LANL
! Oct. 2004: Adapted from POP by William H. Lipscomb, LANL
!
! !USES:

   use ice_kinds_mod
   use ice_exit
   use ice_domain_size

   implicit none
   private
   save

! !PUBLIC TYPES:

   type, public :: block   ! block data type
      integer (int_kind) :: &
         block_id           ,&! global block number
         local_id           ,&! local address of block in current distrib
         ilo, ihi, jlo, jhi ,&! begin, end indices for physical domain
         iblock, jblock       ! cartesian i,j position for block

      logical (log_kind) :: &
         tripole,           & ! flag is true if block is at tripole bndy
         tripoleTFlag         ! tripole boundary is a T-fold

      integer (int_kind), dimension(:), pointer :: &
         i_glob, j_glob     ! global domain location for each point
   end type

! !PUBLIC MEMBER FUNCTIONS:

   public :: create_blocks       ,&
             get_block           ,&
             get_block_parameter ,&
             ice_blocksGetNbrID

   public :: LocateTrouble,PrintTrouble

   interface PrintTrouble
       module procedure PrintTrouble_dbl, PrintTrouble_int
   end interface

! !DEFINED PARAMETERS:

   integer (int_kind), parameter, public :: &
      nghost = 1       ! number of ghost cells around each block

   integer (int_kind), parameter, public :: &! size of block domain in
      nx_block = block_size_x + 2*nghost,   &!  x,y dir including ghost
      ny_block = block_size_y + 2*nghost     !  cells 

   ! predefined directions for neighbor id routine
   ! Note: the directions that are commented out are implemented in 
   !       POP but not in CICE.  If the tripole cut were in the south
   !       instead of the north, these would need to be used (and also
   !       implemented in ice_boundary.F90).
   integer (int_kind), parameter, public :: &
      ice_blocksNorth          =  1,      & ! (i  ,j+1)
      ice_blocksSouth          =  2,      & ! (i  ,j-1)
      ice_blocksEast           =  3,      & ! (i+1,j  )
      ice_blocksWest           =  4,      & ! (i-1,j  )
      ice_blocksNorthEast      =  5,      & ! (i+1,j+1)
      ice_blocksNorthWest      =  6,      & ! (i-1,j+1)
      ice_blocksSouthEast      =  7,      & ! (i+1,j-1)
      ice_blocksSouthWest      =  8         ! (i-1,j-1)
   integer (int_kind), parameter, public :: &
!      ice_blocksNorth2         =  9,      & ! (i  ,j+2)
!      ice_blocksSouth2         = 10,      & ! (i  ,j-2)
      ice_blocksEast2          = 11,      & ! (i+2,j  )
      ice_blocksWest2          = 12         ! (i-2,j  )
!      ice_blocksNorthEast2     = 13,      & ! (i+2,j+2)
!      ice_blocksNorthWest2     = 14,      & ! (i-2,j+2)
!      ice_blocksSouthEast2     = 15,      & ! (i+2,j-2)
!      ice_blocksSouthWest2     = 16         ! (i-2,j-2)
   integer (int_kind), parameter, public :: &
      ice_blocksEastNorthEast  = 17,      & ! (i+2,j+1)
!      ice_blocksEastSouthEast  = 18,      & ! (i+2,j-1)
      ice_blocksWestNorthWest  = 19         ! (i-2,j+1)
!      ice_blocksWestSouthWest  = 20,      & ! (i-2,j-1)
!      ice_blocksNorthNorthEast = 21,      & ! (i+1,j-2)
!      ice_blocksSouthSouthEast = 22,      & ! (i+1,j-2)
!      ice_blocksNorthNorthWest = 23,      & ! (i-1,j+2)
!      ice_blocksSouthSouthWest = 24         ! (i-1,j-2)

! !PUBLIC DATA MEMBERS:

   integer (int_kind), public :: &
      nblocks_tot      ,&! total number of blocks in decomposition
      nblocks_x        ,&! tot num blocks in i direction
      nblocks_y          ! tot num blocks in j direction

   integer (int_kind), public, parameter ::  &
		trouble_ig = 2, &
		trouble_jg = 2
				
   integer (int_kind), public :: trouble_il,trouble_jl,trouble_ibl

!EOP
!BOC
!-----------------------------------------------------------------------
!
!  module private data
!
!-----------------------------------------------------------------------

   type (block), dimension(:), allocatable :: &
      all_blocks         ! block information for all blocks in domain

   integer (int_kind), dimension(:,:),allocatable :: &
      all_blocks_ij      ! block index stored in Cartesian order
                         !   useful for determining block index
                         !   of neighbor blocks

   integer (int_kind), dimension(:,:), allocatable, target :: &
      i_global,         &! global i index for each point in each block
      j_global           ! global j index for each point in each block

!EOC
!***********************************************************************

contains


   subroutine PrintTrouble_dbl(name,array) 1,1

     use ice_fileunits, only: nu_diag

     character(len=*), intent(in) :: name
     real(kind=dbl_kind), intent(in)         :: array(nx_block,ny_block) 
       
     write(nu_diag,*) TRIM(name),'(i,j) =',array(trouble_il,trouble_jl)

   end subroutine PrintTrouble_dbl


   subroutine PrintTrouble_int(name,array) 1,1

     use ice_fileunits, only: nu_diag

     character(len=*), intent(in) :: name
     integer(int_kind), intent(in)         :: array(nx_block,ny_block) 
        
     write(nu_diag,*) TRIM(name),'(i,j) =',array(trouble_il,trouble_jl)

   end subroutine PrintTrouble_int


   subroutine LocateTrouble

     type (block) :: this_block
     integer(int_kind) :: n,gbid,ib,ie,jb,je,ig,jg,i,j
     integer(int_kind) :: j_save,i_save,ib_save
     logical  :: foundi, foundj
    

      do n=1,nblocks_tot
	  foundi=.false.;foundj=.false.
	  gbid = all_blocks(n)%block_id
	  ib   = all_blocks(n)%ilo
	  ie   = all_blocks(n)%ihi
	  jb   = all_blocks(n)%jlo
          je   = all_blocks(n)%jhi
	  do i=ib,ie
	     ig=all_blocks(n)%i_glob(i) 
	     if(ig == trouble_ig) then 
		i_save=i
		foundi=.true.
	     endif
          enddo
	  do j=jb,je
	     jg=all_blocks(n)%j_glob(j) 
	     if(jg == trouble_jg) then
		j_save=j;foundj=.true.
	     endif
          enddo
          if(foundi .and. foundj) then 
		ib_save = n
	  endif
      enddo
      trouble_il  = i_save
      trouble_jl  = j_save
      trouble_ibl = ib_save
!      print *,'Trouble located: ib, i, j: ',ib_save,i_save,j_save

   end subroutine LocateTrouble




!***********************************************************************
!BOP
! !IROUTINE: create_blocks
! !INTERFACE:


 subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & 2,14
                                                ns_boundary_type)

! !DESCRIPTION:
!  This subroutine decomposes the global domain into blocks and
!  fills the data structures with all the necessary block information.
!
! !REVISION HISTORY: 
!  same as module
!
! !USES:

   use ice_fileunits, only: nu_diag
   use ice_communicate, only: my_task, master_task

! !INPUT PARAMETERS:

   integer (int_kind), intent(in) :: &
      nx_global, ny_global           ! global domain size in x,y

   character (*), intent(in) :: &
      ew_boundary_type,  &! type of boundary in logical east-west dir
      ns_boundary_type    ! type of boundary in logical north-south dir

!EOP
!BOC
!----------------------------------------------------------------------
!
!  local variables
!
!----------------------------------------------------------------------

   integer (int_kind) :: &
      i, ip1, j, jp1, n    ,&! loop indices
      iblock, jblock       ,&! block loop indices
      is, ie, js, je         ! temp start, end indices

   logical (log_kind) :: dbug

!----------------------------------------------------------------------
!
!  compute number of blocks and cartesian decomposition
!  if the requested block size does not divide the global domain
!  size evenly, add additional block space to accomodate padding
!
!----------------------------------------------------------------------

   nblocks_x   = (nx_global-1)/block_size_x + 1
   nblocks_y   = (ny_global-1)/block_size_y + 1
   nblocks_tot = nblocks_x*nblocks_y

!----------------------------------------------------------------------
!
!  allocate block arrays
!
!----------------------------------------------------------------------

   allocate(all_blocks(nblocks_tot))
   allocate(i_global(nx_block,nblocks_tot), &
            j_global(ny_block,nblocks_tot))
   allocate(all_blocks_ij(nblocks_x,nblocks_y))

!----------------------------------------------------------------------
!
!  fill block data structures for all blocks in domain
!
!----------------------------------------------------------------------

   n = 0
   do jblock=1,nblocks_y
      js = (jblock-1)*block_size_y + 1
      if (js > ny_global) call abort_ice(&
            'ice: create_blocks: Bad block decomp: ny_block too large?')
      je = js + block_size_y - 1
      if (je > ny_global) je = ny_global ! pad array

      do iblock=1,nblocks_x
         n = n + 1  ! global block id

         is = (iblock-1)*block_size_x + 1
         if (is > nx_global) call abort_ice(&
            'ice: create_blocks: Bad block decomp: nx_block too large?')
         ie = is + block_size_x - 1
         if (ie > nx_global) ie = nx_global

         all_blocks(n)%block_id = n
         all_blocks(n)%iblock   = iblock
         all_blocks(n)%jblock   = jblock
         all_blocks(n)%ilo      = nghost + 1
         all_blocks(n)%jlo      = nghost + 1
         all_blocks(n)%ihi      = nx_block - nghost ! default value
         all_blocks(n)%jhi      = ny_block - nghost ! default value

         if (jblock == nblocks_y .and. &
             (ns_boundary_type == 'tripole' .or. &
             ns_boundary_type == 'tripoleT')) then
             all_blocks(n)%tripole = .true.
         else
             all_blocks(n)%tripole = .false.
         endif
         all_blocks(n)%tripoleTFlag = (ns_boundary_type == 'tripoleT')

         all_blocks_ij(iblock,jblock) = n

         do j=1,ny_block
            j_global(j,n) = js - nghost + j - 1

            !*** southern ghost cells

            if (j_global(j,n) < 1) then
               select case (ns_boundary_type)
               case ('cyclic')
                  j_global(j,n) = j_global(j,n) + ny_global
               case ('open')
                  j_global(j,n) = nghost - j + 1
               case ('closed')
                  j_global(j,n) = 0
               case ('tripole')
                  j_global(j,n) = nghost - j + 1 ! open
               case ('tripoleT')
                  j_global(j,n) = -j_global(j,n) + 1 ! open
               case default
                  call abort_ice(&
                           'ice: create_blocks: unknown n-s bndy type')
               end select
            endif

            !*** padding required

            if (j_global(j,n) > ny_global + nghost) then
               j_global(j,n) = 0   ! padding

            !*** northern ghost cells

            else if (j_global(j,n) > ny_global) then
               select case (ns_boundary_type)
               case ('cyclic')
                  j_global(j,n) = j_global(j,n) - ny_global
               case ('open')
                  j_global(j,n) = 2*ny_global - j_global(j,n) + 1
               case ('closed')
                  j_global(j,n) = 0
               case ('tripole')
                  j_global(j,n) = -j_global(j,n)
               case ('tripoleT')
                  j_global(j,n) = -j_global(j,n)
               case default
                  call abort_ice(&
                           'ice: create_blocks: unknown n-s bndy type')
               end select

            !*** set last physical point if padded domain

            else if (j_global(j,n) == ny_global .and. &
                     j > all_blocks(n)%jlo      .and. &
                     j < all_blocks(n)%jhi) then
               all_blocks(n)%jhi = j   ! last physical point in padded domain
            endif
         end do

         all_blocks(n)%j_glob => j_global(:,n)

         do i=1,nx_block
            i_global(i,n) = is - nghost + i - 1

            !*** western ghost cells

            if (i_global(i,n) < 1) then
               select case (ew_boundary_type)
               case ('cyclic')
                  i_global(i,n) = i_global(i,n) + nx_global
               case ('open')
                  i_global(i,n) = nghost - i + 1
               case ('closed')
                  i_global(i,n) = 0
               case default
                  call abort_ice(&
                           'ice: create_blocks: unknown e-w bndy type')
               end select
            endif

            !*** padded domain - fill padded region with zero

            if (i_global(i,n) > nx_global + nghost) then
               i_global(i,n) = 0

            !*** eastern ghost cells

            else if (i_global(i,n) > nx_global) then
               select case (ew_boundary_type)
               case ('cyclic')
                  i_global(i,n) = i_global(i,n) - nx_global
               case ('open')
                  i_global(i,n) = 2*nx_global - i_global(i,n) + 1
               case ('closed')
                  i_global(i,n) = 0
               case default
                  call abort_ice(&
                           'ice: create_blocks: unknown e-w bndy type')
               end select

            !*** last physical point in padded domain

            else if (i_global(i,n) == nx_global .and. &
                     i > all_blocks(n)%ilo      .and. &
                     i < all_blocks(n)%ihi) then
               all_blocks(n)%ihi = i
            endif
         end do

         all_blocks(n)%i_glob => i_global(:,n)

      end do
   end do

!   dbug = .true.
   dbug = .false.
   if (dbug) then
      if (my_task == master_task) then
         write(nu_diag,*) 'block i,j locations'
         do n = 1, nblocks_tot
            write(nu_diag,*) 'block id, iblock, jblock:', &
            all_blocks(n)%block_id, &
            all_blocks(n)%iblock,   & 
            all_blocks(n)%jblock
         enddo
      endif
   endif

!EOC
!----------------------------------------------------------------------

end subroutine create_blocks

!***********************************************************************
!BOP
! !IROUTINE: ice_blocksGetNbrID
! !INTERFACE:


 function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & 24,20
                             result (nbrID)

! !DESCRIPTION:
!  This function returns the block id of a neighboring block in a
!  requested direction.  Directions:
!      ice\_blocksNorth             (i  ,j+1)
!      ice\_blocksSouth             (i  ,j-1)
!      ice\_blocksEast              (i+1,j  )
!      ice\_blocksWest              (i-1,j  )
!      ice\_blocksNorthEast         (i+1,j+1)
!      ice\_blocksNorthWest         (i-1,j+1)
!      ice\_blocksSouthEast         (i  ,j-1)
!      ice\_blocksSouthWest         (i-1,j-1)
!      ice\_blocksNorth2            (i  ,j+2)
!      ice\_blocksSouth2            (i  ,j-2)
!      ice\_blocksEast2             (i+2,j  )
!      ice\_blocksWest2             (i-2,j  )
!      ice\_blocksNorthEast2        (i+2,j+2)
!      ice\_blocksNorthWest2        (i-2,j+2)
!      ice\_blocksSouthEast2        (i+2,j-2)
!      ice\_blocksSouthWest2        (i-2,j-2)
!      ice\_blocksEastNorthEast     (i+2,j+1)
!      ice\_blocksEastSouthEast     (i+2,j-1)
!      ice\_blocksWestNorthWest     (i-2,j+1)
!      ice\_blocksWestSouthWest     (i-2,j-1)
!      ice\_blocksNorthNorthEast    (i+1,j-2)
!      ice\_blocksSouthSouthEast    (i+1,j-2)
!      ice\_blocksNorthNorthWest    (i-1,j+2)
!      ice\_blocksSouthSouthWest    (i-1,j-2)
!

! !INPUT PARAMETERS:

   integer (int_kind), intent(in)  :: &
      blockID,       &! id of block for which neighbor id requested
      direction       ! direction for which to look for neighbor -
                      !   must be one of the predefined module
                      !   variables for block direction

   character (*), intent(in) :: &
      iBoundary,     &! determines what to do at edges of domain
      jBoundary       !  options are - open, closed, cyclic, tripole, tripoleT

! !OUTPUT PARAMETERS:

   integer (int_kind) :: &
      nbrID           ! block ID of neighbor in requested dir

!EOP
!BOC
!----------------------------------------------------------------------
!
!  local variables
!
!----------------------------------------------------------------------
    
   integer (int_kind) :: &
      iBlock, jBlock,  &! i,j block location of current block
      inbr,   jnbr      ! i,j block location of neighboring block

!----------------------------------------------------------------------
!
!  retrieve info for current block
!
!----------------------------------------------------------------------

   call get_block_parameter(blockID, iblock=iBlock, jblock=jBlock)

!----------------------------------------------------------------------
!
!  compute i,j block location of neighbor
!
!----------------------------------------------------------------------

   select case(direction)

   case (ice_blocksNorth)

      inbr = iBlock
      jnbr = jBlock + 1
      if (jnbr > nblocks_y) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = 1
         case ('tripole':'tripoleT')
            !*** return negative j value to flag tripole
            !*** i index of main northern neighbor across the
            !*** tripole cut - may also need i+1,i-1 to get
            !*** other points if there has been padding or
            !*** if the block size does not divide the domain
            !*** evenly
            inbr =  nblocks_x - iBlock + 1 
            jnbr = -jBlock
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown north boundary')
         end select
      endif

   case (ice_blocksSouth)

      inbr = iBlock
      jnbr = jBlock - 1
      if (jnbr < 1) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = nblocks_y
         case ('tripole')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('tripoleT')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown south boundary')
         end select
      endif

   case (ice_blocksEast )

      inbr = iBlock + 1
      jnbr = jBlock
      if (inbr > nblocks_x) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = 1
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown east boundary')
         end select
      endif

   case (ice_blocksWest )

      jnbr = jBlock
      inbr = iBlock - 1
      if (inbr < 1) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = nblocks_x
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown west boundary')
         end select
      endif

   case (ice_blocksNorthEast)

      inbr = iBlock + 1
      jnbr = jBlock + 1
      if (inbr > nblocks_x) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = 1
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown east boundary')
         end select
      endif
      if (jnbr > nblocks_y) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = 1
         case ('tripole':'tripoleT')
            !*** return negative j value to flag tripole
            !*** i index of main northern neighbor across the
            !*** tripole cut - may also need i+1,i-1 to get
            !*** other points if there has been padding or
            !*** if the block size does not divide the domain
            !*** evenly
            inbr =  nblocks_x - iBlock 
            if (inbr == 0) inbr = nblocks_x
            jnbr = -jBlock
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown north boundary')
         end select
      endif

   case (ice_blocksNorthWest)

      inbr = iBlock - 1
      jnbr = jBlock + 1
      if (inbr < 1) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = nblocks_x
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown west boundary')
         end select
      endif
      if (jnbr > nblocks_y) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = 1
         case ('tripole':'tripoleT')
            !*** return negative j value to flag tripole
            !*** i index of main northern neighbor across the
            !*** tripole cut - may also need i+1,i-1 to get
            !*** other points if there has been padding or
            !*** if the block size does not divide the domain
            !*** evenly
            inbr =  nblocks_x - iBlock + 2 
            if (inbr > nblocks_x) inbr = 1
            jnbr = -jBlock
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown north boundary')
         end select
      endif

   case (ice_blocksSouthEast )

      inbr = iBlock + 1
      jnbr = jBlock - 1
      if (inbr > nblocks_x) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = 1
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown east boundary')
         end select
      endif
      if (jnbr < 1) then
         select case(jBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = nblocks_y
         case ('tripole')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('tripoleT')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown south boundary')
         end select
      endif

   case (ice_blocksSouthWest )
      inbr = iBlock - 1
      jnbr = jBlock - 1
      if (inbr < 1) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = nblocks_x
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown west boundary')
         end select
      endif
      if (jnbr < 1) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = nblocks_y
         case ('tripole')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('tripoleT')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown south boundary')
         end select
      endif

   case (ice_blocksEast2)

      inbr = iBlock + 2
      jnbr = jBlock
      if (inbr > nblocks_x) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = inbr - nblocks_x
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown east boundary')
         end select
      endif

   case (ice_blocksWest2)
      jnbr = jBlock
      inbr = iBlock - 2
      if (inbr < 1) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = nblocks_x + inbr
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown west boundary')
         end select
      endif

   case (ice_blocksEastNorthEast)

      inbr = iBlock + 2
      jnbr = jBlock + 1
      if (inbr > nblocks_x) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = inbr - nblocks_x
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown east boundary')
         end select
      endif
      if (jnbr > nblocks_y) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = jnbr - nblocks_y
         case ('tripole':'tripoleT')
            !*** return negative j value to flag tripole
            !*** i index of main northern neighbor across the
            !*** tripole cut - may also need i+1,i-1 to get
            !*** other points if there has been padding or
            !*** if the block size does not divide the domain
            !*** evenly
            inbr =  nblocks_x - iBlock - 1 
            if (inbr <= 0) inbr = inbr + nblocks_x
            jnbr = -jBlock
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown north boundary')
         end select
      endif

   case (ice_blocksWestNorthWest)

      inbr = iBlock - 2
      jnbr = jBlock + 1
      if (inbr < 1) then
         select case(iBoundary)
         case ('open')
            inbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            inbr = 0
         case ('cyclic')
            inbr = nblocks_x + inbr
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown west boundary')
         end select
      endif
      if (jnbr > nblocks_y) then
         select case(jBoundary)
         case ('open')
            jnbr = 0 ! do not write into the neighbor's ghost cells
         case ('closed')
            jnbr = 0
         case ('cyclic')
            jnbr = jnbr + nblocks_y
         case ('tripole':'tripoleT')
            !*** return negative j value to flag tripole
            !*** i index of main northern neighbor across the
            !*** tripole cut - may also need i+1,i-1 to get
            !*** other points if there has been padding or
            !*** if the block size does not divide the domain
            !*** evenly
            inbr =  nblocks_x - iBlock + 3
            if (inbr > nblocks_x) inbr = inbr - nblocks_x
            jnbr = -jBlock
         case default
            call abort_ice( &
               'ice_blocksGetNbrID: unknown north boundary')
         end select
      endif

   case default

      call abort_ice( &
          'ice_blocksGetNbrID: unknown direction')
      return

   end select

!----------------------------------------------------------------------
!
!  now get block id for this neighbor block
!
!----------------------------------------------------------------------

   if (inbr > 0 .and. jnbr > 0) then
      nbrID = all_blocks_ij(inbr,jnbr)
   else if (inbr > 0 .and. jnbr < 0) then  ! tripole upper boundary
      !*** return negative value to flag tripole
      nbrID = -all_blocks_ij(inbr,abs(jnbr))
   else
      nbrID = 0   ! neighbor outside domain
   endif

!----------------------------------------------------------------------
!EOC

 end function ice_blocksGetNbrID

!**********************************************************************
!BOP
! !IROUTINE: get_block
! !INTERFACE:


 function get_block(block_id,local_id) 247,2

! !DESCRIPTION:
!  This function returns the block data structure for the block
!  associated with the input block id.
!
! !REVISION HISTORY:
!  same as module
!
! !INPUT PARAMETERS:

   integer (int_kind), intent(in) :: &
      block_id,   &! global block id for requested block info
      local_id     ! local  block id to assign to this block

! !OUTPUT PARAMETERS:

   type (block) :: &
      get_block    ! block information returned for requested block

!EOP
!BOC
!----------------------------------------------------------------------
!
!  check for valid id.  if valid, return block info for requested block
!
!----------------------------------------------------------------------

   if (block_id < 1 .or. block_id > nblocks_tot) then
      call abort_ice('ice: get_block: invalid block_id')
   endif

   get_block = all_blocks(block_id)
   get_block%local_id = local_id

!----------------------------------------------------------------------
!EOC

 end function get_block

!**********************************************************************
!BOP
! !IROUTINE: get_block_parameter
! !INTERFACE:


 subroutine get_block_parameter(block_id, local_id,           &  33,2
                                ilo, ihi, jlo, jhi,           &
                                iblock, jblock, tripole,      &
                                i_glob, j_glob)

! !DESCRIPTION:
!  This routine returns requested parts of the block data type
!  for the block associated with the input block id
!
! !REVISION HISTORY:
!  same as module
!
! !INPUT PARAMETERS:

   integer (int_kind), intent(in) :: &
      block_id   ! global block id for which parameters are requested

! !OUTPUT PARAMETERS:

   !(optional) parts of block data type to extract if requested

   integer (int_kind), intent(out), optional :: &
      local_id           ,&! local id assigned to block in current distrb
      ilo, ihi, jlo, jhi ,&! begin,end indices for physical domain
      iblock, jblock       ! cartesian i,j position for bloc

   logical (log_kind), intent(out), optional :: &
      tripole              ! flag is true if block on tripole bndy

   integer (int_kind), dimension(:), pointer, optional :: &
      i_glob, j_glob     ! global domain location for each point

!EOP
!BOC
!----------------------------------------------------------------------
!
!  extract each component of data type if requested
!
!----------------------------------------------------------------------

   if (block_id < 1 .or. block_id > nblocks_tot) then
      call abort_ice('ice: get_block_parameter: invalid block_id')
   endif

   if (present(local_id)) local_id = all_blocks(block_id)%local_id
   if (present(ilo     )) ilo      = all_blocks(block_id)%ilo
   if (present(ihi     )) ihi      = all_blocks(block_id)%ihi
   if (present(jlo     )) jlo      = all_blocks(block_id)%jlo
   if (present(jhi     )) jhi      = all_blocks(block_id)%jhi
   if (present(iblock  )) iblock   = all_blocks(block_id)%iblock
   if (present(jblock  )) jblock   = all_blocks(block_id)%jblock
   if (present(i_glob  )) i_glob   => all_blocks(block_id)%i_glob
   if (present(j_glob  )) j_glob   => all_blocks(block_id)%j_glob
   if (present(tripole )) tripole  = all_blocks(block_id)%tripole

!----------------------------------------------------------------------
!EOC

 end subroutine get_block_parameter

!**********************************************************************

 end module ice_blocks

!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||