uEMEP_minimum_distance_trajectory_fast Subroutine

public subroutine uEMEP_minimum_distance_trajectory_fast(x_r, y_r, traj_max_index_in, dr_traj, x_traj, y_traj, x_loc, y_loc, valid_traj)

Uses

  • proc~~uemep_minimum_distance_trajectory_fast~~UsesGraph proc~uemep_minimum_distance_trajectory_fast uEMEP_minimum_distance_trajectory_fast module~uemep_definitions uEMEP_definitions proc~uemep_minimum_distance_trajectory_fast->module~uemep_definitions

Arguments

Type IntentOptional Attributes Name
real, intent(in) :: x_r
real, intent(in) :: y_r
integer, intent(in) :: traj_max_index_in
real, intent(in) :: dr_traj
real, intent(in) :: x_traj(*)
real, intent(in) :: y_traj(*)
real, intent(out) :: x_loc
real, intent(out) :: y_loc
logical, intent(out) :: valid_traj

Calls

proc~~uemep_minimum_distance_trajectory_fast~~CallsGraph proc~uemep_minimum_distance_trajectory_fast uEMEP_minimum_distance_trajectory_fast proc~distrl_sqr distrl_sqr proc~uemep_minimum_distance_trajectory_fast->proc~distrl_sqr

Called by

proc~~uemep_minimum_distance_trajectory_fast~~CalledByGraph proc~uemep_minimum_distance_trajectory_fast uEMEP_minimum_distance_trajectory_fast proc~uemep_subgrid_deposition uEMEP_subgrid_deposition proc~uemep_subgrid_deposition->proc~uemep_minimum_distance_trajectory_fast proc~uemep_subgrid_dispersion uEMEP_subgrid_dispersion proc~uemep_subgrid_dispersion->proc~uemep_minimum_distance_trajectory_fast proc~uemep_subgrid_dispersion_integral uEMEP_subgrid_dispersion_integral proc~uemep_subgrid_dispersion->proc~uemep_subgrid_dispersion_integral proc~uemep_subgrid_dispersion_integral->proc~uemep_minimum_distance_trajectory_fast program~uemep uEMEP program~uemep->proc~uemep_subgrid_deposition program~uemep->proc~uemep_subgrid_dispersion

Source Code

    subroutine uEMEP_minimum_distance_trajectory_fast(x_r,y_r,traj_max_index_in,dr_traj,x_traj,y_traj,x_loc,y_loc,valid_traj)

        use uEMEP_definitions

        implicit none

        real, intent(out) ::  x_loc,y_loc
        logical, intent(out) ::  valid_traj
        real, intent(in) ::  dr_traj
        real, intent(in) ::  x_r,y_r
        integer, intent(in) :: traj_max_index_in
        !real, intent(in) ::  x_traj(traj_max_index_in),y_traj(traj_max_index_in)
        real, intent(in) ::  x_traj(*),y_traj(*)

        integer k
        real distance_traj,distance_intercept_traj
        real x_intercept_traj,y_intercept_traj,frac_length_traj

        real distance_intercept_min

        k=1
        !return

        !Set the distances for the initial emission grid
        !distance_traj(k)=sqrt((x_traj(k)-x_r)*(x_traj(k)-x_r)+(y_traj(k)-y_r)*(y_traj(k)-y_r))
        distance_traj=(x_traj(k)-x_r)*(x_traj(k)-x_r)+(y_traj(k)-y_r)*(y_traj(k)-y_r)

        !Leave the routine because the receptor is the same as the emission grid
        if (distance_traj.eq.0) then
            y_loc=0.
            x_loc=0.
            valid_traj=.true.
            return
        endif

        !distance_intercept_traj(k)=distance_traj(k)
        y_loc=0.
        x_loc=0.
        valid_traj=.false.

        distance_intercept_min=distance_traj

        do k=2,traj_max_index_in
            if (x_traj(k).ne.NODATA_value) then
                call distrl_sqr(x_r,y_r,x_traj(k-1),y_traj(k-1),x_traj(k),y_traj(k),x_intercept_traj,y_intercept_traj,distance_intercept_traj,frac_length_traj)

                if (distance_intercept_traj.lt.distance_intercept_min) then
                    distance_intercept_min=distance_intercept_traj
                    y_loc=distance_intercept_traj
                    x_loc=dr_traj*(k-2)+frac_length_traj*dr_traj
                    valid_traj=.true.
                endif
            endif
        enddo

        !Remove most of the results because they are upwind
        if (x_loc.eq.0.and.y_loc.gt.dr_traj) then
            valid_traj=.false.
        endif

        y_loc=sqrt(y_loc)

    end subroutine uEMEP_minimum_distance_trajectory_fast