meke_advect Subroutine

private pure subroutine meke_advect(nx, ny, sdt, adv_fac, iareaT, i_mass, baro_hu, baro_hv, uflux, vflux, meke)

Upwind flux-form advection of E by the barotropic mass transport. advFac = adv_fac/sdt uflux(I) = baroHu(I)advFacE_upwind (E_{I-1} if baroHu>0 else E_I) E += sdtIareaTI_mass((uflux_{i-1}-uflux_i)+(vflux_{j-1}-vflux_j)) Conservative on a closed domain (interior faces only; the divergence telescopes ⇒ Sum Earea*mass conserved). adv_fac=0 never reaches here (gated by the caller) ⇒ default bit-identity.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
real(kind=wp), intent(in) :: sdt
real(kind=wp), intent(in) :: adv_fac
real(kind=wp), intent(in) :: iareaT(nx,ny)
real(kind=wp), intent(in) :: i_mass(nx,ny)
real(kind=wp), intent(in) :: baro_hu(nx+1,ny)
real(kind=wp), intent(in) :: baro_hv(nx,ny+1)
real(kind=wp), intent(inout) :: uflux(nx+1,ny)
real(kind=wp), intent(inout) :: vflux(nx,ny+1)
real(kind=wp), intent(inout) :: meke(nx,ny)

Calls

proc~~meke_advect~~CallsGraph proc~meke_advect meke_advect local local proc~meke_advect->local

Called by

proc~~meke_advect~~CalledByGraph proc~meke_advect meke_advect proc~meke_step meke_step proc~meke_step->proc~meke_advect proc~run_meke_step run_meke_step proc~run_meke_step->proc~meke_step proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_meke_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 :: adv_per_t
real(kind=wp), private :: bh
integer, private :: i
integer, private :: j
real(kind=wp), private :: mke

Source Code

   pure subroutine meke_advect(nx, ny, sdt, adv_fac, iareaT, i_mass, &
                               baro_hu, baro_hv, uflux, vflux, meke)
      !! Upwind flux-form advection of E by the barotropic mass transport.
      !!   advFac = adv_fac/sdt
      !!   uflux(I) = baroHu(I)*advFac*E_upwind   (E_{I-1} if baroHu>0 else E_I)
      !!   E += sdt*IareaT*I_mass*((uflux_{i-1}-uflux_i)+(vflux_{j-1}-vflux_j))
      !! Conservative on a closed domain (interior faces only; the
      !! divergence telescopes ⇒ Sum E*area*mass conserved).  `adv_fac=0`
      !! never reaches here (gated by the caller) ⇒ default bit-identity.
      integer, intent(in) :: nx, ny
      real(wp), intent(in) :: sdt, adv_fac
      real(wp), intent(in) :: iareaT(nx, ny)
      real(wp), intent(in) :: i_mass(nx, ny)
      real(wp), intent(in) :: baro_hu(nx + 1, ny)
      real(wp), intent(in) :: baro_hv(nx, ny + 1)
      real(wp), intent(inout) :: uflux(nx + 1, ny)
      real(wp), intent(inout) :: vflux(nx, ny + 1)
      real(wp), intent(inout) :: meke(nx, ny)
      integer :: i, j
      real(wp) :: adv_per_t, bh, mke

      adv_per_t = 0.0_wp
      if (sdt > 0.0_wp) adv_per_t = adv_fac/sdt

      ! u-face upwind flux (array-edge faces carry zero ⇒ closed domain).
      do concurrent(j=1:ny, i=1:nx + 1)
         uflux(i, j) = 0.0_wp
      end do
      do concurrent(j=1:ny, i=2:nx) local(bh)
         bh = baro_hu(i, j)
         if (bh > 0.0_wp) then
            uflux(i, j) = bh*adv_per_t*meke(i - 1, j)
         else if (bh < 0.0_wp) then
            uflux(i, j) = bh*adv_per_t*meke(i, j)
         end if
      end do
      ! v-face upwind flux.
      do concurrent(j=1:ny + 1, i=1:nx)
         vflux(i, j) = 0.0_wp
      end do
      do concurrent(j=2:ny, i=1:nx) local(bh)
         bh = baro_hv(i, j)
         if (bh > 0.0_wp) then
            vflux(i, j) = bh*adv_per_t*meke(i, j - 1)
         else if (bh < 0.0_wp) then
            vflux(i, j) = bh*adv_per_t*meke(i, j)
         end if
      end do
      ! conservative divergence (uflux at face i is the LEFT face of cell i;
      ! face i+1 the RIGHT face).  Inflow-left minus outflow-right.
      do concurrent(j=1:ny, i=1:nx) local(mke)
         mke = sdt*(iareaT(i, j)*i_mass(i, j))* &
               ((uflux(i, j) - uflux(i + 1, j)) + (vflux(i, j) - vflux(i, j + 1)))
         meke(i, j) = meke(i, j) + mke
      end do
   end subroutine meke_advect