Skip to content

Commit

Permalink
Update
Browse files Browse the repository at this point in the history
  • Loading branch information
@abhaasgoyal
abhaasgoyal committed Jun 5, 2024
1 parent 136dc5a commit d05850e
Show file tree
Hide file tree
Showing 2 changed files with 93 additions and 29 deletions.
120 changes: 92 additions & 28 deletions src/offline/cable_checks.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -210,12 +210,12 @@ SUBROUTINE check_range_i1_d1(parameter_i1, parameter_range, ktau, met)

INTEGER :: index

index = MAXLOC(parameter_i1, MASK=parameter_i1 < parameter_range(1) .OR. parameter_i1 > parameter_range(2), DIM=1)

! Review: Converting to double precision
IF (index .NE. 0) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_i1(index)), parameter_range, index, patch(index)%latitude, patch(index)%longitude)
END IF
DO index = 1, SIZE(parameter_i1)
IF (parameter_i1(index) < parameter_range(1) .OR. parameter_i1(index) > parameter_range(2)) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_i1(index)), \
parameter_range, index, patch(index)%latitude, patch(index)%longitude)
END IF
END DO

END SUBROUTINE check_range_i1_d1

Expand All @@ -228,11 +228,12 @@ SUBROUTINE check_range_r2_d1(parameter_r2, parameter_range, ktau, met)

INTEGER :: index

index = MAXLOC(parameter_r2, MASK=parameter_r2 < parameter_range(1) .OR. parameter_r2 > parameter_range(2), DIM=1)

IF (index .NE. 0) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_r2(index)), parameter_range, index, patch(index)%latitude, patch(index)%longitude)
END IF
DO index = 1, SIZE(parameter_r2)
IF (parameter_r2(index) < parameter_range(1) .OR. parameter_r2(index) > parameter_range(2)) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_r2(index)), \
parameter_range, index, patch(index)%latitude, patch(index)%longitude)
END IF
END DO

END SUBROUTINE check_range_r2_d1

Expand All @@ -244,46 +245,72 @@ SUBROUTINE check_range_r1_d1(parameter_r1, parameter_range, ktau, met)
REAL, DIMENSION(:), INTENT(IN) :: parameter_r1
REAL, DIMENSION(2), INTENT(IN) :: parameter_range


INTEGER :: index

index = MAXLOC(parameter_r1, MASK=parameter_r1 < parameter_range(1) .OR. parameter_r1 > parameter_range(2), DIM=1)
DO index = 1, SIZE(parameter_r1)
IF (parameter_r1(index) < parameter_range(1) .OR. parameter_r1(index) > parameter_range(2)) THEN
CALL range_abort("Out of range", ktau, met, parameter_r1(index), \
parameter_range, index, patch(index)%latitude, patch(index)%longitude)
END IF
END DO

IF (index .NE. 0) THEN
CALL range_abort("Out of range", ktau, met, parameter_r1(index), parameter_range, index, patch(index)%latitude, patch(index)%longitude)
END IF
END SUBROUTINE check_range_r1_d1


SUBROUTINE check_range_i2_d1(parameter_i2, parameter_range, ktau, met)
SUBROUTINE check_range_i1_d2(parameter_i2, parameter_range, ktau, met)
INTEGER, INTENT(IN) :: ktau
TYPE(met_type), INTENT(IN) :: met

INTEGER, DIMENSION(:,:), INTENT(IN) :: parameter_i2
REAL, DIMENSION(2), INTENT(IN) :: parameter_range

INTEGER :: max_val, min_val
INTEGER, DIMENSION(2) :: index

index = MAXLOC(parameter_i2, MASK=parameter_i2 < parameter_range(1) .OR. parameter_i2 > parameter_range(2), DIM=1)
index = 0
max_val = MAXVAL(parameter_i2)
min_val = MINVAL(parameter_i2)

IF (min_val < parameter_range(1)) THEN
index = FINDLOC(parameter_i2, min_val)
END IF

IF (max_val > parameter_range(2)) THEN
index = FINDLOC(parameter_i2, max_val)
END IF

IF (index(1) .NE. 0) THEN
IF (index(1) > 0) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_i2(index(1), index(2))), parameter_range, index(1), patch(index(1))%latitude, patch(index(1))%longitude)
END IF
END SUBROUTINE check_range_i2_d1

END SUBROUTINE check_range_i1_d2

SUBROUTINE check_range_r2_d2(parameter_r2, parameter_range, ktau, met)
INTEGER, INTENT(IN) :: ktau
TYPE(met_type), INTENT(IN) :: met

REAL(r_2), DIMENSION(:,:), INTENT(IN) :: parameter_r2
REAL, DIMENSION(2), INTENT(IN) :: parameter_range

REAL(r_2) :: max_val, min_val
INTEGER, DIMENSION(2) :: index

index = MAXLOC(parameter_r2, MASK=parameter_r2 < parameter_range(1) .OR. parameter_r2 > parameter_range(2))
index = 0
max_val = MAXVAL(parameter_r2)
min_val = MINVAL(parameter_r2)

