rescale_anomaly_ke Subroutine

private pure subroutine rescale_anomaly_ke(nz, h_old_face, h_new_face, u_old_col, u_new_col)

KE-conserving rescale of a remapped face-velocity column. The column remap conserves momentum (Σ h·u) but not KE; restore it by rescaling ONLY the baroclinic anomaly (Adcroft & Hallberg 2006): scale = sqrt(KE_old_anom/KE_new_anom), clamped to [0, 1.25] u_new(k) = u_bar_new + scale·(u_new(k) - u_bar_new) Barotropic mean u_bar preserved verbatim; degenerate columns untouched.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nz
real(kind=wp), intent(in) :: h_old_face(NZ_STACK_MAX)
real(kind=wp), intent(in) :: h_new_face(NZ_STACK_MAX)
real(kind=wp), intent(in) :: u_old_col(NZ_STACK_MAX)
real(kind=wp), intent(inout) :: u_new_col(NZ_STACK_MAX)

Called by

proc~~rescale_anomaly_ke~~CalledByGraph proc~rescale_anomaly_ke rescale_anomaly_ke proc~remap_x_face_velocity remap_x_face_velocity proc~remap_x_face_velocity->proc~rescale_anomaly_ke proc~remap_y_face_velocity remap_y_face_velocity proc~remap_y_face_velocity->proc~rescale_anomaly_ke proc~ocean_apply_ale_remap_faces ocean_apply_ale_remap_faces proc~ocean_apply_ale_remap_faces->proc~remap_x_face_velocity proc~ocean_apply_ale_remap_faces->proc~remap_y_face_velocity proc~ocean_apply_ale_remap_step ocean_apply_ale_remap_step proc~ocean_apply_ale_remap_step->proc~remap_x_face_velocity proc~ocean_apply_ale_remap_step->proc~remap_y_face_velocity proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~ocean_apply_ale_remap_step proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: anom
real(kind=wp), private :: h_new_sum
real(kind=wp), private :: h_old_sum
integer, private :: k
real(kind=wp), private :: ke_new
real(kind=wp), private :: ke_old
real(kind=wp), private :: mom_new
real(kind=wp), private :: mom_old
real(kind=wp), private :: scale_fac
real(kind=wp), private :: u_bar_new
real(kind=wp), private :: u_bar_old

Source Code

   pure subroutine rescale_anomaly_ke(nz, h_old_face, h_new_face, u_old_col, u_new_col)
      !$acc routine seq
      !$omp declare target
      !! KE-conserving rescale of a remapped face-velocity column.
      !! The column remap conserves momentum (Σ h·u) but not KE; restore it by
      !! rescaling ONLY the baroclinic anomaly (Adcroft & Hallberg 2006):
      !!   scale = sqrt(KE_old_anom/KE_new_anom), clamped to [0, 1.25]
      !!   u_new(k) = u_bar_new + scale·(u_new(k) - u_bar_new)
      !! Barotropic mean u_bar preserved verbatim; degenerate columns untouched.
      integer, intent(in) :: nz
      real(wp), intent(in) :: h_old_face(NZ_STACK_MAX)
      real(wp), intent(in) :: h_new_face(NZ_STACK_MAX)
      real(wp), intent(in) :: u_old_col(NZ_STACK_MAX)
      real(wp), intent(inout) :: u_new_col(NZ_STACK_MAX)
      integer :: k
      real(wp) :: h_old_sum, h_new_sum, mom_old, mom_new
      real(wp) :: u_bar_old, u_bar_new, ke_old, ke_new, anom, scale_fac

      h_old_sum = 0.0_wp
      h_new_sum = 0.0_wp
      mom_old = 0.0_wp
      mom_new = 0.0_wp
      do k = 1, nz
         h_old_sum = h_old_sum + h_old_face(k)
         h_new_sum = h_new_sum + h_new_face(k)
         mom_old = mom_old + h_old_face(k)*u_old_col(k)
         mom_new = mom_new + h_new_face(k)*u_new_col(k)
      end do
      ! Dry / vanishing column: nothing to rescale.
      if (h_old_sum <= H_FLOOR .or. h_new_sum <= H_FLOOR) return
      u_bar_old = mom_old/h_old_sum
      u_bar_new = mom_new/h_new_sum

      ke_old = 0.0_wp
      ke_new = 0.0_wp
      do k = 1, nz
         anom = u_old_col(k) - u_bar_old
         ke_old = ke_old + 0.5_wp*h_old_face(k)*anom*anom
         anom = u_new_col(k) - u_bar_new
         ke_new = ke_new + 0.5_wp*h_new_face(k)*anom*anom
      end do
      ! No anomaly KE on either side ⇒ pure barotropic column, leave as-is.
      if (ke_new <= 0.0_wp .or. ke_old <= 0.0_wp) return
      scale_fac = sqrt(ke_old/ke_new)
      if (scale_fac > 1.25_wp) scale_fac = 1.25_wp
      if (scale_fac < 0.0_wp) scale_fac = 0.0_wp
      do k = 1, nz
         u_new_col(k) = u_bar_new + scale_fac*(u_new_col(k) - u_bar_new)
      end do
   end subroutine rescale_anomaly_ke