distrl_sqr Subroutine

public subroutine distrl_sqr(x0, y0, x1, y1, x2, y2, xm, ym, dm_sqr, wm)

Arguments

Type IntentOptional Attributes Name
real, intent(in) :: x0

Receptor point x-coordinate

real, intent(in) :: y0

Receptor point y-coordinate

real, intent(in) :: x1

Line source x-coordinate 1

real, intent(in) :: y1

Line source y-coordinate 1

real, intent(in) :: x2

Line source x-coordinate 2

real, intent(in) :: y2

Line source y-coordinate 2

real, intent(out) :: xm

Minimum distance x-coordinate

real, intent(out) :: ym

Minimum distance y-coordinate

real, intent(out) :: dm_sqr

Minimum distance

real :: wm

Called by

proc~~distrl_sqr~~CalledByGraph proc~distrl_sqr distrl_sqr proc~uemep_local_trajectory uEMEP_local_trajectory proc~uemep_local_trajectory->proc~distrl_sqr proc~uemep_minimum_distance_trajectory_fast uEMEP_minimum_distance_trajectory_fast proc~uemep_minimum_distance_trajectory_fast->proc~distrl_sqr 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 distrl_sqr(x0, y0, x1, y1, x2, y2, xm, ym, dm_sqr, wm)
        real, intent(in) :: x0 !! Receptor point x-coordinate
        real, intent(in) :: y0 !! Receptor point y-coordinate
        real, intent(in) :: x1 !! Line source x-coordinate 1
        real, intent(in) :: y1 !! Line source y-coordinate 1
        real, intent(in) :: x2 !! Line source x-coordinate 2
        real, intent(in) :: y2 !! Line source y-coordinate 2
        real, intent(out) :: xm !! Minimum distance x-coordinate
        real, intent(out) :: ym !! Minimum distance y-coordinate
        real, intent(out) :: dm_sqr !! Minimum distance

        ! Local variables
        real :: num, denum, wm

        if (x1 == x2 .and. y1 == y2) then
            wm = 0.5
        else
            num = (x0 - x1)*(x2 - x1) + (y0 - y1)*(y2 - y1)
            denum = (x2 - x1)*(x2 - x1) + (y2 - y1)*(y2 - y1)
            wm = num/denum
        end if

        wm = min(wm, 1.0)
        wm = max(wm, 0.0)

        xm = (1.0 - wm)*x1 + wm*x2
        ym = (1.0 - wm)*y1 + wm*y2
        dm_sqr = (x0 - xm)*(x0 - xm) + (y0 - ym)*(y0 - ym)
    end subroutine distrl_sqr