interpolate_observations_thc Subroutine

subroutine interpolate_observations_thc(self, obs_values, domain, properties, nodal_temperature, nodal_porosity, nodal_pw)

Arguments

Type IntentOptional Attributes Name
class(type_output_observation), intent(inout) :: self
real(kind=real64), intent(out) :: obs_values(:)
type(type_domain), intent(inout), optional :: domain
type(type_proereties_manager), intent(inout), optional :: properties
real(kind=real64), intent(in), optional :: nodal_temperature(:)
real(kind=real64), intent(in), optional :: nodal_porosity(:)
real(kind=real64), intent(in), optional :: nodal_pw(:)

Calls

proc~~interpolate_observations_thc~~CallsGraph proc~interpolate_observations_thc interpolate_observations_thc get_group get_group proc~interpolate_observations_thc->get_group none~to_original_value type_reordering%to_original_value proc~interpolate_observations_thc->none~to_original_value proc~get_algorithm_name type_reordering%get_algorithm_name proc~interpolate_observations_thc->proc~get_algorithm_name interface~to_original_values_int32 type_reordering%to_original_values_int32 none~to_original_value->interface~to_original_values_int32 interface~to_original_values_real64 type_reordering%to_original_values_real64 none~to_original_value->interface~to_original_values_real64 proc~to_original_values_int32 to_original_values_int32 interface~to_original_values_int32->proc~to_original_values_int32 proc~to_original_values_real64 to_original_values_real64 interface~to_original_values_real64->proc~to_original_values_real64

Source Code

    subroutine interpolate_observations_thc(self, obs_values, domain, properties, &
                                            nodal_temperature, nodal_porosity, nodal_pw)
        implicit none
        class(type_output_observation), intent(inout) :: self
        real(real64), intent(out) :: obs_values(:)
        type(type_domain), intent(inout), optional :: domain
        type(type_proereties_manager), intent(inout), optional :: properties
        real(real64), intent(in), optional :: nodal_temperature(:)
        real(real64), intent(in), optional :: nodal_porosity(:)
        real(real64), intent(in), optional :: nodal_pw(:)

        type(type_gauss_point_state) :: state
        integer(int32) :: iObs, group_id
        real(real64), allocatable :: original_temperature(:)
        real(real64), allocatable :: original_porosity(:)
        integer(int32) :: istat

        ! Initialize to zero
        obs_values(:) = 0.0d0
        if (.not. present(nodal_temperature)) return
        if (.not. present(nodal_porosity)) return
        if (.not. present(properties)) return
        if (.not. present(nodal_pw)) then
            state%pressure = 101325.0d0

            if (.not. domain%reordering%get_algorithm_name() == "none") then
                allocate (original_temperature, mold=nodal_temperature)
                allocate (original_porosity, mold=nodal_porosity)
                call domain%reordering%to_original_value(nodal_temperature, original_temperature)
                call domain%reordering%to_original_value(nodal_porosity, original_porosity)
            else
                allocate (original_temperature, source=nodal_temperature)
                allocate (original_porosity, source=nodal_porosity)
            end if

            do iObs = 1, self%num_observations
                state%temperature = self%elements(iObs)%e%interpolate( &
                                    self%xi(iObs), self%eta(iObs), original_temperature(:))
                state%porosity = self%elements(iObs)%e%interpolate( &
                                 self%xi(iObs), self%eta(iObs), original_porosity(:))
                group_id = self%elements(iObs)%e%get_group()
                state%water_content = properties%get_qw(state, group_id)
                obs_values(iObs) = properties%get_thc(state, group_id)
            end do

            deallocate (original_temperature)
            deallocate (original_porosity)
        end if

    end subroutine interpolate_observations_thc