upstream_calculate Subroutine

private subroutine upstream_calculate(this, t, func, b)

Calculates the boundary values to use at the current time with the current ice thickness.

Arguments

Type IntentOptional AttributesName
class(upstream_plume_boundary), intent(inout) :: this
real(kind=r8), intent(in) :: t

The time at which to calculate the boundary values.

procedure(non_diff) :: func

A function which returns the non-diffusive, non-inertial components of the ODEs describing the plume.

class(scalar_field), intent(in) :: b

The depth of the ice shelf base.


Calls

proc~~upstream_calculate~~CallsGraph proc~upstream_calculate upstream_calculate str str proc~upstream_calculate->str interface~range_integrate range_integrate proc~upstream_calculate->interface~range_integrate interface~setup setup proc~upstream_calculate->interface~setup interface~collect_garbage collect_garbage proc~upstream_calculate->interface~collect_garbage proc~range_integrate_r1 range_integrate_r1 interface~range_integrate->proc~range_integrate_r1 proc~setup_r1 setup_r1 interface~setup->proc~setup_r1 proc~collect_garbage_r1 collect_garbage_r1 interface~collect_garbage->proc~collect_garbage_r1 proc~method_const method_const proc~setup_r1->proc~method_const proc~rkmsg_r1 rkmsg_r1 proc~setup_r1->proc~rkmsg_r1 proc~machine_const machine_const proc~setup_r1->proc~machine_const interface~reset_t_end reset_t_end proc~range_integrate_r1->interface~reset_t_end interface~interpolate interpolate proc~range_integrate_r1->interface~interpolate interface~step_integrate step_integrate proc~range_integrate_r1->interface~step_integrate proc~set_saved_state_r1 set_saved_state_r1 proc~range_integrate_r1->proc~set_saved_state_r1 proc~get_saved_state_r1 get_saved_state_r1 proc~range_integrate_r1->proc~get_saved_state_r1 proc~range_integrate_r1->proc~rkmsg_r1 proc~get_saved_fatal_r1 get_saved_fatal_r1 proc~range_integrate_r1->proc~get_saved_fatal_r1 proc~reset_t_end_r1 reset_t_end_r1 interface~reset_t_end->proc~reset_t_end_r1 proc~interpolate_r1 interpolate_r1 interface~interpolate->proc~interpolate_r1 proc~step_integrate_r1 step_integrate_r1 interface~step_integrate->proc~step_integrate_r1 proc~rkmsg_r1->proc~set_saved_state_r1 proc~get_stop_on_fatal_r1 get_stop_on_fatal_r1 proc~rkmsg_r1->proc~get_stop_on_fatal_r1 proc~step_integrate_r1->proc~set_saved_state_r1 proc~step_integrate_r1->proc~get_saved_state_r1 proc~step_integrate_r1->proc~rkmsg_r1 proc~stiff_r1 stiff_r1 proc~step_integrate_r1->proc~stiff_r1 proc~step_r1 step_r1 proc~step_integrate_r1->proc~step_r1 proc~truerr_r1 truerr_r1 proc~step_integrate_r1->proc~truerr_r1 proc~interpolate_r1->proc~get_saved_state_r1 proc~interpolate_r1->proc~rkmsg_r1 proc~reset_t_end_r1->proc~get_saved_state_r1 proc~reset_t_end_r1->proc~rkmsg_r1 proc~truerr_r1->proc~step_r1

Contents

Source Code


Source Code

  subroutine upstream_calculate(this, t, func, b)
    !* Author: Chris MacMackin
    !  Date: July 2017
    !
    ! Calculates the boundary values to use at the current time with
    ! the current ice thickness.
    !
    class(upstream_plume_boundary), intent(inout) :: this
    real(r8), intent(in)                          :: t
      !! The time at which to calculate the boundary values.
    procedure(non_diff)                           :: func
      !! A function which returns the non-diffusive, non-inertial
      !! components of the ODEs describing the plume.
    class(scalar_field), intent(in)               :: b
      !! The depth of the ice shelf base.

    integer :: n
    real(r8) :: D_0, U_0, S_0, T_0, DU_0, DUS_0, DUT_0
    real(r8), dimension(:), allocatable :: Uvec_0, DUvecU_0
    class(scalar_field), pointer :: b_x
    real(r8), dimension(:), allocatable :: y0, ygot, yderiv_got
    real(r8) :: xgot
    integer :: flag
    type(rk_comm_real_1d) :: comm

    call b%guard_temp()
    call this%get_boundaries(t, D_0, Uvec_0, T_0, S_0)

    U_0 = Uvec_0(1)
    DU_0 = D_0*U_0
    DUvecU_0 = DU_0*Uvec_0
    DUT_0 = DU_0*T_0
    DUS_0 = DU_0*S_0
    y0 = [DU_0, DUvecU_0, DUT_0, DUS_0]
    n = size(y0)
    allocate(ygot(n), yderiv_got(n))
    if (.not. allocated(this%thresholds)) then
      allocate(this%thresholds(n))
      this%thresholds = 1._r8
    end if
    b_x => b%d_dx(1)
    call b_x%guard_temp()

    call setup(comm, 0._r8, y0, this%distance, 1e-6_r8, this%thresholds, &
               method='h', h_start=2e-3_r8*this%distance)
    call range_integrate(comm, integrand, this%distance, xgot, ygot, &
                         yderiv_got, flag)
    if (flag /= 1) then
      call logger%error('upstream_plume_boundary%calculate',            &
                        'Could only integrate plume to x = '//str(xgot))
    end if
    !this%thresholds = abs(ygot) + 1e-10
    this%thickness = ygot(1)**2/ygot(2)
    this%velocity = ygot(2:n-2)/ygot(1)
    this%temperature = ygot(n-1)/ygot(1)
    this%salinity = ygot(n)/ygot(1)
    call logger%trivia('upstream_plume_boundary%calculate',             &
         'Calculated boundary values D='//str(this%thickness)//', U='// &
         str(this%velocity)//', T='//str(this%temperature)//', S='//    &
         str(this%salinity))
    if (this%thickness < 0._r8) error stop ('Negative plume thickness found')
    call collect_garbage(comm)
    call b%clean_temp(); call b_x%clean_temp()

  contains

    function integrand(x, y) result(f)
      real(r8), intent(in)               :: x
        !! The independent variable
      real(r8), dimension(:), intent(in) :: y
        !! The dependent variable
      real(r8), dimension(size(y))       :: f
        !! The derivatives

      type(uniform_scalar_field)   :: D, T, S, DU_x, DUT_x, DUS_x
      type(uniform_vector_field)   :: Uvec, DUU_x
      type(uniform_gradient_field) :: b_loc
      D = uniform_scalar_field(y(1)**2/y(2))
      Uvec = uniform_vector_field(y(2:n-2)/y(1))
      T = uniform_scalar_field(y(n-1)/y(1))
      S = uniform_scalar_field(y(n)/y(1))
      b_loc = uniform_gradient_field(b%interpolate([x]), [b_x%interpolate([x])])
      call func(D, Uvec, T, S, b_loc, DU_x, DUU_x, DUT_x, DUS_x)
      f(1) = DU_x%get_value()
      f(2:n-2) = DUU_x%get_value()
      f(n-1) = DUT_x%get_value()
      f(n) = DUS_x%get_value()
    end function integrand
    
  end subroutine upstream_calculate