IF (min_val < parameter_range(1)) THEN
index = FINDLOC(parameter_r2, min_val)
END IF

IF (max_val > parameter_range(2)) THEN
index = FINDLOC(parameter_r2, max_val)
END IF

IF (index(1) .NE. 0) THEN
IF (index(1) > 0) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_r2(index(1), index(2))), parameter_range, index(1), patch(index(1))%latitude, patch(index(1))%longitude)
END IF

END SUBROUTINE check_range_r2_d2

SUBROUTINE check_range_r1_d2(parameter_r1, parameter_range, ktau, met)
Expand All @@ -293,13 +320,25 @@ SUBROUTINE check_range_r1_d2(parameter_r1, parameter_range, ktau, met)
REAL, DIMENSION(:,:), INTENT(IN) :: parameter_r1
REAL, DIMENSION(2), INTENT(IN) :: parameter_range

REAL :: max_val, min_val
INTEGER, DIMENSION(2) :: index

index = MAXLOC(parameter_r1, MASK=parameter_r1 < parameter_range(1) .OR. parameter_r1 > parameter_range(2))
index = 0
max_val = MAXVAL(parameter_r1)
min_val = MINVAL(parameter_r1)

IF (min_val < parameter_range(1)) THEN
index = FINDLOC(parameter_r1, min_val)
END IF

IF (max_val > parameter_range(2)) THEN
index = FINDLOC(parameter_r1, max_val)
END IF

IF (index(1) .NE. 0) THEN
IF (index(1) > 0) THEN
CALL range_abort("Out of range", ktau, met, parameter_r1(index(1), index(2)), parameter_range, index(1), patch(index(1))%latitude, patch(index(1))%longitude)
END IF

END SUBROUTINE check_range_r1_d2

SUBROUTINE check_range_r2_d3(parameter_r2, parameter_range, ktau, met)
Expand All @@ -308,13 +347,26 @@ SUBROUTINE check_range_r2_d3(parameter_r2, parameter_range, ktau, met)

REAL(r_2), DIMENSION(:,:,:), INTENT(IN) :: parameter_r2
REAL, DIMENSION(2), INTENT(IN) :: parameter_range

INTEGER, DIMENSION(3) :: index
REAL(r_2) :: max_val, min_val

index = 0
max_val = MAXVAL(parameter_r2)
min_val = MINVAL(parameter_r2)

index = MAXLOC(parameter_r2, MASK=parameter_r2 < parameter_range(1) .OR. parameter_r2 > parameter_range(2))
IF (min_val < parameter_range(1)) THEN
index = FINDLOC(parameter_r2, min_val)
END IF

IF (max_val > parameter_range(2)) THEN
index = FINDLOC(parameter_r2, max_val)
END IF

IF (index(1) .NE. 0) THEN
IF (SIZE(index) > 0) THEN
CALL range_abort("Out of range", ktau, met, REAL(parameter_r2(index(0), index(1), index(2))), parameter_range, index(1), patch(index(1))%latitude, patch(index(1))%longitude)
END IF

END SUBROUTINE check_range_r2_d3

SUBROUTINE check_range_r1_d3(parameter_r1, parameter_range, ktau, met)
Expand All @@ -324,12 +376,24 @@ SUBROUTINE check_range_r1_d3(parameter_r1, parameter_range, ktau, met)
REAL, DIMENSION(:,:,:), INTENT(IN) :: parameter_r1
REAL, DIMENSION(2), INTENT(IN) :: parameter_range
INTEGER, DIMENSION(3) :: index
REAL :: max_val, min_val

index = 0
max_val = MAXVAL(parameter_r1)
min_val = MINVAL(parameter_r1)

index = MAXLOC(parameter_r1, MASK=parameter_r1 < parameter_range(1) .OR. parameter_r1 > parameter_range(2))
IF (min_val < parameter_range(1)) THEN
index = FINDLOC(parameter_r1, min_val)
END IF

IF (max_val > parameter_range(2)) THEN
index = FINDLOC(parameter_r1, max_val)
END IF

IF (index(1) .NE. 0) THEN
IF (SIZE(index) > 0) THEN
CALL range_abort("Out of range", ktau, met, parameter_r1(index(1), index(2), index(3)), parameter_range, index(1), patch(index(1))%latitude, patch(index(1))%longitude)
END IF

END SUBROUTINE check_range_r1_d3

! TODO add for integer
Expand Down
2 changes: 1 addition & 1 deletion src/offline/cable_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -620,7 +620,7 @@ PROGRAM cable_offline_driver

IF (check%ranges) THEN
WRITE (*, *) "Checking ranges"
CALL constant_check_range(soil, veg)
CALL constant_check_range(soil, veg, 0, met)
END IF

IF ( CABLE_USER%POPLUC .AND. TRIM(CABLE_USER%POPLUC_RunType) .EQ. 'static') &
Expand Down

0 comments on commit d05850e

Please sign in to comment.