module grid_comm
  !***************************************************************
  !--- Grid related routines used by multiple modules
  !---
  !--- Larry Solheim  ...Mar,2017
  !***************************************************************

  use com_cpl

  implicit none

  public

  !--- Generic interface for a routine that will strip overlap longitudes
  !--- from the input NEMO coordinate data field
  interface resize_nemo_field
    module procedure resize_nemo_field_i4
    module procedure resize_nemo_field_i8
    module procedure resize_nemo_field_r4
    module procedure resize_nemo_field_r8
  end interface
  private :: resize_nemo_field_i4
  private :: resize_nemo_field_i8
  private :: resize_nemo_field_r4
  private :: resize_nemo_field_r8

  contains

    !***************************************************************************
    !--- Remove first and last overlap longitudes from a real*4 NEMO field
    !***************************************************************************
    subroutine resize_nemo_field_r4(afld, corner)
      real(kind=4), pointer, intent(inout) :: afld(:,:)
      logical, intent(in), optional :: corner

      !--- Local
      real(kind=4), pointer, dimension(:,:) :: wrk2d=>null()
      integer :: nx, ny
      logical :: corn

      if ( present(corner) ) then
        corn = corner
      else
        corn = .false.
      endif

      if ( .not. associated(afld) ) then
        write(6,*)"resize_nemo_field_r4: Input array is not allocated."
        call xit("resize_nemo_field_r4",-1)
      endif

      if ( nemo_jpiglo > 0 .and. nemo_jpjglo > 0 ) then
        !--- Verify that the array dimensions are consistent with
        !--- the shape of the global NEMO domain
        !--- nemo_jpiglo and nemo_jpjglo are passed to the coupler at runtime
        if ( corn ) then
          !--- The corner arrays will have 1 extra row and column
          if ( size(afld,dim=1) /= nemo_jpiglo+1 .or. &
               size(afld,dim=2) /= nemo_jpjglo+1 ) then
            write(6,*)"resize_nemo_field_r4: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo+1,nemo_jpjglo+1
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_r4",-1)
          endif
        else
          if ( size(afld,dim=1) /= nemo_jpiglo .or. &
               size(afld,dim=2) /= nemo_jpjglo ) then
            write(6,*)"resize_nemo_field_r4: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo,nemo_jpjglo
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_r4",-2)
          endif
        endif
      endif

      !--- Remove the first and last column (ie lon) from this array
      nx = size(afld,dim=1) - 2
      ny = size(afld,dim=2)

      allocate( wrk2d(nx,ny) )
      wrk2d(1:nx,1:ny) = afld(2:nx+1,1:ny)

      deallocate( afld )
      allocate( afld(nx,ny) )
      afld = wrk2d

      deallocate( wrk2d )

    end subroutine resize_nemo_field_r4

    !***************************************************************************
    !--- Remove first and last overlap longitudes from a real*8 NEMO field
    !***************************************************************************
    subroutine resize_nemo_field_r8(afld, corner)
      real(kind=8), pointer, intent(inout) :: afld(:,:)
      logical, intent(in), optional :: corner

      !--- Local
      real(kind=8), pointer, dimension(:,:) :: wrk2d=>null()
      integer :: nx, ny
      logical :: corn

      if ( present(corner) ) then
        corn = corner
      else
        corn = .false.
      endif

      if ( .not. associated(afld) ) then
        write(6,*)"resize_nemo_field_r8: Input array is not allocated."
        call xit("resize_nemo_field_r8",-1)
      endif

      if ( nemo_jpiglo > 0 .and. nemo_jpjglo > 0 ) then
        !--- Verify that the array dimensions are consistent with
        !--- the shape of the global NEMO domain
        !--- nemo_jpiglo and nemo_jpjglo are passed to the coupler at runtime
        if ( corn ) then
          !--- The corner arrays will have 1 extra row and column
          if ( size(afld,dim=1) /= nemo_jpiglo+1 .or. &
               size(afld,dim=2) /= nemo_jpjglo+1 ) then
            write(6,*)"resize_nemo_field_r8: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo+1,nemo_jpjglo+1
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_r8",-1)
          endif
        else
          if ( size(afld,dim=1) /= nemo_jpiglo .or. &
               size(afld,dim=2) /= nemo_jpjglo ) then
            write(6,*)"resize_nemo_field_r8: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo,nemo_jpjglo
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_r8",-2)
          endif
        endif
      endif

      !--- Remove the first and last column (ie lon) from this array
      nx = size(afld,dim=1) - 2
      ny = size(afld,dim=2)

      allocate( wrk2d(nx,ny) )
      wrk2d(1:nx,1:ny) = afld(2:nx+1,1:ny)

      deallocate( afld )
      allocate( afld(nx,ny) )
      afld = wrk2d

      deallocate( wrk2d )

    end subroutine resize_nemo_field_r8

    !***************************************************************************
    !--- Remove first and last overlap longitudes from a integer*4 NEMO field
    !***************************************************************************
    subroutine resize_nemo_field_i4(afld, corner)
      integer(kind=4), pointer, intent(inout) :: afld(:,:)
      logical, intent(in), optional :: corner

      !--- Local
      integer(kind=4), pointer, dimension(:,:) :: wrk2d=>null()
      integer :: nx, ny
      logical :: corn

      if ( present(corner) ) then
        corn = corner
      else
        corn = .false.
      endif

      if ( .not. associated(afld) ) then
        write(6,*)"resize_nemo_field_i4: Input array is not allocated."
        call xit("resize_nemo_field_i4",-1)
      endif

      if ( nemo_jpiglo > 0 .and. nemo_jpjglo > 0 ) then
        !--- Verify that the array dimensions are consistent with
        !--- the shape of the global NEMO domain
        !--- nemo_jpiglo and nemo_jpjglo are passed to the coupler at runtime
        if ( corn ) then
          !--- The corner arrays will have 1 extra row and column
          if ( size(afld,dim=1) /= nemo_jpiglo+1 .or. &
               size(afld,dim=2) /= nemo_jpjglo+1 ) then
            write(6,*)"resize_nemo_field_i4: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo+1,nemo_jpjglo+1
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_i4",-1)
          endif
        else
          if ( size(afld,dim=1) /= nemo_jpiglo .or. &
               size(afld,dim=2) /= nemo_jpjglo ) then
            write(6,*)"resize_nemo_field_i4: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo,nemo_jpjglo
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_i4",-2)
          endif
        endif
      endif

      !--- Remove the first and last column (ie lon) from this array
      nx = size(afld,dim=1) - 2
      ny = size(afld,dim=2)

      allocate( wrk2d(nx,ny) )
      wrk2d(1:nx,1:ny) = afld(2:nx+1,1:ny)

      deallocate( afld )
      allocate( afld(nx,ny) )
      afld = wrk2d

      deallocate( wrk2d )

    end subroutine resize_nemo_field_i4

    !***************************************************************************
    !--- Remove first and last overlap longitudes from a integer*8 NEMO field
    !***************************************************************************
    subroutine resize_nemo_field_i8(afld, corner)
      integer(kind=8), pointer, intent(inout) :: afld(:,:)
      logical, intent(in), optional :: corner

      !--- Local
      integer(kind=8), pointer, dimension(:,:) :: wrk2d=>null()
      integer :: nx, ny
      logical :: corn

      if ( present(corner) ) then
        corn = corner
      else
        corn = .false.
      endif

      if ( .not. associated(afld) ) then
        write(6,*)"resize_nemo_field_i8: Input array is not allocated."
        call xit("resize_nemo_field_i8",-1)
      endif

      if ( nemo_jpiglo > 0 .and. nemo_jpjglo > 0 ) then
        !--- Verify that the array dimensions are consistent with
        !--- the shape of the global NEMO domain
        !--- nemo_jpiglo and nemo_jpjglo are passed to the coupler at runtime
        if ( corn ) then
          !--- The corner arrays will have 1 extra row and column
          if ( size(afld,dim=1) /= nemo_jpiglo+1 .or. &
               size(afld,dim=2) /= nemo_jpjglo+1 ) then
            write(6,*)"resize_nemo_field_i8: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo+1,nemo_jpjglo+1
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_i8",-1)
          endif
        else
          if ( size(afld,dim=1) /= nemo_jpiglo .or. &
               size(afld,dim=2) /= nemo_jpjglo ) then
            write(6,*)"resize_nemo_field_i8: Invalid input array shape."
            write(6,*)"    expected ",nemo_jpiglo,nemo_jpjglo
            write(6,*)"       found ",shape(afld)
            call xit("resize_nemo_field_i8",-2)
          endif
        endif
      endif

      !--- Remove the first and last column (ie lon) from this array
      nx = size(afld,dim=1) - 2
      ny = size(afld,dim=2)

      allocate( wrk2d(nx,ny) )
      wrk2d(1:nx,1:ny) = afld(2:nx+1,1:ny)

      deallocate( afld )
      allocate( afld(nx,ny) )
      afld = wrk2d

      deallocate( wrk2d )

    end subroutine resize_nemo_field_i8

end module grid_comm
