!! compute grid statistics
!|author: Giovanni Ravazzani
! license: GPL
!
!### History
!
! current version 1.2 - 24th Jan 2020
!
! | version | date | comment |
! |----------|-------------|----------|
! | 1.0 | 19/Dec/2016 | routines moved from GridOperations module |
! | 1.1 | 04/Sep/2018 | GetCV to compute coefficient of variation of a grid |
! | 1.2 | 24/Jan/2020 | Added subroutine UniqueValues to retrieve a list of distinct values from a grid_integer |
!
!
!### License
! license: GNU GPL
!
! This file is part of
!
! MOSAICO -- MOdular library for raSter bAsed hydrologIcal appliCatiOn.
!
! Copyright (C) 2011 Giovanni Ravazzani
!
!### Module Description:
! library to compute grids statistics
MODULE GridStatistics
! Modules used:
USE DataTypeSizes, ONLY: &
! Imported type definitions:
short, long, float
USE LogLib, ONLY: &
! Imported routines:
Catch
USE GridLib, ONLY: &
!Imported type definitions:
grid_integer, grid_real
USE GridOperations, ONLY: &
!Imported routines:
CRSisEqual, Grid2vector
!USE GeoLib, ONLY: &
!Imported operators:
!OPERATOR (==)
IMPLICIT NONE
!global (public declarations)
INTERFACE GetMean
MODULE PROCEDURE GetMeanOfGridFloat
MODULE PROCEDURE GetMeanOfGridInteger
END INTERFACE
INTERFACE GetStDev
MODULE PROCEDURE GetStDevOfGridFloat
MODULE PROCEDURE GetStDevOfGridInteger
END INTERFACE
INTERFACE GetMin
MODULE PROCEDURE GetMinOfGridFloat
MODULE PROCEDURE GetMinOfGridInteger
END INTERFACE
INTERFACE GetCV
MODULE PROCEDURE GetCVofGridFloat
!MODULE PROCEDURE GetCVofGridInteger
END INTERFACE
INTERFACE GetMax
MODULE PROCEDURE GetMaxOfGridFloat
MODULE PROCEDURE GetMaxOfGridInteger
END INTERFACE
INTERFACE GetSum
MODULE PROCEDURE GetSumOfGridFloat
MODULE PROCEDURE GetSumOfGridInteger
END INTERFACE
INTERFACE CountCells
MODULE PROCEDURE CountCellsFloat
MODULE PROCEDURE CountCellsInteger
END INTERFACE
INTERFACE MinMaxNormalization
MODULE PROCEDURE MinMaxNormalizationFloat
!MODULE PROCEDURE MinMaxNormalizationInteger !seems not useful
END INTERFACE
INTERFACE GetBias
MODULE PROCEDURE GetBiasFloat
!MODULE PROCEDURE GetBiasInteger !TO BE IMPLEMENTED IF REQUIRED
END INTERFACE
INTERFACE GetRMSE
MODULE PROCEDURE GetRMSEfloat
!MODULE PROCEDURE GetRMSEinteger !TO BE IMPLEMENTED IF REQUIRED
END INTERFACE
INTERFACE GetNSE
MODULE PROCEDURE GetNSEfloat
!MODULE PROCEDURE GetNSEinteger !TO BE IMPLEMENTED IF REQUIRED
END INTERFACE
INTERFACE GetR2
MODULE PROCEDURE GetR2float
!MODULE PROCEDURE GetR2integer !TO BE IMPLEMENTED IF REQUIRED
END INTERFACE
INTERFACE UniqueValues
MODULE PROCEDURE UniqueValuesOfGridInteger
END INTERFACE
!global procedures:
PUBLIC :: GetMean
PUBLIC :: GetStDev
PUBLIC :: GetMin
PUBLIC :: GetMax
PUBLIC :: GetSum
PUBLIC :: CountCells
PUBLIC :: MinMaxNormalization
PUBLIC :: GetRMSE
PUBLIC :: GetBias
PUBLIC :: GetNSE
PUBLIC :: GetR2
PUBLIC :: GetCV
PUBLIC :: UniqueValues
! Local (i.e. private) Declarations:
! Local Procedures:
PRIVATE :: GetMeanOfGridFloat
PRIVATE :: GetMeanOfGridInteger
PRIVATE :: GetStDevOfGridFloat
PRIVATE :: GetStDevOfGridInteger
PRIVATE :: GetMinOfGridFloat
PRIVATE :: GetMinOfGridInteger
PRIVATE :: GetMaxOfGridFloat
PRIVATE :: GetMaxOfGridInteger
PRIVATE :: GetSumOfGridFloat
PRIVATE :: GetSumOfGridInteger
PRIVATE :: CountCellsFloat
PRIVATE :: CountCellsInteger
PRIVATE :: MinMaxNormalizationFloat
PRIVATE :: GetBiasFloat
PRIVATE :: GetRMSEfloat
PRIVATE :: GetR2float
!=======
CONTAINS
!=======
! Define procedures contained in this module.
!==============================================================================
!| Description:
! compute mean of grid_real eventually constrained to a mask
FUNCTION GetMeanOfGridFloat &
!
(grid, maskReal, maskInteger) &
!
RESULT (mean)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: mean
REAL (KIND = float) :: countCells
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
mean = 0.
countCells = 0.
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
IF (grid % mat (i,j) /= grid % nodata) THEN
CALL Catch ('warning', 'GridStatistics', &
'calculate mean: ', argument = &
'found nodata within mask' )
mean = mean + grid % mat (i,j)
countCells = countCells + 1.
END IF
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
IF (grid % mat (i,j) /= grid % nodata) THEN
CALL Catch ('warning', 'GridStatistics', &
'calculate mean: ', argument = &
'found nodata within mask' )
mean = mean + grid % mat (i,j)
countCells = countCells + 1
END IF
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
mean = mean + grid % mat (i,j)
countCells = countCells + 1.
END IF
END DO
END DO
END IF
mean = mean / countCells
RETURN
END FUNCTION GetMeanOfGridFloat
!==============================================================================
!| Description:
! compute mean of grid_integer eventually constrained to a mask
FUNCTION GetMeanOfGridInteger &
!
(grid, maskReal, maskInteger) &
!
RESULT (mean)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_integer), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: mean
REAL (KIND = float) :: countCells
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
mean = 0.
countCells = 0.
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
mean = mean + grid % mat (i,j)
countCells = countCells + 1.
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
mean = mean + grid % mat (i,j)
countCells = countCells + 1.
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
mean = mean + grid % mat (i,j)
countCells = countCells + 1.
END IF
END DO
END DO
END IF
mean = mean / countCells
RETURN
END FUNCTION GetMeanOfGridInteger
!==============================================================================
!| Description:
! compute unbiased standard deviation of grid_real optionally
! constrained to a mask
FUNCTION GetStDevOfGridFloat &
!
(grid, maskReal, maskInteger) &
!
RESULT (stDev)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: mean
REAL (KIND = float) :: stDev
REAL (KIND = float) :: countCells
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
stDev = 0.
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate standard deviation: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean
mean = GetMean (grid, maskReal = maskReal)
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
stDev = stDev + ( grid % mat (i,j) - mean) **2.
countCells = countCells + 1.
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate standard deviation: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean
mean = GetMean (grid, maskInteger = maskInteger)
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
stDev = stDev + ( grid % mat (i,j) - mean) **2.
countCells = countCells + 1.
END IF
END DO
END DO
ELSE
!get mean
mean = GetMean (grid)
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
stDev = stDev + ( grid % mat (i,j) - mean) **2.
countCells = countCells + 1.
END IF
END DO
END DO
END IF
stDev = (stDev / (countCells - 1.)) ** 0.5
RETURN
END FUNCTION GetStDevOfGridFloat
!==============================================================================
!| Description:
! compute unbiased standard deviation of grid_integer optionally
! constrained to a mask
FUNCTION GetStDevOfGridInteger &
!
(grid, maskReal, maskInteger) &
!
RESULT (stDev)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_integer), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: mean
REAL (KIND = float) :: stDev
REAL (KIND = float) :: countCells
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
stDev = 0.
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate standard deviation: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean
mean = GetMean (grid, maskReal = maskReal)
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
stDev = stDev + ( grid % mat (i,j) - mean) **2.
countCells = countCells + 1.
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate standard deviation: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean
mean = GetMean (grid, maskInteger = maskInteger)
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
stDev = stDev + ( grid % mat (i,j) - mean) **2.
countCells = countCells + 1.
END IF
END DO
END DO
ELSE
!get mean
mean = GetMean (grid)
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
stDev = stDev + ( grid % mat (i,j) - mean) **2.
countCells = countCells + 1.
END IF
END DO
END DO
END IF
stDev = (stDev / (countCells - 1.)) ** 0.5
RETURN
END FUNCTION GetStDevOfGridInteger
!==============================================================================
!| Description:
! compute coefficient of variation of grid_real eventually constrained to a mask
FUNCTION GetCVofGridFloat &
!
(grid, maskReal, maskInteger) &
!
RESULT (cv)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: cv
REAL (KIND = float) :: mean
REAL (KIND = float) :: std
!---------------------------end of declarations--------------------------------
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate coefficient of variation: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
mean = GetMean (grid, maskReal = maskReal)
std = GetStDev (grid, maskReal = maskReal)
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate coefficient of variation: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
mean = GetMean (grid, maskInteger = maskInteger)
std = GetStDev (grid, maskInteger = maskInteger)
ELSE
mean = GetMean (grid)
std = GetStDev (grid)
END IF
cv = std / mean
RETURN
END FUNCTION GetCVofGridFloat
!==============================================================================
!| Description:
! compute minimum of grid_real eventually constrained to a mask
FUNCTION GetMinOfGridFloat &
!
(grid, maskReal, maskInteger) &
!
RESULT (min)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: min
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
min = HUGE (min)
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate min: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
IF (grid % mat(i,j) < min) THEN
min = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate min: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
IF (grid % mat(i,j) < min) THEN
min = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
IF (grid % mat(i,j) < min) THEN
min = grid % mat(i,j)
END IF
END IF
END DO
END DO
END IF
RETURN
END FUNCTION GetMinOfGridFloat
!==============================================================================
!| Description:
! compute minimum of grid_integer eventually constrained to a mask
FUNCTION GetMinOfGridInteger &
!
(grid, maskReal, maskInteger) &
!
RESULT (min)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_integer), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
INTEGER (KIND = long) :: min
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
min = HUGE (min)
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate min: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
IF (grid % mat(i,j) < min) THEN
min = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate min: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
IF (grid % mat(i,j) < min) THEN
min = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
IF (grid % mat(i,j) < min) THEN
min = grid % mat(i,j)
END IF
END IF
END DO
END DO
END IF
RETURN
END FUNCTION GetMinOfGridInteger
!==============================================================================
!| Description:
! compute maximum of grid_real eventually constrained to a mask
FUNCTION GetMaxOfGridFloat &
!
(grid, maskReal, maskInteger) &
!
RESULT (max)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: max
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
max = - HUGE (max)
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate max: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
IF (grid % mat(i,j) > max) THEN
max = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate max: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
IF (grid % mat(i,j) > max) THEN
max = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
IF (grid % mat(i,j) > max) THEN
max = grid % mat(i,j)
END IF
END IF
END DO
END DO
END IF
RETURN
END FUNCTION GetMaxOfGridFloat
!==============================================================================
!| Description:
! compute maximum of grid_integer eventually constrained to a mask
FUNCTION GetMaxOfGridInteger &
!
(grid, maskReal, maskInteger) &
!
RESULT (max)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_integer), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
INTEGER (KIND = long) :: max
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
max = - HUGE (max)
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate max: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
IF (grid % mat(i,j) > max) THEN
max = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate max: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
IF (grid % mat(i,j) > max) THEN
max = grid % mat(i,j)
END IF
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
IF (grid % mat(i,j) > max) THEN
max = grid % mat(i,j)
END IF
END IF
END DO
END DO
END IF
RETURN
END FUNCTION GetMaxOfGridInteger
!==============================================================================
!| Description:
! compute Root Mean Square Error between two grids real
! optional argument:
! `mask`: compute RMSE only on assigned mask
! `nrmse`: compute Normalizes Root Mean Square Error
FUNCTION GetRMSEfloat &
!
(grid1, grid2, maskReal, maskInteger, nrmse) &
!
RESULT (rmse)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid1
TYPE (grid_real), INTENT(IN) :: grid2
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
LOGICAL, OPTIONAL, INTENT(IN) :: nrmse
!Local declarations:
INTEGER (KIND = long) :: i, j
REAL (KIND = float) :: rmse, mean
INTEGER :: countCells
!---------------------------end of declarations--------------------------------
rmse = 0.
countCells = 0
!check grid1 and grid2 have the same coordinate reference system
IF ( .NOT. CRSisEqual(grid1,grid2) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate RMSE: ', argument = &
'coordinate reference system of grid1 differs from grid2' )
END IF
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate RMSE: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean
!mean = GetMean (grid, maskReal = maskReal)
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
rmse = rmse + ( grid1 % mat (i,j) - grid2 % mat (i,j)) **2.
countCells = countCells + 1.
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate RMSE: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
rmse = rmse + ( grid1 % mat (i,j) - grid2 % mat (i,j)) **2.
countCells = countCells + 1.
END IF
END DO
END DO
ELSE
DO j = 1, grid1 % jdim
DO i = 1, grid1 % idim
IF (grid1 % mat(i,j) /= grid1 % nodata) THEN
rmse = rmse + ( grid1 % mat (i,j) - grid2 % mat (i,j)) **2.
countCells = countCells + 1.
END IF
END DO
END DO
END IF
rmse = ( rmse / countCells ) ** 0.5
IF (PRESENT(nrmse)) THEN
IF (nrmse) THEN
mean = GetMean (grid1)
rmse = rmse / mean
END IF
END IF
RETURN
END FUNCTION GetRMSEfloat
!==============================================================================
!| Description:
! compute Nash and Sutcliffe efficiency index, equivalent to
! coefficient of determination.
! optional argument:
! `mask`: compute RMSE only on assigned mask
! `nrmse`: compute normalized Nash efficiency
! ***
! References:
! Nash, J. E. and J. V. Sutcliffe (1970), River flow forecasting through
! conceptual models part I — A discussion of principles, Journal of Hydrology,
! 10 (3), 282–290.
! Moriasi, D. N.; Arnold, J. G.; Van Liew, M. W.; Bingner,R. L.; Harmel, R. D.;
! Veith, T. L. (2007), "Model Evaluation Guidelines for Systematic Quantification
! of Accuracy in Watershed Simulations", Transactions of the ASABE, 50 (3), 885–900.
! http://swat.tamu.edu/media/1312/moriasimodeleval.pdf
! Nossent, J., Bauwens, W., Application of a normalized Nash-Sutcliffe efficiency
! to improve the accuracy of the Sobol’ sensitivity analysis of a hydrological model
! Geophysical Research Abstracts Vol. 14, EGU2012-237, 2012 EGU General Assembly 2012
FUNCTION GetNSEfloat &
!
(grid1, grid2, maskReal, maskInteger, normalized) &
!
RESULT (nash)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid1 !modeled
TYPE (grid_real), INTENT(IN) :: grid2 !observation
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
LOGICAL, OPTIONAL, INTENT(IN) :: normalized
!Local declarations:
INTEGER (KIND = long) :: i, j
REAL (KIND = float) :: nash, meanobs, nashnum, nashden
!---------------------------end of declarations--------------------------------
nash = 0.
nashnum = 0.
nashden = 0.
!check grid1 and grid2 have the same coordinate reference system
IF ( .NOT. CRSisEqual(grid1,grid2) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate NSE: ', argument = &
'coordinate reference system of grid1 differs from grid2' )
END IF
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate NSE: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean of observations
meanobs = GetMean (grid2, maskReal = maskReal)
!compute numerator and denominator
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
nashnum = nash + ( grid1 % mat (i,j) - grid2 % mat (i,j) ) **2.
nashden = nashden + ( grid2 % mat (i,j) - meanobs ) **2.
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate RMSE: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean of observations
meanobs = GetMean (grid2, maskReal = maskReal)
!compute numerator and denominator
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
nashnum = nashnum + ( grid1 % mat (i,j) - grid2 % mat (i,j) ) **2.
nashden = nashden + ( grid2 % mat (i,j) - meanobs ) **2.
END IF
END DO
END DO
ELSE
!get mean of observations
meanobs = GetMean (grid2, maskReal = maskReal)
!compute numerator and denominator
DO j = 1, grid1 % jdim
DO i = 1, grid1 % idim
IF (grid1 % mat(i,j) /= grid1 % nodata) THEN
nashnum = nashnum + ( grid1 % mat (i,j) - grid2 % mat (i,j) ) **2.
nashden = nashden + ( grid2 % mat (i,j) - meanobs ) **2.
END IF
END DO
END DO
END IF
IF (nashden /= 0.) THEN
nash = 1. - nashnum / nashden
ELSE
nash = -9999.9
END IF
IF (PRESENT(normalized)) THEN
IF (normalized) THEN
IF (nash == -9999.9) THEN
nash = -9999.9
ELSE
nash = 1. / (2. - nash)
END IF
END IF
END IF
RETURN
END FUNCTION GetNSEfloat
!==============================================================================
!| Description:
! compute R2, square of the Pearson correlation coefficient
! optional argument:
! `mask`: compute RMSE only on assigned mask
! ***
! References:
! Karl Pearson (20 June 1895) "Notes on regression and inheritance in
! the case of two parents," Proceedings of the Royal Society of
! London, 58 : 240–242
FUNCTION GetR2float &
!
(grid1, grid2, maskReal, maskInteger) &
!
RESULT (r2)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid1
TYPE (grid_real), INTENT(IN) :: grid2
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
INTEGER (KIND = long) :: i, j
REAL (KIND = float) :: r2, mean1, mean2, num, den1, den2, den
!---------------------------end of declarations--------------------------------
num = 0.
den = 0.
den1 = 0.
den2 = 0.
!check grid1 and grid2 have the same coordinate reference system
IF ( .NOT. CRSisEqual(grid1,grid2) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate R2: ', argument = &
'coordinate reference system of grid1 differs from grid2' )
END IF
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate R2: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean of grid1 and grid2
mean1 = GetMean (grid1, maskReal = maskReal)
mean2 = GetMean (grid2, maskReal = maskReal)
!compute numerator and denominator
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
num = num + ( grid1 % mat (i,j) - mean1 ) * &
( grid2 % mat (i,j) - mean2 )
den1 = den1 + ( grid1 % mat (i,j) - mean1 ) ** 2.
den2 = den2 + ( grid2 % mat (i,j) - mean2 ) ** 2.
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate R2: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
!get mean of grid1 and grid2
mean1 = GetMean (grid1, maskReal = maskReal)
mean2 = GetMean (grid2, maskReal = maskReal)
!compute numerator and denominator
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
num = num + ( grid1 % mat (i,j) - mean1 ) * &
( grid2 % mat (i,j) - mean2 )
den1 = den1 + ( grid1 % mat (i,j) - mean1 ) ** 2.
den2 = den2 + ( grid2 % mat (i,j) - mean2 ) ** 2.
END IF
END DO
END DO
ELSE !compute over entire grid
!get mean of grid1 and grid2
mean1 = GetMean (grid1, maskReal = maskReal)
mean2 = GetMean (grid2, maskReal = maskReal)
!compute numerator and denominator
DO j = 1, grid1 % jdim
DO i = 1, grid1 % idim
IF (grid1 % mat(i,j) /= grid1 % nodata) THEN
num = num + ( grid1 % mat (i,j) - mean1 ) * &
( grid2 % mat (i,j) - mean2 )
den1 = den1 + ( grid1 % mat (i,j) - mean1 ) ** 2.
den2 = den2 + ( grid2 % mat (i,j) - mean2 ) ** 2.
END IF
END DO
END DO
END IF
den = (den1 * den2) ** 0.5
IF (den /= 0.) THEN
r2 = ( num / den ) ** 2.
ELSE
r2 = -9999.9
END IF
RETURN
END FUNCTION GetR2float
!==============================================================================
!| Description:
! compute mean Bias between two grids real
! optional argument:
! `mask`: compute Bias only on assigned mask
! `rbias`: compute relative Bias
FUNCTION GetBiasFloat &
!
(grid1, grid2, maskReal, maskInteger, rbias) &
!
RESULT (bias)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid1
TYPE (grid_real), INTENT(IN) :: grid2
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
LOGICAL, OPTIONAL, INTENT(IN) :: rbias
!Local declarations:
INTEGER (KIND = long) :: i, j
REAL (KIND = float) :: bias, mean
INTEGER :: countCells
!---------------------------end of declarations--------------------------------
bias = 0.
mean = 0.
countCells = 0
!check grid1 and grid2 have the same coordinate reference system
IF ( .NOT. CRSisEqual(grid1,grid2) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate Bias: ', argument = &
'coordinate reference system of grid1 differs from grid2' )
END IF
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate Bias: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
bias = bias + ( grid1 % mat (i,j) - grid2 % mat (i,j))
countCells = countCells + 1.
mean = mean + grid2 % mat (i,j)
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid1) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate RMSE: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
bias = bias + ( grid1 % mat (i,j) - grid2 % mat (i,j))
countCells = countCells + 1.
mean = mean + grid2 % mat (i,j)
END IF
END DO
END DO
ELSE
DO j = 1, grid1 % jdim
DO i = 1, grid1 % idim
IF (grid1 % mat(i,j) /= grid1 % nodata) THEN
bias = bias + ( grid1 % mat (i,j) - grid2 % mat (i,j))
countCells = countCells + 1.
mean = mean + grid2 % mat (i,j)
END IF
END DO
END DO
END IF
bias = bias / countCells
IF (PRESENT(rbias)) THEN
IF (rbias) THEN
mean = mean / countCells
bias = bias / mean
END IF
END IF
RETURN
END FUNCTION GetBiasFloat
!==============================================================================
!| Description:
! compute sum of grid_real eventually constrained to a mask
FUNCTION GetSumOfGridFloat &
!
(grid, maskReal, maskInteger) &
!
RESULT (sum)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
REAL (KIND = float) :: sum
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
sum = 0.
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
sum = sum + grid % mat (i,j)
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate sum: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata .AND. &
grid % mat(i,j) /= grid % nodata ) THEN
sum = sum + grid % mat (i,j)
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
sum = sum + grid % mat (i,j)
END IF
END DO
END DO
END IF
RETURN
END FUNCTION GetSumOfGridFloat
!==============================================================================
!| Description:
! compute sum of grid_integer eventually constrained to a mask
FUNCTION GetSumOfGridInteger &
!
(grid, maskReal, maskInteger) &
!
RESULT (sum)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_integer), INTENT(IN) :: grid
TYPE (grid_real), OPTIONAL, INTENT(IN) :: maskReal
TYPE (grid_integer), OPTIONAL, INTENT(IN) :: maskInteger
!Local declarations:
INTEGER (KIND = long) :: sum
INTEGER (KIND = long) :: i, j
!---------------------------end of declarations--------------------------------
sum = 0.
!check that grid and mask have the same coordinate reference system
IF (PRESENT (maskReal)) THEN
IF ( .NOT. CRSisEqual(maskReal,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskReal % jdim
DO i = 1, maskReal % idim
IF (maskReal % mat(i,j) /= maskReal % nodata) THEN
sum = sum + grid % mat (i,j)
END IF
END DO
END DO
ELSE IF (PRESENT (maskInteger)) THEN
IF ( .NOT. CRSisEqual(maskInteger,grid) ) THEN
CALL Catch ('error', 'GridStatistics', &
'calculate mean: ', argument = &
'coordinate reference system of mask differs from input grid' )
END IF
DO j = 1, maskInteger % jdim
DO i = 1, maskInteger % idim
IF (maskInteger % mat(i,j) /= maskInteger % nodata) THEN
sum = sum + grid % mat (i,j)
END IF
END DO
END DO
ELSE
DO j = 1, grid % jdim
DO i = 1, grid % idim
IF (grid % mat(i,j) /= grid % nodata) THEN
sum = sum + grid % mat (i,j)
END IF
END DO
END DO
END IF
RETURN
END FUNCTION GetSumOfGridInteger
!==============================================================================
!| Description:
! count number of cells different from nodata
FUNCTION CountCellsFloat &
!
(grid) &
!
RESULT (count)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: grid
!Local declaration
INTEGER (KIND = short) :: count
INTEGER (KIND = short) :: i, j
!---------------------end of declarations--------------------------------------
count = 0
DO i = 1, grid % idim
DO j = 1, grid % jdim
IF (grid % mat(i,j) /= grid % nodata) THEN
count = count + 1
END IF
END DO
END DO
RETURN
END FUNCTION CountCellsFloat
!==============================================================================
!| Description:
! count number of cells different from nodata
FUNCTION CountCellsInteger &
!
(grid) &
!
RESULT (count)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_integer), INTENT(IN) :: grid
!Local declaration
INTEGER (KIND = short) :: count
INTEGER (KIND = short) :: i, j
!---------------------end of declarations--------------------------------------
count = 0
DO i = 1, grid % idim
DO j = 1, grid % jdim
IF (grid % mat(i,j) /= grid % nodata) THEN
count = count + 1
END IF
END DO
END DO
RETURN
END FUNCTION CountCellsInteger
!==============================================================================
!| Description:
! performs a linear transformation on the original data values.
! Suppose that `minX` and `maxX` are the minimum and maximum of feature X.
! We would like to map interval `[minX, maxX]` into a new interval
! `[new_minX, new_maxX]`. Consequently, every value `v` from the original
! interval will be mapped into value `new_v` following formula:
!
! ` new_v = (v - minX) / (maxX - minX) * (new_maxX - new_minX) + new_minX`
!
! If `new_minX` and `new_maxX` are not given values are mapped
! to `[0,1]` interval
! ***
! References:
! Hann, J., Kamber, M. (2000). Data Mining: Concepts and Techniques.
! Morgan Kaufman Publishers.
SUBROUTINE MinMaxNormalizationFloat &
!
(gridIn, gridOut, min, max)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: gridIn
REAL (KIND = float), OPTIONAL, INTENT(IN) :: min
REAL (KIND = float), OPTIONAL, INTENT(IN) :: max
!Arguments with intent(inout):
TYPE (grid_real), INTENT(INOUT) :: gridOut
!Local declaration
INTEGER (KIND = short) :: i, j
REAL (KIND = float) :: old_min, old_max
REAL (KIND = float) :: new_min, new_max
!---------------------end of declarations--------------------------------------
!set new_min and new_max
IF (PRESENT(min)) THEN
new_min = min
ELSE
new_min = 0.
END IF
IF (PRESENT(max)) THEN
new_max = max
ELSE
new_max = 0.
END IF
!get min and max of gridIn
old_min = GetMin (gridIn)
old_max = GetMax (gridIn)
!normalize grid. gridout is supposed to be initialized outside the subroutine
DO i = 1, gridIn % idim
DO j = 1, gridOut % jdim
IF (gridIn % mat (i,j) /= gridIn % nodata) THEN
gridOut % mat (i,j) = (gridIn % mat (i,j) - old_min) / &
(old_max - old_min) * (new_max - new_min) + new_min
END IF
END DO
END DO
RETURN
END SUBROUTINE MinMaxNormalizationFloat
!==============================================================================
!| Description:
! also called zero-mean normalization. The values of attribute `X` are
! normalized using the mean and standard deviation of `X`. A new value
! `new_v` is obtained using the following expression:
!
! `new_v = (v - mX) / sX`
!
! where `mX` and `sX` are the mean and standard deviation of attribute `X`,
! respectively. After zero-mean normalizing each feature will have a mean
! value of 0. Also, the unit of each value will be the number of (estimated)
! standard deviations away from the (estimated) mean.
SUBROUTINE ZscoreNormalizationFloat &
!
(gridIn, gridOut)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (grid_real), INTENT(IN) :: gridIn
!Arguments with intent(inout):
TYPE (grid_real), INTENT(INOUT) :: gridOut
!Local declaration
INTEGER (KIND = short) :: i, j
REAL (KIND = float) :: mean, std
!---------------------end of declarations--------------------------------------
!get mean
mean = GetMean (gridIn)
!get standard deviation
std = getStDev (gridIn)
!normalize grid. gridout is supposed to be initialized outside the subroutine
DO i = 1, gridIn % idim
DO j = 1, gridIn % jdim
IF (gridIn % mat (i,j) /= gridIn % nodata) THEN
gridOut % mat (i,j) = (gridIn % mat (i,j) - mean) / std
END IF
END DO
END DO
RETURN
END SUBROUTINE ZscoreNormalizationFloat
!------------------------------------------------------------------------------
!| Description
! return a vector of distinct values from a grid_integer
SUBROUTINE UniqueValuesOfGridInteger &
!
(grid, values)
IMPLICIT NONE
!arguments with intent(in):
TYPE(grid_integer), INTENT (IN) :: grid
!arguments with intent (out):
INTEGER (KIND = short), INTENT (OUT), ALLOCATABLE :: values (:)
!Local declarations:
INTEGER (KIND = short), ALLOCATABLE :: vector (:)
INTEGER (KIND = short), ALLOCATABLE :: unique (:)
INTEGER (KIND = short) :: i = 0
INTEGER (KIND = short) :: count
INTEGER (KIND = short) :: min_val, max_val
!------------------------------------end of declarations-----------------------
! vectorize grid
CALL Grid2Vector (grid, vector)
!allocate temporary unique array
ALLOCATE ( unique ( SIZE(vector) ) )
!elaborate
min_val = MINVAL (vector) - 1
max_val = MAXVAL (vector)
DO WHILE (min_val min_val)
unique(i) = min_val
END DO
ALLOCATE ( values (i), source = unique(1:i) ) !<-- Or, just use unique(1:i)
!free memory
DEALLOCATE (vector)
DEALLOCATE (unique)
RETURN
END SUBROUTINE UniqueValuesOfGridInteger
END MODULE GridStatistics