ice_ride_update_y_layer_impl Subroutine

private pure subroutine ice_ride_update_y_layer_impl(iareaT, vh, tr_flux_y_work, mca, val4, layer, dt_adv, ncat, nk, nx, ny)

Layer-indexed twin of ice_ride_update_y_impl for enth_ice/sal_ice/enth_snow (shape (nx,ny,ncat,nk)).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: iareaT(nx,ny)
real(kind=wp), intent(in) :: vh(nx,ny+1,ncat)
real(kind=wp), intent(in) :: tr_flux_y_work(nx,ny+1,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_y_layer_impl~~CallsGraph proc~ice_ride_update_y_layer_impl ice_ride_update_y_layer_impl local local proc~ice_ride_update_y_layer_impl->local

Called by

proc~~ice_ride_update_y_layer_impl~~CalledByGraph proc~ice_ride_update_y_layer_impl ice_ride_update_y_layer_impl proc~ice_pass_y ice_pass_y proc~ice_pass_y->proc~ice_ride_update_y_layer_impl proc~ice_transport_step ice_transport_step proc~ice_transport_step->proc~ice_pass_y 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 :: fn
real(kind=wp), private :: fn_term
real(kind=wp), private :: fs
real(kind=wp), private :: fs_term
real(kind=wp), private :: h_add
real(kind=wp), private :: haddn
real(kind=wp), private :: hadds
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_n
real(kind=wp), private :: val_s

Source Code

   pure subroutine ice_ride_update_y_layer_impl(iareaT, vh, tr_flux_y_work, mca, val4, layer, &
                                                dt_adv, ncat, nk, nx, ny)
      !! Layer-indexed twin of `ice_ride_update_y_impl` for
      !! `enth_ice`/`sal_ice`/`enth_snow` (shape `(nx,ny,ncat,nk)`).
      integer, intent(in) :: ncat, nk, nx, ny
      real(wp), intent(in) :: iareaT(nx, ny)
      real(wp), intent(in) :: vh(nx, ny + 1, ncat)
      real(wp), intent(in) :: tr_flux_y_work(nx, ny + 1, 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) :: fs, fn, val_s, val_n, mca_old, hlst, dti, hnew, h_add, denom, i_htot
      real(wp) :: hlst_adj, hadds, haddn, fs_term, fn_term

      do concurrent(j=1:ny, i=1:nx, c=1:ncat) &
         local(fs, fn, val_s, val_n, mca_old, hlst, dti, hnew, h_add, denom, i_htot, &
               hlst_adj, hadds, haddn, fs_term, fn_term)
         fs = vh(i, j, c)
         fn = vh(i, j + 1, c)
         if (fs /= 0.0_wp .or. fn /= 0.0_wp) then
            val_s = tr_flux_y_work(i, j, c)
            val_n = tr_flux_y_work(i, j + 1, c)
            mca_old = mca(i, j, c)
            hlst = max(mca_old, 0.0_wp)
            dti = dt_adv*iareaT(i, j)
            hnew = mca_old - dti*(fn - fs)
            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(fn) + abs(fs))
               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
               hadds = h_add*dti*abs(fs)*i_htot
               haddn = h_add*dti*abs(fn)*i_htot
               fn_term = fn*dti - haddn
               fs_term = fs*dti + hadds
               val4(i, j, c, layer) = (val4(i, j, c, layer)*hlst_adj - (fn_term*val_n - fs_term*val_s)) &
                                      /H_NEGLECT_ICE_TRANSPORT
            else
               val4(i, j, c, layer) = (val4(i, j, c, layer)*mca_old - dti*(fn*val_n - fs*val_s))/hnew
            end if
         end if
      end do
   end subroutine ice_ride_update_y_layer_impl