cavity_exchange_velocities_f Subroutine

   pure subroutine cavity_exchange_velocities_f(par, f_cor, const, u_star, l_plus, &
                                                T_w, S_w, T_b, S_b, gamma_t, gamma_s, ierr)
      !! Exchange-velocity dispatch — ONE argument list for every law, so
      !! a later `do concurrent` kernel dispatches with a single
      !! `select case` and no reshaping.  `l_plus` is the viscous Obukhov
      !! scale of the CURRENT iterate: the single scalar that carries the
      !! stratification feedback for every implicit law.  Pass
      !! `CAVITY_L_PLUS_NEUTRAL` for the neutral / unsuppressed
      !! evaluation.
      !!
      !! `T_w`, `S_w`, `T_b`, `S_b` are in the list for `CAVITY_LAW_MK18`
      !! (reserved), the only law whose exchange velocities depend on the
      !! interface state; every law that ships ignores them.  They are
      !! carried now precisely so that adding MK18 later does not
      !! re-signature this seam or any kernel that calls it.
      !!
      !! `f_cor` is a SEPARATE scalar rather than `par%f_cor` so the 2-D
      !! driver can give each column its own Coriolis parameter WITHOUT
      !! building a modified copy of `ocean_cavity_exchange_t` in device
      !! code.  That type has default initialisers, and instantiating one
      !! inside an `!$acc routine seq` procedure makes nvfortran (23.9 to
      !! 26.5, `-acc=gpu`) emit a device default-init template whose
      !! generated name embeds the hex-encoded source filename — long
      !! enough names SIGSEGV the compiler's `fort2` pass.  The public
      !! `cavity_exchange_velocities` passes `par%f_cor`; the bundle's
      !! member is otherwise ignored here.
      !$acc routine seq
      type(ocean_cavity_exchange_t), intent(in) :: par
         !! Law selector + parameters (its `f_cor` member is NOT read).
      real(wp), intent(in) :: f_cor
         !! Coriolis parameter (1/s) for this column; `hj99` only.
      type(ocean_cavity_const_t), intent(in) :: const
         !! Constants bundle.
      real(wp), intent(in) :: u_star
         !! Friction velocity (m/s), strictly positive.
      real(wp), intent(in) :: l_plus
         !! Trial viscous Obukhov scale, or `CAVITY_L_PLUS_NEUTRAL`.
      real(wp), intent(in) :: T_w
         !! Far-field temperature (degC) — reserved-law argument.
      real(wp), intent(in) :: S_w
         !! Far-field salinity (g/kg) — reserved-law argument.
      real(wp), intent(in) :: T_b
         !! Trial interface temperature (degC) — reserved-law argument.
      real(wp), intent(in) :: S_b
         !! Trial interface salinity (g/kg) — reserved-law argument.
      real(wp), intent(out) :: gamma_t
         !! Heat exchange velocity (m/s).  Zero on any non-OK status.
      real(wp), intent(out) :: gamma_s
         !! Salt exchange velocity (m/s).  Zero on any non-OK status.
      integer, intent(out) :: ierr
         !! `CAVITY_MELT_*` status.

      ierr = CAVITY_MELT_OK
      gamma_t = 0.0_wp
      gamma_s = 0.0_wp

      if (.not. (ieee_is_finite(u_star) .and. ieee_is_finite(T_w) .and. &
                 ieee_is_finite(S_w) .and. ieee_is_finite(T_b) .and. &
                 ieee_is_finite(S_b))) then
         ierr = CAVITY_MELT_NONFINITE_INPUT
         return
      end if
      if (u_star <= 0.0_wp) then
         ierr = CAVITY_MELT_BAD_INPUT
         return
      end if

      select case (par%law)
      case (CAVITY_LAW_CONST_GAMMA)
         if (.not. (ieee_is_finite(par%gamma_t_coeff) .and. &
                    ieee_is_finite(par%gamma_s_coeff))) then
            ierr = CAVITY_MELT_NONFINITE_INPUT
            return
         end if
         gamma_t = par%gamma_t_coeff*u_star
         gamma_s = par%gamma_s_coeff*u_star
      case (CAVITY_LAW_HJ99)
         call cavity_gamma_hj99(u_star, l_plus, f_cor, const, gamma_t, gamma_s, ierr)
      case (CAVITY_LAW_YUNG25)
         call cavity_gamma_yung25(u_star, l_plus, gamma_t, gamma_s, ierr)
      case (CAVITY_LAW_JENKINS91, CAVITY_LAW_ROSEVEAR22, CAVITY_LAW_VT19, &
            CAVITY_LAW_MK18, CAVITY_LAW_BURCHARD22, CAVITY_LAW_JENKINS21)
         ! Reserved.  Each is implemented in the Python prototype
         ! `ice_shelf_melt/melt.py`, with the published ambiguities it
         ! carries recorded in that directory's CITATIONS.md.
         ierr = CAVITY_MELT_NOT_IMPLEMENTED
      case default
         ierr = CAVITY_MELT_LAW_INVALID
      end select
   end subroutine cavity_exchange_velocities_f