solidellipsoidCubeOverlap Function

private function solidellipsoidCubeOverlap(me, cube) result(overlap)

This function checks intesection of solid cube and solid ellipsoid

This algorithm is taken from http://tog.acm.org/resources/GraphicsGems/gems/Boxellipsoid.c

Arguments

Type IntentOptional Attributes Name
type(tem_ellipsoid_type), intent(in) :: me

ellipsoid object

type(tem_cube_type), intent(in) :: cube

cube object

Return Value logical


Called by

proc~~solidellipsoidcubeoverlap~~CalledByGraph proc~solidellipsoidcubeoverlap solidellipsoidCubeOverlap proc~tem_ellipsoidcubeoverlap tem_ellipsoidCubeOverlap proc~tem_ellipsoidcubeoverlap->proc~solidellipsoidcubeoverlap proc~tem_shape_subtreefromgeominters tem_shape_subTreeFromGeomInters proc~tem_shape_subtreefromgeominters->proc~tem_ellipsoidcubeoverlap proc~tem_shape2subtree tem_shape2subTree proc~tem_shape2subtree->proc~tem_shape_subtreefromgeominters proc~tem_create_subtree_of tem_create_subTree_of proc~tem_create_subtree_of->proc~tem_shape2subtree

Contents


Source Code

  function solidellipsoidCubeOverlap(me, cube) result(overlap)
    ! --------------------------------------------------------------------------!
    !> ellipsoid object
    type(tem_ellipsoid_type), intent(in) :: me
    !> cube object
    type(tem_cube_type), intent(in) :: cube
    logical :: overlap !< return value
    ! --------------------------------------------------------------------------!
    ! local variables
    integer :: i
    real(kind=rk) :: dmin
    ! --------------------------------------------------------------------------!

    ! minimum distance
    dmin = 0.0_rk

    do i=1,3
      if ( me%origin(i) < cube%origin(i) ) then
        dmin = dmin + &
          &  ( me%origin(i) - cube%origin(i) )**2 / me%radius(i)**2
        ! dmin = dmin + ( me%origin(i) - cube%origin(i) )**2
      else if ( me%origin(i) > cube%endPnt(i) ) then
        dmin = dmin + &
          &  ( me%origin(i) - cube%endPnt(i) )**2 / me%radius(i)**2
        ! dmin = dmin +  ( me%origin(i) - cube%endPnt(i) )**2
      end if
    end do

    overlap = ( dmin <= 1.0_rk )

  end function solidellipsoidCubeOverlap