UpstreamCell Subroutine

public subroutine UpstreamCell(i, j, flowdir, flowacc, is, js, found, dx)

returns the position (is,js) of the upstream cell and, optionally, the flow path length, considering cardinal and diagonal direction

Arguments

Type IntentOptional Attributes Name
integer(kind=short), intent(in) :: i

current cell
integer(kind=short), intent(in) :: j

current cell
type(grid_integer), intent(in) :: flowdir

flow direction map
type(grid_real), intent(in) :: flowacc

flow accumulation map
integer(kind=short), intent(out) :: is

upstream cell
integer(kind=short), intent(out) :: js

upstream cell
logical, intent(out) :: found

upsteam cell found
real(kind=float), intent(out), optional :: dx

flow path length [m]

Variables

Type Visibility Attributes Name Initial
integer(kind=short), public :: col
real(kind=float), public :: deltaArea
real(kind=float), public :: minDeltaArea
integer(kind=short), public :: row
real(kind=float), public :: x
real(kind=float), public :: xs
real(kind=float), public :: y
real(kind=float), public :: ys

Source Code

SUBROUTINE UpstreamCell &
!
(i, j, flowdir, flowacc, is, js, found, dx)

IMPLICIT NONE

!Arguments with intent in:
INTEGER (KIND = short), INTENT (IN) :: i, j !!current cell
TYPE (grid_integer), INTENT (IN) :: flowdir  !!flow direction map
TYPE (grid_real), INTENT (IN) :: flowacc !! flow accumulation map

!Arguments with intent out:
INTEGER (KIND = short), INTENT (OUT) :: is,js !!upstream cell
LOGICAL, INTENT(OUT) :: found  !! upsteam cell found
REAL (KIND = float), INTENT (OUT) ,OPTIONAL :: dx !!flow path length [m]

!Local declarations
REAL (KIND = float) :: x,y,xs,ys
INTEGER (KIND = short) :: row, col
REAL (KIND = float) :: minDeltaArea, deltaArea


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


minDeltaArea = 1000000000.
is = 0
js = 0
found = .FALSE.

!east cell
row = i
col = j + 1
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == W ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF

!south-east cell
row = i + 1
col = j + 1
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == NW ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF

!south cell
row = i + 1
col = j 
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == N ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF


!south-west cell
row = i + 1
col = j - 1
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == NE ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF

!west cell
row = i
col = j - 1
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == E ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF


!north-west cell
row = i - 1
col = j - 1
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == SE ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF


!north cell
row = i - 1
col = j 
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == S ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF

!north-east cell
row = i - 1
col = j + 1
IF(.NOT. IsOutOfGrid(row,col,flowDir) ) THEN
    IF(flowDir%mat(row,col) == SW ) THEN
        !check delta area
        deltaArea = flowacc % mat (i, j) - flowacc % mat (row,col)
        
        IF ( deltaArea > 0. .AND. deltaArea < minDeltaArea ) THEN
            found = .TRUE.
            minDeltaArea = deltaArea
            is = row
            js = col
        END IF

    ENDIF
ENDIF

IF (found) THEN
    IF (PRESENT (dx) ) THEN
        CALL GetXY (i,j,flowDir,x,y)
        CALL GetXY (is,js,flowDir,xs,ys)
        
        point1 % system = flowDir % grid_mapping
        point2 % system = flowDir % grid_mapping
        
        point1 % northing = y  
        point1 % easting = x
        point2 % northing = ys  
        point2 % easting = xs

       dx = distance(point1,point2)

    END IF
END IF

END SUBROUTINE UpstreamCell