ice_ride_update_x_layer_impl Subroutine

private pure subroutine ice_ride_update_x_layer_impl(iareaT, uh, tr_flux_x_work, mca, val4, layer, dt_adv, ncat, nk, nx, ny)

Layer-indexed twin of ice_ride_update_x_impl for enth_ice/sal_ice/enth_snow (shape (nx,ny,ncat,nk)). Same algebra, applied to val4(:,:,:,layer).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: iareaT(nx,ny)
real(kind=wp), intent(in) :: uh(nx+1,ny,ncat)
real(kind=wp), intent(in) :: tr_flux_x_work(nx+1,ny,ncat)
real(kind=wp), intent(in) :: mca(nx,ny,ncat)
real(kind=wp), intent(inout) :: val4(nx,ny,ncat,nk)
integer, intent(in) :: layer
real(kind=wp), intent(in) :: dt_adv
integer, intent(in) :: ncat
integer, intent(in) :: nk
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ice_ride_update_x_layer_impl~~CallsGraph proc~ice_ride_update_x_layer_impl ice_ride_update_x_layer_impl local local proc~ice_ride_update_x_layer_impl->local

Called by

proc~~ice_ride_update_x_layer_impl~~CalledByGraph proc~ice_ride_update_x_layer_impl ice_ride_update_x_layer_impl proc~ice_pass_x ice_pass_x proc~ice_pass_x->proc~ice_ride_update_x_layer_impl proc~ice_transport_step ice_transport_step proc~ice_transport_step->proc~ice_pass_x proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_transport_step proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step_ice proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step_ice proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
integer, private :: c
real(kind=wp), private :: denom
real(kind=wp), private :: dti
real(kind=wp), private :: fe
real(kind=wp), private :: fe_term
real(kind=wp), private :: fw
real(kind=wp), private :: fw_term
real(kind=wp), private :: h_add
real(kind=wp), private :: hadde
real(kind=wp), private :: haddw
real(kind=wp), private :: hlst
real(kind=wp), private :: hlst_adj
real(kind=wp), private :: hnew
integer, private :: i
real(kind=wp), private :: i_htot
integer, private :: j
real(kind=wp), private :: mca_old
real(kind=wp), private :: val_e
real(kind=wp), private :: val_w

Source Code

   pure subroutine ice_ride_update_x_layer_impl(iareaT, uh, tr_flux_x_work, mca, val4, layer, &
                                                dt_adv, ncat, nk, nx, ny)
      !! Layer-indexed twin of `ice_ride_update_x_impl` for
      !! `enth_ice`/`sal_ice`/`enth_snow` (shape `(nx,ny,ncat,nk)`).  Same
      !! algebra, applied to `val4(:,:,:,layer)`.
      integer, intent(in) :: ncat, nk, nx, ny
      real(wp), intent(in) :: iareaT(nx, ny)
      real(wp), intent(in) :: uh(nx + 1, ny, ncat)
      real(wp), intent(in) :: tr_flux_x_work(nx + 1, ny, ncat)
      real(wp), intent(in) :: mca(nx, ny, ncat)
      real(wp), intent(inout) :: val4(nx, ny, ncat, nk)
      integer, intent(in) :: layer
      real(wp), intent(in) :: dt_adv
      integer :: i, j, c
      real(wp) :: fw, fe, val_w, val_e, mca_old, hlst, dti, hnew, h_add, denom, i_htot
      real(wp) :: hlst_adj, haddw, hadde, fw_term, fe_term

      do concurrent(j=1:ny, i=1:nx, c=1:ncat) &
         local(fw, fe, val_w, val_e, mca_old, hlst, dti, hnew, h_add, denom, i_htot, &
               hlst_adj, haddw, hadde, fw_term, fe_term)
         fw = uh(i, j, c)
         fe = uh(i + 1, j, c)
         if (fw /= 0.0_wp .or. fe /= 0.0_wp) then
            val_w = tr_flux_x_work(i, j, c)
            val_e = tr_flux_x_work(i + 1, j, c)
            mca_old = mca(i, j, c)
            hlst = max(mca_old, 0.0_wp)
            dti = dt_adv*iareaT(i, j)
            hnew = mca_old - dti*(fe - fw)
            if (hnew <= 0.0_wp) then
               continue
            else if (hnew < H_NEGLECT_ICE_TRANSPORT) then
               h_add = H_NEGLECT_ICE_TRANSPORT - hnew
               denom = hlst + dti*(abs(fe) + abs(fw))
               if (denom > 0.0_wp) then
                  i_htot = 1.0_wp/denom
               else
                  i_htot = 0.0_wp
               end if
               hlst_adj = hlst + h_add*hlst*i_htot
               haddw = h_add*dti*abs(fw)*i_htot
               hadde = h_add*dti*abs(fe)*i_htot
               fe_term = fe*dti - hadde
               fw_term = fw*dti + haddw
               val4(i, j, c, layer) = (val4(i, j, c, layer)*hlst_adj - (fe_term*val_e - fw_term*val_w)) &
                                      /H_NEGLECT_ICE_TRANSPORT
            else
               val4(i, j, c, layer) = (val4(i, j, c, layer)*mca_old - dti*(fe*val_e - fw*val_w))/hnew
            end if
         end if
      end do
   end subroutine ice_ride_update_x_layer_impl