! --------------------------------------------------------
! Instituto Nacional de Pesquisas Espaciais - INPE
! Coordenacao-Geral de Ciencias da Terra - CGCT
! Divisao de Impactos, Adaptacao e Vulnerabilidade - DIIAV
!
! Projeto: SisMOM
! Sistema de Monitoramento e Modelagem Oceanica e Costeira
! --------------------------------------------------------
! Interpolacao horizontal bilinear e vertical linear; conversao Kelvin -> Celsius.
! --------------------------------------------------------
module mod_interp
  use mod_kinds, only: sp, dp
  use, intrinsic :: ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan
  implicit none
  private
  public :: bilinear, vinterp_levels, kelvin_to_celsius

contains

  !> Bilinear de grade regular ascendente (src_x, src_y) para pontos arbitrarios.
  !> field tem NaN onde invalido; pesos renormalizados sobre vizinhos validos.
  subroutine bilinear(src_x, src_y, field, tlon, tlat, out)
    real(dp), intent(in)  :: src_x(:), src_y(:)
    real(sp), intent(in)  :: field(:,:)
    real(dp), intent(in)  :: tlon(:), tlat(:)
    real(sp), intent(out) :: out(:)
    integer  :: nx, ny, np, p, ix, iy
    real(dp) :: x0, y0, dx, dy, fx, fy, w(4), v(4), wsum, num, nan
    logical  :: ok(4)

    nx = size(src_x); ny = size(src_y); np = size(tlon)
    x0 = src_x(1); dx = (src_x(nx) - src_x(1)) / real(nx - 1, dp)
    y0 = src_y(1); dy = (src_y(ny) - src_y(1)) / real(ny - 1, dp)
    nan = ieee_value(1.0_dp, ieee_quiet_nan)

    do p = 1, np
      ix = int((tlon(p) - x0) / dx) + 1
      iy = int((tlat(p) - y0) / dy) + 1
      if (ix < 1 .or. ix >= nx .or. iy < 1 .or. iy >= ny) then
        out(p) = real(nan, sp)
        cycle
      end if
      fx = (tlon(p) - src_x(ix)) / (src_x(ix+1) - src_x(ix))
      fy = (tlat(p) - src_y(iy)) / (src_y(iy+1) - src_y(iy))
      fx = max(0.0_dp, min(1.0_dp, fx))
      fy = max(0.0_dp, min(1.0_dp, fy))

      v(1) = real(field(ix,   iy  ), dp); w(1) = (1-fx)*(1-fy)
      v(2) = real(field(ix+1, iy  ), dp); w(2) = fx*(1-fy)
      v(3) = real(field(ix,   iy+1), dp); w(3) = (1-fx)*fy
      v(4) = real(field(ix+1, iy+1), dp); w(4) = fx*fy
      ok = .not. ieee_is_nan(v)

      wsum = 0.0_dp; num = 0.0_dp
      if (ok(1)) then; wsum = wsum + w(1); num = num + w(1)*v(1); end if
      if (ok(2)) then; wsum = wsum + w(2); num = num + w(2)*v(2); end if
      if (ok(3)) then; wsum = wsum + w(3); num = num + w(3)*v(3); end if
      if (ok(4)) then; wsum = wsum + w(4); num = num + w(4)*v(4); end if

      if (wsum > 0.0_dp) then
        out(p) = real(num / wsum, sp)
      else
        out(p) = real(nan, sp)
      end if
    end do
  end subroutine bilinear

  !> Interpolacao linear em profundidade: src_z (ascendente) -> zt.
  !> NaN propaga (abaixo do leito permanece fill); clamp no topo.
  subroutine vinterp_levels(src_z, field, zt, out)
    real(dp), intent(in)  :: src_z(:)
    real(sp), intent(in)  :: field(:,:,:)
    real(dp), intent(in)  :: zt(:)
    real(sp), intent(out) :: out(:,:,:)
    integer  :: nz, nlev, li, k, kk
    real(dp) :: z, wgt
    real(sp) :: wk

    nz = size(src_z); nlev = size(zt)
    do li = 1, nlev
      z = zt(li)
      if (z <= src_z(1)) then
        out(:,:,li) = field(:,:,1)
      else if (z >= src_z(nz)) then
        out(:,:,li) = field(:,:,nz)
      else
        k = 1
        do kk = 1, nz - 1
          if (src_z(kk) <= z .and. z < src_z(kk+1)) then
            k = kk; exit
          end if
        end do
        wgt = (z - src_z(k)) / (src_z(k+1) - src_z(k))
        wk = real(wgt, sp)
        out(:,:,li) = (1.0_sp - wk) * field(:,:,k) + wk * field(:,:,k+1)
      end if
    end do
  end subroutine vinterp_levels

  !> Converte de Kelvin para Celsius se a media (ignorando NaN) indicar Kelvin.
  subroutine kelvin_to_celsius(field)
    real(sp), intent(inout) :: field(:,:)
    integer  :: i, j
    real(dp) :: s
    integer  :: n
    s = 0.0_dp; n = 0
    do j = 1, size(field, 2)
      do i = 1, size(field, 1)
        if (.not. ieee_is_nan(field(i,j))) then
          s = s + real(field(i,j), dp); n = n + 1
        end if
      end do
    end do
    if (n > 0 .and. s / real(n, dp) > 100.0_dp) then
      where (.not. ieee_is_nan(field)) field = field - 273.15_sp
    end if
  end subroutine kelvin_to_celsius

end module mod_interp
