IsPointInsideInteger Function

public function IsPointInsideInteger(point, grid, checkCRS) result(inside)

check if a point is inside a raster cell with value different from nodata

Arguments

Type IntentOptional Attributes Name
type(Coordinate), intent(in) :: point
type(grid_integer), intent(in) :: grid
logical, intent(in) :: checkCRS

Return Value logical


Variables

Type Visibility Attributes Name Initial
integer(kind=float), public :: c
logical, public :: checkIn
type(Coordinate), public :: point2
integer(kind=float), public :: r

Source Code

LOGICAL FUNCTION IsPointInsideInteger &
!
(point, grid, checkCRS)  &
!
RESULT (inside)

IMPLICIT NONE

!Arguments with intent in:
TYPE (grid_integer),  INTENT(IN) :: grid
TYPE (Coordinate), INTENT(IN) :: point
LOGICAL,           INTENT(IN) :: checkCRS

!local declarations:
TYPE (Coordinate) :: point2
INTEGER (KIND = float) :: r, c
LOGICAL :: checkIn


!----------------------end of declarations-------------------------------------

inside = .FALSE.

IF ( checkCRS ) THEN !check CRS of point is the same of grid
    IF ( point % system == grid % grid_mapping ) THEN 
        !coordinate reference system is the same
        CALL GetIJ ( point % easting, point % northing, grid, &
                          r, c, checkIn)
        IF ( .NOT. checkIn) THEN !point is outside grid boundary
            RETURN
        END IF
        
        IF ( grid % mat (r,c) /= grid % nodata ) THEN
            inside = .TRUE.
            RETURN
        END IF
    ELSE
        !convert CRS 
        point2 % system = grid % grid_mapping
        CALL Convert (point, point2)
        CALL GetIJ ( point2 % easting, point2 % northing, grid, &
                          r, c, checkIn)
        IF ( .NOT. checkIn) THEN !point is outside grid boundary
            RETURN
        END IF
        
        IF ( grid % mat (r,c) /= grid % nodata ) THEN
            inside = .TRUE.
            RETURN
        END IF
    END IF
    
ELSE
    CALL GetIJ ( point % easting, point % northing, grid, &
                          r, c, checkIn)
    IF ( .NOT. checkIn) THEN !point is outside grid boundary
        RETURN
    END IF
        
    IF ( grid % mat (r,c) /= grid % nodata ) THEN
        inside = .TRUE.
        RETURN
    END IF
    
END IF

RETURN
END FUNCTION IsPointInsideInteger