!===================================================
! DO NOT EDIT THIS FILE, it was generated using ./tools/genf90/genf90.pl
! Any changes you make to this file may be lost
!===================================================
module array_utils

  ! ------------------------------------------------------------------------
  ! !DESCRIPTION:
  ! This module contains routines for working with arrays.
  !
  ! NOTES
  ! Subroutines transpose_wrapper_* and pack_wrapper could be moved to csm_share
  ! if they stick around for long; they are just here to work around the fact
  ! that we don't specify -Mallocatable=03 with pgi (which in turn is because
  ! that flag led to bugs with pgi14).
  !
  ! !USES:
#include "shr_assert.h"
  use shr_kind_mod, only : r8 => shr_kind_r8, r4 => shr_kind_r4, i4=>shr_kind_i4
  use shr_log_mod , only : errMsg => shr_log_errMsg
  use shr_sys_mod , only : shr_sys_abort

  implicit none
  private
  save

  ! Public routines

  public :: find_k_max_indices ! returns the indices of the maximum k values in data, in sorted order
  public :: convert_to_logical ! convert a numeric array to logical array
  public :: transpose_wrapper  ! wrap the intrinsic transpose function, first allocating the destination array
  public :: pack_wrapper       ! wrap the intrinsic pack function, first allocating the destination array

# 30 "src/utils/array_utils.F90.in"
  interface convert_to_logical
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_1d_double
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_2d_double
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_3d_double
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_1d_real
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_2d_real
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_3d_real
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_1d_int
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_2d_int
     !TYPE double,real,int
     !DIMS 1,2,3
     module procedure convert_to_logical_3d_int
  end interface convert_to_logical

# 36 "src/utils/array_utils.F90.in"
  interface transpose_wrapper
     !TYPE int,double
     module procedure transpose_wrapper_int
     !TYPE int,double
     module procedure transpose_wrapper_double
  end interface transpose_wrapper

  character(len=*), parameter, private :: sourcefile = &
       __FILE__
# 43 "src/utils/array_utils.F90.in"
contains

  !-----------------------------------------------------------------------
