prop/lib/microwaveprop/weather/skewt_params.ex

defmodule Microwaveprop.Weather.SkewtParams do
  @moduledoc """
  Derived sounding parameters for the `/skewt` page — the same set the
  SPC sounding viewer publishes in its `*.txt` companion file
  (`https://www.spc.noaa.gov/exper/soundings/`):

    * Lifting condensation level (`lcl_pressure_mb`, `lcl_temp_c`,
      `lcl_height_m`).
    * Level of free convection (`lfc_pressure_mb`, `lfc_height_m`).
    * Equilibrium level (`el_pressure_mb`, `el_height_m`).
    * Surface-based CAPE/CIN (`sbcape`, `sbcin` in J/kg).
    * Three-kilometre CAPE (`cape_3km`).
    * Lifted index (`lifted_index`, parcel-environment T diff at 500 mb).
    * Freezing level and wet-bulb-zero level (`freezing_level_m`,
      `wbz_m`).
    * Downdraft CAPE (`dcape`).
    * Layer lapse rates (`lapse_rate_sfc_3km_c_per_km`,
      `lapse_rate_700_500_c_per_km`, `lapse_rate_850_500_c_per_km`).
    * `parcel_trace` — the surface parcel's pressure/temperature
      trajectory through the diagram, used by `SkewtSvg.render/1` to
      draw the dashed parcel-ascent overlay.

  Wind-derived indices (SRH, BWD, Bunkers motion, SCP, STP, SHIP) are
  *not* produced because HRRR persists wind only at 10 m AGL — there
  is no per-pressure-level wind to compute them from. Operators wanting
  shear-based products should use NUCAPS / SPC mesoanalysis instead.

  Inputs are the same canonical profile shape `SoundingParams.derive/1`
  consumes: `[%{"pres", "hght", "tmpc", "dwpc"}, ...]` (string OR atom
  keys; a `:hght_m` / `"hght_m"` alias for height is also accepted).
  """

  @r_d 287.05
  @r_v 461.5
  @c_p 1004.0
  @g 9.80665
  @epsilon @r_d / @r_v
  # Buck's saturation-vapor formula constants (kept in this module so
  # we don't have to leak them out of SoundingParams).
  @buck_a 6.1121
  @buck_b 17.502
  @buck_c 240.97
  # Approximate L_v at 0 °C in J/kg. Tropospheric variation across
  # parcel temperatures is ≤4 % which is well below CAPE bin noise.
  @l_v 2.5e6

  @nil_params %{
    lcl_pressure_mb: nil,
    lcl_temp_c: nil,
    lcl_height_m: nil,
    lfc_pressure_mb: nil,
    lfc_height_m: nil,
    el_pressure_mb: nil,
    el_height_m: nil,
    sbcape: nil,
    sbcin: nil,
    cape_3km: nil,
    lifted_index: nil,
    freezing_level_m: nil,
    wbz_m: nil,
    dcape: nil,
    lapse_rate_sfc_3km_c_per_km: nil,
    lapse_rate_700_500_c_per_km: nil,
    lapse_rate_850_500_c_per_km: nil,
    parcel_trace: []
  }

  @doc """
  Returns the SPC-style parameter map for `profile`. See module
  docstring for field-by-field semantics. Returns `@nil_params` for
  empty / single-level inputs.
  """
  @spec derive([map()]) :: map()
  def derive(profile) when is_list(profile) do
    levels = profile |> Enum.map(&normalize_level/1) |> Enum.reject(&is_nil/1)

    case Enum.sort_by(levels, & &1.pres, :desc) do
      [] -> @nil_params
      [_only] -> @nil_params
      [surface | _] = sorted -> compute(surface, sorted)
    end
  end

  defp compute(surface, sorted_desc) do
    {p_lcl, t_lcl} = lcl(surface.tmpc, surface.dwpc, surface.pres)
    parcel_trace = parcel_trace(surface, p_lcl, t_lcl, sorted_desc)
    {sbcape, sbcin} = cape_cin(parcel_trace, sorted_desc)
    cape_3km = cape_layer(parcel_trace, sorted_desc, surface.hght, surface.hght + 3000.0)
    {lfc_pressure, el_pressure} = lfc_el(parcel_trace, sorted_desc)

    {lfc_height, el_height} =
      {height_at_pressure(sorted_desc, lfc_pressure), height_at_pressure(sorted_desc, el_pressure)}

    %{
      lcl_pressure_mb: p_lcl,
      lcl_temp_c: t_lcl,
      lcl_height_m: height_at_pressure(sorted_desc, p_lcl),
      lfc_pressure_mb: lfc_pressure,
      lfc_height_m: lfc_height,
      el_pressure_mb: el_pressure,
      el_height_m: el_height,
      sbcape: sbcape,
      sbcin: sbcin,
      cape_3km: cape_3km,
      lifted_index: lifted_index(parcel_trace, sorted_desc),
      freezing_level_m: temperature_height_crossing(sorted_desc, & &1.tmpc, 0.0),
      wbz_m: temperature_height_crossing(sorted_desc, &wet_bulb_c/1, 0.0),
      dcape: dcape(sorted_desc),
      lapse_rate_sfc_3km_c_per_km: lapse_rate_height(sorted_desc, surface.hght, surface.hght + 3000.0),
      lapse_rate_700_500_c_per_km: lapse_rate_pressures(sorted_desc, 700.0, 500.0),
      lapse_rate_850_500_c_per_km: lapse_rate_pressures(sorted_desc, 850.0, 500.0),
      parcel_trace: parcel_trace
    }
  end

  # ── Lifting Condensation Level (Bolton 1980 eq 22) ──────────────────

  @doc """
  Lifting condensation level pressure and temperature.

  Inputs:
    * `temp_c` — surface temperature, °C
    * `dewpoint_c` — surface dewpoint, °C
    * `pressure_mb` — surface pressure, mb

  Returns `{p_lcl_mb, t_lcl_c}`. Saturated air (T = T_d) returns the
  surface pressure unchanged.
  """
  @spec lcl(number(), number(), number()) :: {float(), float()}
  def lcl(temp_c, dewpoint_c, pressure_mb) when is_number(temp_c) and is_number(dewpoint_c) and is_number(pressure_mb) do
    t_k = temp_c + 273.15
    td_k = dewpoint_c + 273.15

    # Bolton (1980) eq 22: T at LCL.
    t_lcl_k = 1.0 / (1.0 / (td_k - 56.0) + :math.log(t_k / td_k) / 800.0) + 56.0

    # Poisson relation between two adiabatic levels.
    p_lcl = pressure_mb * :math.pow(t_lcl_k / t_k, @c_p / @r_d)

    {p_lcl, t_lcl_k - 273.15}
  end

  # ── Parcel ascent ───────────────────────────────────────────────────

  # Returns a list of `%{pres, tmpc}` for the surface parcel, walking
  # from surface pressure up through every environmental level above
  # the LCL using a saturated-adiabatic step in pressure.
  defp parcel_trace(surface, p_lcl, t_lcl, sorted_desc) do
    surface_step = %{pres: surface.pres, tmpc: surface.tmpc}
    lcl_step = %{pres: min(p_lcl, surface.pres), tmpc: t_lcl}

    above_lcl =
      sorted_desc
      |> Enum.filter(&(&1.pres < p_lcl))
      |> Enum.sort_by(& &1.pres, :desc)

    {trace_above, _} =
      Enum.map_reduce(above_lcl, lcl_step, fn level, prev ->
        t_next = saturated_adiabatic_step(prev.tmpc, prev.pres, level.pres)
        step = %{pres: level.pres, tmpc: t_next}
        {step, step}
      end)

    Enum.uniq_by([surface_step, lcl_step | trace_above], & &1.pres)
  end

  # Integrate dT/d(ln p) = γ_sat × R_d × T / g across the pressure
  # interval [p1, p2] in 5 mb steps using a forward-Euler scheme.
  # Coarse but stable; the residual error is well below CAPE-bin noise.
  defp saturated_adiabatic_step(t_c_start, p_start, p_end) do
    n_steps = max(1, trunc((p_start - p_end) / 5.0))
    dp = (p_end - p_start) / n_steps

    1..n_steps
    |> Enum.reduce({t_c_start, p_start}, fn _, {t_c, p} ->
      t_k = t_c + 273.15
      gamma_s = saturated_lapse_rate_per_pressure(t_k, p)
      t_next_k = t_k + gamma_s * dp
      {t_next_k - 273.15, p + dp}
    end)
    |> elem(0)
  end

  # γ_sat expressed as dT/dp (K/mb), derived from the standard moist
  # adiabatic lapse rate dT/dz combined with hydrostatic dz/dp =
  # -R_d × T_v / (g × p).
  defp saturated_lapse_rate_per_pressure(t_k, p_mb) do
    e_s = saturation_vapor_pressure_mb(t_k - 273.15)
    r_s = @epsilon * e_s / max(p_mb - e_s, 1.0e-3)

    num = 1.0 + @l_v * r_s / (@r_d * t_k)
    den = @c_p + @l_v * @l_v * r_s * @epsilon / (@r_d * t_k * t_k)
    gamma_z = @g * num / den

    # dz/dp ≈ -R_d × T / (g × p)  (mb)
    dz_dp = -@r_d * t_k / (@g * p_mb)
    -gamma_z * dz_dp
  end

  defp saturation_vapor_pressure_mb(t_c) do
    @buck_a * :math.exp(@buck_b * t_c / (@buck_c + t_c))
  end

  # ── CAPE / CIN ──────────────────────────────────────────────────────

  defp cape_cin(parcel_trace, sorted_desc) do
    pairs = parcel_environment_pairs(parcel_trace, sorted_desc)

    {cape, cin} =
      Enum.reduce(layer_increments(pairs), {0.0, 0.0}, fn {avg_diff, dlnp}, {cape, cin} ->
        delta = @r_d * avg_diff * dlnp

        cond do
          avg_diff > 0 -> {cape + delta, cin}
          avg_diff < 0 -> {cape, cin + delta}
          true -> {cape, cin}
        end
      end)

    {round_j(cape), round_j(cin)}
  end

  defp cape_layer(_parcel, _profile, lo, hi) when not (is_number(lo) and is_number(hi)), do: nil

  defp cape_layer(parcel_trace, sorted_desc, lo_height_m, hi_height_m) do
    pairs =
      parcel_trace
      |> parcel_environment_pairs(sorted_desc)
      |> Enum.filter(fn p -> p.height >= lo_height_m and p.height <= hi_height_m end)

    cape =
      pairs
      |> layer_increments()
      |> Enum.reduce(0.0, fn {avg_diff, dlnp}, acc ->
        if avg_diff > 0, do: acc + @r_d * avg_diff * dlnp, else: acc
      end)

    round_j(cape)
  end

  # Build a list of {pressure, parcel_T_K, env_T_K, height} pairs at
  # every environmental pressure level the parcel trace also covers.
  defp parcel_environment_pairs(parcel_trace, sorted_desc) do
    parcel_by_pres = Map.new(parcel_trace, &{&1.pres, &1.tmpc})

    Enum.flat_map(sorted_desc, fn level ->
      case Map.fetch(parcel_by_pres, level.pres) do
        {:ok, parcel_t} ->
          [
            %{
              pres: level.pres,
              parcel_t_k: parcel_t + 273.15,
              env_t_k: level.tmpc + 273.15,
              diff: parcel_t - level.tmpc,
              height: level.hght
            }
          ]

        :error ->
          []
      end
    end)
  end

  defp layer_increments(pairs) do
    pairs
    |> Enum.sort_by(& &1.pres, :desc)
    |> Enum.chunk_every(2, 1, :discard)
    |> Enum.map(fn [a, b] ->
      avg = (a.diff + b.diff) / 2.0
      dlnp = :math.log(a.pres / b.pres)
      {avg, dlnp}
    end)
  end

  # ── LFC, EL ─────────────────────────────────────────────────────────

  defp lfc_el(parcel_trace, sorted_desc) do
    pairs =
      parcel_trace
      |> parcel_environment_pairs(sorted_desc)
      |> Enum.sort_by(& &1.pres, :desc)

    pos_pairs = Enum.filter(pairs, &(&1.diff > 0))

    case pos_pairs do
      [] ->
        {nil, nil}

      [first | _] ->
        last = List.last(pos_pairs)
        # LFC = bottom of the first contiguous positive-area region.
        # EL = top of the last positive-area region. Coarse but
        # matches what SPC publishes for single-parcel ascent.
        {first.pres, last.pres}
    end
  end

  # ── Lifted index ────────────────────────────────────────────────────

  defp lifted_index(parcel_trace, sorted_desc) do
    parcel_t = pressure_lookup_temp(parcel_trace, 500.0)
    env_t = pressure_lookup_temp(sorted_desc, 500.0)

    case {parcel_t, env_t} do
      {nil, _} -> nil
      {_, nil} -> nil
      {pt, et} -> Float.round(et - pt, 1)
    end
  end

  defp pressure_lookup_temp(levels, target_p) do
    sorted = Enum.sort_by(levels, & &1.pres, :desc)

    cond do
      sorted == [] -> nil
      target_p > List.first(sorted).pres -> List.first(sorted).tmpc
      target_p < List.last(sorted).pres -> List.last(sorted).tmpc
      true -> interp_temp_at_pressure(sorted, target_p)
    end
  end

  defp interp_temp_at_pressure(sorted, target_p) do
    sorted
    |> Enum.chunk_every(2, 1, :discard)
    |> Enum.find_value(fn [a, b] ->
      if target_p <= a.pres and target_p >= b.pres do
        f = (a.pres - target_p) / max(a.pres - b.pres, 1.0e-6)
        a.tmpc + f * (b.tmpc - a.tmpc)
      end
    end)
  end

  # ── Freezing / wet-bulb-zero / DCAPE ────────────────────────────────

  defp temperature_height_crossing(sorted_desc, fun, target_c) do
    sorted_desc
    |> Enum.chunk_every(2, 1, :discard)
    |> Enum.find_value(fn [a, b] ->
      ta = fun.(a)
      tb = fun.(b)

      cond do
        ta == nil or tb == nil ->
          nil

        (ta - target_c) * (tb - target_c) > 0 ->
          nil

        ta == tb ->
          a.hght

        true ->
          f = (ta - target_c) / (ta - tb)
          a.hght + f * (b.hght - a.hght)
      end
    end)
  end

  defp wet_bulb_c(level) do
    # Stipanuk-style iterative approximation: T_wb satisfies
    # e_s(T_wb) = e + (p × c_p / (ε × L_v)) × (T - T_wb)
    # Solve by bracketing between dewpoint and dry bulb.
    t_d = level.dwpc
    t = level.tmpc

    if t_d == nil or t == nil do
      nil
    else
      bisect_wet_bulb(t, t_d, level.pres)
    end
  end

  defp bisect_wet_bulb(t, t_d, _p) when t == t_d, do: t

  defp bisect_wet_bulb(t, t_d, p) do
    e = saturation_vapor_pressure_mb(t_d)

    f = fn t_w ->
      e_s = saturation_vapor_pressure_mb(t_w)
      e_s - e - p * @c_p / (@epsilon * @l_v) * (t - t_w)
    end

    bisect(f, t_d, t, 30)
  end

  defp bisect(_f, lo, hi, 0), do: (lo + hi) / 2.0

  defp bisect(f, lo, hi, iter) do
    mid = (lo + hi) / 2.0
    val_lo = f.(lo)
    val_mid = f.(mid)

    cond do
      abs(val_mid) < 1.0e-3 -> mid
      val_lo * val_mid < 0 -> bisect(f, lo, mid, iter - 1)
      true -> bisect(f, mid, hi, iter - 1)
    end
  end

  defp dcape(sorted_desc) do
    # Pick the level with minimum θ_e in the layer 700-400 mb as the
    # downdraft source. Saturate the parcel there, descend moist-
    # adiabatically to the surface, and integrate negative buoyancy.
    candidates =
      Enum.filter(sorted_desc, fn l -> l.pres >= 400.0 and l.pres <= 700.0 end)

    case candidates do
      [] ->
        nil

      _ ->
        source = Enum.min_by(candidates, &theta_e(&1.tmpc, &1.dwpc, &1.pres))
        descend_dcape(source, sorted_desc)
    end
  end

  defp descend_dcape(source, sorted_desc) do
    descent_targets =
      sorted_desc
      |> Enum.filter(&(&1.pres >= source.pres))
      |> Enum.sort_by(& &1.pres, :asc)

    {traj, _} =
      Enum.map_reduce(descent_targets, %{pres: source.pres, tmpc: source.dwpc}, fn lvl, prev ->
        t_next = saturated_adiabatic_step(prev.tmpc, prev.pres, lvl.pres)
        step = %{pres: lvl.pres, tmpc: t_next, env_t: lvl.tmpc, height: lvl.hght}
        {step, %{pres: lvl.pres, tmpc: t_next}}
      end)

    integral =
      traj
      |> Enum.chunk_every(2, 1, :discard)
      |> Enum.reduce(0.0, fn [a, b], acc ->
        diff = (a.env_t - a.tmpc + b.env_t - b.tmpc) / 2.0
        dlnp = :math.log(b.pres / a.pres)

        if diff > 0, do: acc + @r_d * diff * dlnp, else: acc
      end)

    round_j(integral)
  end

  defp theta_e(t_c, td_c, p_mb) do
    t_k = t_c + 273.15
    e = saturation_vapor_pressure_mb(td_c)
    r = @epsilon * e / max(p_mb - e, 1.0e-3)
    theta = t_k * :math.pow(1000.0 / p_mb, @r_d / @c_p)
    theta * :math.exp(@l_v * r / (@c_p * t_k))
  end

  # ── Lapse rates ─────────────────────────────────────────────────────

  defp lapse_rate_height(sorted_desc, lo_m, hi_m) do
    case {temp_at_height(sorted_desc, lo_m), temp_at_height(sorted_desc, hi_m)} do
      {t_lo, t_hi} when is_number(t_lo) and is_number(t_hi) ->
        Float.round((t_lo - t_hi) / ((hi_m - lo_m) / 1000.0), 2)

      _ ->
        nil
    end
  end

  defp lapse_rate_pressures(sorted_desc, p_lo, p_hi) do
    t_lo = pressure_lookup_temp(sorted_desc, p_lo)
    t_hi = pressure_lookup_temp(sorted_desc, p_hi)
    h_lo = height_at_pressure(sorted_desc, p_lo)
    h_hi = height_at_pressure(sorted_desc, p_hi)

    cond do
      not (is_number(t_lo) and is_number(t_hi)) -> nil
      not (is_number(h_lo) and is_number(h_hi)) -> nil
      h_hi == h_lo -> nil
      true -> Float.round((t_lo - t_hi) / ((h_hi - h_lo) / 1000.0), 2)
    end
  end

  defp temp_at_height(sorted_desc, target_m) do
    sorted_desc
    |> Enum.chunk_every(2, 1, :discard)
    |> Enum.find_value(fn [a, b] ->
      if a.hght <= target_m and target_m <= b.hght and b.hght != a.hght do
        f = (target_m - a.hght) / (b.hght - a.hght)
        a.tmpc + f * (b.tmpc - a.tmpc)
      end
    end)
  end

  defp height_at_pressure(_sorted, nil), do: nil

  defp height_at_pressure(sorted_desc, target_p) do
    sorted_desc
    |> Enum.chunk_every(2, 1, :discard)
    |> Enum.find_value(fn [a, b] ->
      if target_p <= a.pres and target_p >= b.pres and a.pres != b.pres do
        f = (a.pres - target_p) / (a.pres - b.pres)
        a.hght + f * (b.hght - a.hght)
      end
    end)
  end

  # ── Profile shape normaliser ────────────────────────────────────────

  defp normalize_level(level) when is_map(level) do
    pres = number(get_any(level, ["pres", "pres_mb", :pres, :pres_mb]))
    hght = number(get_any(level, ["hght", "hght_m", :hght, :hght_m]))
    tmpc = number(get_any(level, ["tmpc", :tmpc]))
    dwpc = number(get_any(level, ["dwpc", :dwpc]))

    if is_number(pres) and is_number(hght) and is_number(tmpc) do
      %{pres: pres, hght: hght, tmpc: tmpc, dwpc: dwpc}
    end
  end

  defp normalize_level(_), do: nil

  defp get_any(_map, []), do: nil

  defp get_any(map, [key | rest]) do
    case Map.fetch(map, key) do
      {:ok, v} -> v
      :error -> get_any(map, rest)
    end
  end

  defp number(nil), do: nil
  defp number(x) when is_integer(x), do: x * 1.0
  defp number(x) when is_float(x), do: x
  defp number(_), do: nil

  defp round_j(nil), do: nil
  defp round_j(v) when is_number(v), do: Float.round(v * 1.0, 1)
end