set_draft_linear Subroutine

public pure subroutine set_draft_linear(z_draft, grid, draft0, slope, x0, x1, y0, y1)

Linear-in-x draft z_draft = draft0 + slope*(x - x0) inside the shelf box, clipped at 0 from below (a formula that would lift the ice base above the sea surface is open water, not negative ice), and zero outside the box.

slope is in draft-metres per GRID unit; the dispatch converts the dimensionless namelist slope. Ghost rule as set_draft_flat.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(inout) :: z_draft(:,:)
type(hgrid_t), intent(in) :: grid
real(kind=wp), intent(in) :: draft0

Draft at x = x0 (m, positive down).
real(kind=wp), intent(in) :: slope

d(draft)/dx in draft-metres per grid unit.
real(kind=wp), intent(in) :: x0
real(kind=wp), intent(in) :: x1
real(kind=wp), intent(in) :: y0
real(kind=wp), intent(in) :: y1

Calls

proc~~set_draft_linear~~CallsGraph proc~set_draft_linear set_draft_linear proc~in_shelf_box in_shelf_box proc~set_draft_linear->proc~in_shelf_box

Called by

proc~~set_draft_linear~~CalledByGraph proc~set_draft_linear set_draft_linear proc~seed_cavity_draft seed_cavity_draft proc~seed_cavity_draft->proc~set_draft_linear proc~ocean_state_seed_from_cfg ocean_state_seed_from_cfg proc~ocean_state_seed_from_cfg->proc~seed_cavity_draft proc~engine_setup engine_setup proc~engine_setup->proc~ocean_state_seed_from_cfg proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_setup proc~driver_validate driver_validate proc~driver_validate->proc~engine_setup proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean proc~rdb_ocean_create_finalize rdb_ocean_create_finalize proc~rdb_ocean_create_finalize->proc~complete_ocean_create proc~rdb_ocean_create_from_string rdb_ocean_create_from_string proc~rdb_ocean_create_from_string->proc~complete_ocean_create

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: d_local
integer, private :: i
integer, private :: ioff
integer, private :: j
integer, private :: joff
integer, private :: ng
integer, private :: nxt
integer, private :: nyt
real(kind=wp), private :: x_phys
real(kind=wp), private :: y_phys

Source Code

   pure subroutine set_draft_linear(z_draft, grid, draft0, slope, x0, x1, y0, y1)
      !! Linear-in-x draft `z_draft = draft0 + slope*(x - x0)` inside the
      !! shelf box, clipped at 0 from below (a formula that would lift the
      !! ice base above the sea surface is open water, not negative ice),
      !! and zero outside the box.
      !!
      !! `slope` is in draft-metres per GRID unit; the dispatch converts
      !! the dimensionless namelist slope.  Ghost rule as `set_draft_flat`.
      real(wp), intent(inout) :: z_draft(:, :)
      type(hgrid_t), intent(in) :: grid
      real(wp), intent(in) :: draft0
         !! Draft at `x = x0` (m, positive down).
      real(wp), intent(in) :: slope
         !! d(draft)/dx in draft-metres per grid unit.
      real(wp), intent(in) :: x0, x1, y0, y1
      integer :: i, j, ng, nxt, nyt, ioff, joff
      real(wp) :: x_phys, y_phys, d_local

      ng = grid%nghost
      ioff = grid%i_offset_global
      joff = grid%j_offset_global
      nxt = size(z_draft, 1)
      nyt = size(z_draft, 2)

      do j = 1, nyt
         y_phys = (real(j - ng + joff, wp) - 0.5_wp)*grid%dy
         do i = 1, nxt
            x_phys = (real(i - ng + ioff, wp) - 0.5_wp)*grid%dx
            if (in_shelf_box(x_phys, y_phys, x0, x1, y0, y1)) then
               d_local = draft0 + slope*(x_phys - x0)
               if (d_local < 0.0_wp) d_local = 0.0_wp
               z_draft(i, j) = d_local
            else
               z_draft(i, j) = 0.0_wp
            end if
         end do
      end do
   end subroutine set_draft_linear