# 46 "src/utils/array_utils.F90.in"
  subroutine find_k_max_indices(data, lb, k, max_indices)
    !
    ! !DESCRIPTION:
    ! Returns the indices of the maximum k values in data, in sorted order (so the first
    ! index will be the largest, the second index will be the second largest, etc.)
    !
    ! The output array (max_indices) should be of size k
    !
    ! Speed estimate: O(n*k) (where n is the size of the input array)
    !
    ! !ARGUMENTS:
    integer  , intent(in)  :: lb ! lower bound of data array
    real(r8) , intent(in)  :: data(lb:)
    integer  , intent(in)  :: k  ! number of max indices to find
    integer  , intent(out) :: max_indices(:)
    !
    ! !LOCAL VARIABLES:
    real(r8) :: max_vals(k)
    integer :: i, j
    integer :: insertion_location

    character(len=*), parameter :: subname = 'find_k_max_indices'
    !-----------------------------------------------------------------------

    SHR_ASSERT_FL((size(max_indices) == k), subname, __LINE__)

    if (k < 1 .or. k > size(data)) then
       call shr_sys_abort(subname//': must have 1 <= k <= size(data)')
    end if

    max_indices(:) = lb - 1
    max_vals(:) = -huge(1._r8)

    do i = lbound(data,1), ubound(data,1)
       ! Determine where (if anywhere) data(i) should go in max_vals, relative to the
       ! values we've seen so far. Note that max_vals will be arranged in sorted order,
       ! with the largest value first.
       insertion_location = -1
       do j = 1, k
          if (data(i) > max_vals(j)) then
             insertion_location = j
             exit
          end if
       end do

       if (insertion_location > 0) then
          ! Shift lower values right by one (note that the k'th value will be dropped)
          do j = k-1, insertion_location, -1
             max_indices(j+1) = max_indices(j)
             max_vals(j+1) = max_vals(j)
          end do

          max_indices(insertion_location) = i
          max_vals(insertion_location) = data(i)
       end if
    end do

# 103 "src/utils/array_utils.F90.in"
  end subroutine find_k_max_indices

  !-----------------------------------------------------------------------
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_1d_double(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    real(r8), intent(in)  :: data_numeric(:)
    logical, intent(out) :: data_logical(:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_1d_double'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_1d_double
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_2d_double(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    real(r8), intent(in)  :: data_numeric(:,:)
    logical, intent(out) :: data_logical(:,:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_2d_double'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_2d_double
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_3d_double(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    real(r8), intent(in)  :: data_numeric(:,:,:)
    logical, intent(out) :: data_logical(:,:,:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_3d_double'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_3d_double
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_1d_real(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    real(r4), intent(in)  :: data_numeric(:)
    logical, intent(out) :: data_logical(:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_1d_real'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_1d_real
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_2d_real(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    real(r4), intent(in)  :: data_numeric(:,:)
    logical, intent(out) :: data_logical(:,:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_2d_real'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_2d_real
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_3d_real(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    real(r4), intent(in)  :: data_numeric(:,:,:)
    logical, intent(out) :: data_logical(:,:,:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_3d_real'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_3d_real
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_1d_int(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    integer(i4), intent(in)  :: data_numeric(:)
    logical, intent(out) :: data_logical(:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_1d_int'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_1d_int
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_2d_int(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    integer(i4), intent(in)  :: data_numeric(:,:)
    logical, intent(out) :: data_logical(:,:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_2d_int'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_2d_int
  !DIMS 1,2,3
  !TYPE double,real,int
# 108 "src/utils/array_utils.F90.in"
  subroutine convert_to_logical_3d_int(data_numeric, data_logical)
    !
    ! !DESCRIPTION:
    ! Convert a numeric variable to logical
    !
    ! !ARGUMENTS:
    integer(i4), intent(in)  :: data_numeric(:,:,:)
    logical, intent(out) :: data_logical(:,:,:)
    !
    ! !LOCAL VARIABLES:

    character(len=*), parameter :: subname = 'convert_to_logical_3d_int'
    !-----------------------------------------------------------------------

    if (any(data_numeric /= 0 .and. data_numeric /= 1)) then
       call shr_sys_abort('convert_to_logical: bad value(s) for logical data')
    end if

    where (data_numeric == 1)
       data_logical = .true.
    elsewhere
       data_logical = .false.
    end where
# 131 "src/utils/array_utils.F90.in"
  end subroutine convert_to_logical_3d_int

  !-----------------------------------------------------------------------
  !TYPE int,double
# 135 "src/utils/array_utils.F90.in"
  subroutine transpose_wrapper_int(arr_out, arr_in)
    !
    ! !DESCRIPTION:
    ! Wrap the intrinsic transpose function, doing the necessary allocation of the
    ! destination array
    !
    ! NOTE(wjs, 2015-10-21) This is supposed to be handled for you in Fortran2003. Within
    ! CESM, it currently appears to be handled for all compilers except pgi: It is
    ! handled with intel through the use of '-assume realloc_lhs'. It could be handled
    ! with pgi through the use of '-Mallocatable=03', but we currently don't use that
    ! flag, because it triggered bugs with pgi14.
    !
    ! !USES:
    !
    ! !ARGUMENTS:
    integer(i4), allocatable, intent(out) :: arr_out(:,:)
    integer(i4), intent(in) :: arr_in(:,:)
    !
    ! !LOCAL VARIABLES:
    integer :: size1, size2

    character(len=*), parameter :: subname = 'transpose_wrapper_int'
    !-----------------------------------------------------------------------

    size1 = size(arr_in, 1)
    size2 = size(arr_in, 2)
    allocate(arr_out(size2, size1))

    arr_out = transpose(arr_in)

# 165 "src/utils/array_utils.F90.in"
  end subroutine transpose_wrapper_int
  !TYPE int,double
# 135 "src/utils/array_utils.F90.in"
  subroutine transpose_wrapper_double(arr_out, arr_in)
    !
    ! !DESCRIPTION:
    ! Wrap the intrinsic transpose function, doing the necessary allocation of the
    ! destination array
    !
    ! NOTE(wjs, 2015-10-21) This is supposed to be handled for you in Fortran2003. Within
    ! CESM, it currently appears to be handled for all compilers except pgi: It is
    ! handled with intel through the use of '-assume realloc_lhs'. It could be handled
    ! with pgi through the use of '-Mallocatable=03', but we currently don't use that
    ! flag, because it triggered bugs with pgi14.
    !
    ! !USES:
    !
    ! !ARGUMENTS:
    real(r8), allocatable, intent(out) :: arr_out(:,:)
    real(r8), intent(in) :: arr_in(:,:)
    !
    ! !LOCAL VARIABLES:
    integer :: size1, size2

    character(len=*), parameter :: subname = 'transpose_wrapper_double'
    !-----------------------------------------------------------------------

    size1 = size(arr_in, 1)
    size2 = size(arr_in, 2)
    allocate(arr_out(size2, size1))

    arr_out = transpose(arr_in)

# 165 "src/utils/array_utils.F90.in"
  end subroutine transpose_wrapper_double

  !-----------------------------------------------------------------------
# 168 "src/utils/array_utils.F90.in"
  subroutine pack_wrapper(arr_packed, arr, mask)
    !
    ! !DESCRIPTION:
    ! Wrap the intrinsic pack function, doing the necessary allocation of the destination
    ! array.
    !
    ! NOTE(wjs, 2015-10-21) This is supposed to be handled for you in Fortran2003. Within
    ! CESM, it currently appears to be handled for all compilers except pgi: It is
    ! handled with intel through the use of '-assume realloc_lhs'. It could be handled
    ! with pgi through the use of '-Mallocatable=03', but we currently don't use that
    ! flag, because it triggered bugs with pgi14.
    !
    ! !USES:
    !
    ! !ARGUMENTS:
    real(r8), allocatable, intent(out) :: arr_packed(:)
    real(r8), intent(in) :: arr(:)
    logical , intent(in) :: mask(:)
    !
    ! !LOCAL VARIABLES:
    integer :: packed_size

    character(len=*), parameter :: subname = 'pack_wrapper'
    !-----------------------------------------------------------------------

    packed_size = count(mask)
    allocate(arr_packed(packed_size))
    arr_packed = pack(arr, mask)

# 197 "src/utils/array_utils.F90.in"
  end subroutine pack_wrapper

end module array_utils
