!! Contains subroutines used by Meteo module
!|author: Giovanni Ravazzani
! license: GPL
!
!### History
!
! current version 1.0 - 19th October 2017
!
! | version | date | comment |
! |----------|-------------|----------|
! | 1.0 | 19/Oct/2017 | Original code |
!
!### License
! license: GNU GPL
!
!### Module Description
! Module containing subroutines used by Meteo module
!
MODULE MeteoUtilities
! Modules used:
USE DataTypeSizes, ONLY : &
! Imported Parameters:
float, short
USE Loglib, ONLY : &
!Imported routines:
Catch
USE GridLib, ONLY : &
!Imported types:
grid_real, grid_integer, &
!Imported parameters:
NET_CDF, &
!Imported routines:
NewGrid, GridDestroy
USE Chronos, ONLY : &
!Imported types:
DateTime, &
!Imported operations:
OPERATOR (+), &
ASSIGNMENT (=)
USE GridOperations, ONLY: &
!Imported routines
GridConvert, GridResample, &
GetIJ
USE ObservationalNetworks, ONLY: &
!Imported definitions:
ObservationalNetwork
USE SpatialInterpolation, ONLY: &
!imported routines:
NearestNeighbor, IDW
USE Kriging, ONLY: &
!imported routines:
Krige
IMPLICIT NONE
! Global (i.e. public) Declarations:
!Local (i.e. private) declarations
!Public routines
PUBLIC :: ReadField
PUBLIC :: ShiftMeteoWithLapse
PUBLIC :: ShiftBackWithLapse
PUBLIC :: Offset
PUBLIC :: Scale
PUBLIC :: Interpolate
!Local routines
!=======
CONTAINS
!=======
! Define procedures contained in this module.
!==============================================================================
!| Description:
! read a time varying field from a netcdf file
SUBROUTINE ReadField &
!
(filename, time, dtAggr, dtGrid, aggrType, field, varName, &
stdName, cellsize, dem, demHiRes, lapse )
USE StringManipulation, ONLY : &
! Imported routines:
StringCompact
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT (IN) :: filename !!name of netcdf file
TYPE (DateTime), INTENT (IN) :: time !!time of the variable to read
INTEGER, INTENT (IN) :: dtAggr !!aggregation time interval
INTEGER, INTENT (IN) :: dtGrid !!time interval of grid in netcdf file
CHARACTER (LEN = *), INTENT (IN) :: aggrType !!aggregation type. 'M' = mean, 'C' = cumulated, 'X' = maximum, 'N' = minimum
CHARACTER (LEN = *), OPTIONAL, INTENT (IN) :: varName !!name of the variable to read
CHARACTER (LEN = *), OPTIONAL, INTENT (IN) :: stdName !!name of the variable to read
REAL, OPTIONAL, INTENT (IN) :: cellsize
TYPE (grid_real), OPTIONAL, INTENT (IN) :: dem
TYPE (grid_real), OPTIONAL, INTENT (IN) :: demHiRes
TYPE (grid_real), OPTIONAL, INTENT (IN) :: lapse
!Arguments with intent (out):
TYPE (grid_real), INTENT (INOUT) :: field
!Local declarations:
TYPE (grid_real) :: gridTemp !!temporary grid
TYPE (grid_real) :: gridtemp2 !!temporary grid
TYPE (grid_real) :: gridTemp3 !!temporary grid
INTEGER :: nGrid !! number of grid to be read in netcdf file
TYPE (DateTime) :: gridTime
INTEGER :: i,j,k
CHARACTER (LEN = 100) :: variableName
CHARACTER (LEN = 100) :: standardName
REAL :: size
!------------end of declaration------------------------------------------------
variableName = ''
standardName = ''
IF (PRESENT (cellsize)) THEN
size = cellsize
ELSE
size = 0.
END IF
!read grid in netcdf file
IF (PRESENT(stdName)) THEN
CALL NewGrid (GridTemp, filename, NET_CDF, stdName=stdName, time = time)
standardName = stdName
ELSE IF (PRESENT(varName)) THEN
CALL NewGrid (GridTemp, filename, NET_CDF, variable=varName, time = time)
variableName = varName
ELSE !read info in field
IF (TRIM(StringCompact(field % standard_name)) /= '') THEN
CALL NewGrid (GridTemp, filename, NET_CDF, stdName=field % standard_name, time = time)
standardName = field % standard_name
ELSE IF (TRIM(StringCompact(field % var_name)) /= '') THEN
CALL NewGrid (GridTemp, filename, NET_CDF, variable=field % var_name, time = time)
variableName = field % var_name
ELSE
CALL Catch ('error', 'MeteoUtilities', &
'missing standard or variable name in grid while calling ReadField' )
END IF
END IF
!compute number of grid to be read in netcdf file
nGrid = INT (dtAggr / dtGrid)
gridTime = time
!read other grids in netcdf file
DO k = 1, nGrid - 1
gridTime = gridTime + dtGrid
IF (PRESENT(stdName)) THEN
CALL NewGrid (gridTemp3, filename, NET_CDF, stdName=stdName, time = gridTime)
ELSE IF (PRESENT(varName)) THEN
CALL NewGrid (gridTemp3, filename, NET_CDF, variable=varName, time = gridTime)
ELSE !read info in field
IF (TRIM(StringCompact(field % standard_name)) /= '') THEN
CALL NewGrid (gridTemp3, filename, NET_CDF, stdName=field % standard_name, time = gridTime)
ELSE IF (TRIM(StringCompact(field % var_name)) /= '') THEN
CALL NewGrid (gridTemp3, filename, NET_CDF, variable=field % var_name, time = gridTime)
ELSE
CALL Catch ('error', 'MeteoUtilities', &
'missing standard or variable name in grid while calling ReadField' )
END IF
END IF
DO i = 1, gridTemp % idim
DO j = 1, gridTemp % jdim
IF (gridTemp % mat (i,j) /= gridTemp % nodata ) THEN
SELECT CASE (aggrType)
CASE ('M','C') !mean or cumulated
gridTemp % mat(i,j) = gridTemp % mat(i,j) + gridTemp3 % mat(i,j)
CASE ('N') !minimum
gridTemp % mat (i,j) = MIN (gridTemp % mat (i,j), gridTemp3 % mat(i,j))
CASE ('X') !maximum
gridTemp % mat (i,j) = MAX (gridTemp % mat (i,j), gridTemp3 % mat(i,j))
END SELECT
END IF
END DO
END DO
CALL GridDestroy (gridTemp3)
END DO
SELECT CASE (aggrType)
CASE ('M') !mean
DO i = 1, gridTemp % idim
DO j = 1, gridTemp % jdim
IF (gridTemp % mat (i,j) /= gridTemp % nodata ) THEN
gridTemp % mat (i,j) = gridTemp % mat (i,j) / REAL (nGrid)
END IF
END DO
END DO
END SELECT
!update attribute
field % next_time = gridTemp % next_time
field % reference_time = gridTemp % reference_time
field % current_time = gridTemp % current_time
field % time_index = gridTemp % time_index
field % time_unit = gridTemp % time_unit
field % var_name = gridTemp % var_name
field % standard_name = gridTemp % standard_name
field % file_name = gridTemp % file_name
!coordinate conversion
IF ( .NOT. gridTemp % grid_mapping == field % grid_mapping) THEN
!set Coordinate reference system of temporary grid
gridTemp2 % grid_mapping = field % grid_mapping
!convert coordinate
IF (size > 0.) THEN
CALL GridConvert (gridTemp, gridTemp2, cellsize = size)
ELSE
CALL GridConvert (gridTemp, gridTemp2)
END IF
!apply lapse rate
IF (PRESENT (dem) .AND. PRESENT (demHiRes) .AND. PRESENT (lapse) ) THEN
DO i = 1, gridTemp2 % idim
DO j = 1, gridTemp2 % jdim
IF (gridTemp2 % mat(i,j) /= gridTemp2 % nodata) THEN
gridTemp2 % mat (i,j) = gridTemp2 % mat (i,j) + &
( demHiRes % mat(i,j) - dem % mat (i,j) ) * &
lapse % mat(i,j)
END IF
END DO
END DO
END IF
!resample grid
CALL GridResample (gridTemp2, field)
CALL GridDestroy (gridTemp)
CALL GridDestroy (gridTemp2)
ELSE
!resample grid
CALL GridResample (gridTemp, field)
CALL GridDestroy (gridTemp)
END IF
RETURN
END SUBROUTINE ReadField
!==============================================================================
!| Description:
! apply offset to a grid_real
SUBROUTINE Offset &
!
(grid, off)
IMPLICIT NONE
!Arguments with intent(in):
REAL (KIND = float), INTENT(IN) :: off
!Arguments with intent(inout):
TYPE(grid_real), INTENT(INOUT) :: grid
!Local declarations
INTEGER :: i,j
!------------end of declaration------------------------------------------------
DO i = 1, grid % idim
DO j = 1, grid % jdim
IF (grid % mat (i,j) /= grid % nodata) THEN
grid % mat (i,j) = grid % mat (i,j) + off
END IF
END DO
END DO
END SUBROUTINE Offset
!==============================================================================
!| Description:
! apply scale factor to a grid_real
SUBROUTINE Scale &
!
(grid, sc)
IMPLICIT NONE
!Arguments with intent(in):
REAL (KIND = float), INTENT(IN) :: sc
!Arguments with intent(inout):
TYPE(grid_real), INTENT(INOUT) :: grid
!Local declarations
INTEGER :: i,j
!------------end of declaration------------------------------------------------
DO i = 1, grid % idim
DO j = 1, grid % jdim
IF (grid % mat (i,j) /= grid % nodata) THEN
grid % mat (i,j) = grid % mat (i,j) * sc
END IF
END DO
END DO
END SUBROUTINE Scale
!==============================================================================
!| Description:
! shift meteo observations to reference elevation applying lapse rate
SUBROUTINE ShiftMeteoWithLapse &
!
(input, lapse, refelev, output, dt)
IMPLICIT NONE
!Arguments with intent(in):
TYPE (ObservationalNetwork), INTENT(IN) :: input !!actual station network
TYPE (grid_real), INTENT(IN) :: lapse !! lapse rate grid
REAL (KIND = float), INTENT(IN) :: refelev !!reference elevation
INTEGER, OPTIONAL, INTENT(IN) :: dt !! used when lapse rate is a flux
!Arguments with intent(inout):
TYPE (ObservationalNetwork), INTENT(INOUT) :: output !!station network at reference elevation
!local eclarations:
INTEGER :: i, j, r, c
REAL (KIND = float) :: x, y
LOGICAL :: check
REAL (KIND = float) :: deltat
!------------end of declaration------------------------------------------------
IF (PRESENT (dt)) THEN
deltat = dt
ELSE
deltat = 1.
END IF
!dato al livello di riferimento
DO i = 1, input % countObs
IF (input % obs(i) % value == input % nodata) THEN
output % obs(i) % value = output % nodata
ELSE
x = input % obs(i) % xyz % easting
y = input % obs(i) % xyz % northing
CALL GetIJ (x, y, lapse, r, c, check)
IF (check) THEN ! lapse rate is defined at location x,y
IF (lapse % mat (r,c) /= lapse % nodata) THEN
output % obs(i) % value = input % obs(i) % value + &
(refelev - input % obs(i) % xyz % elevation) * &
lapse % mat(r,c) * deltat
ELSE
output % obs(i) % value = input % obs(i) % value
END IF
ELSE
output % obs(i) % value = input % obs(i) % value
END IF
END IF
END DO
RETURN
END SUBROUTINE ShiftMeteoWithLapse
!==============================================================================
!| Description:
! interpolate site data to space
SUBROUTINE Interpolate &
!
(network, method, near, idw_power, anisotropy, varmodel, lags, maxlag, grid, devst)
IMPLICIT NONE
!arguments with intent in:
TYPE (ObservationalNetwork), INTENT(IN) :: network
INTEGER (KIND = short), INTENT(IN) :: method
INTEGER (KIND = short), INTENT(IN) :: near
REAL (KIND = float), INTENT(IN) :: idw_power
INTEGER (KIND = short), INTENT(IN) :: anisotropy
INTEGER (KIND = short), INTENT(IN) :: varmodel
INTEGER (KIND = short), INTENT(IN) :: lags
REAL (KIND = float), INTENT(IN) :: maxlag
!arguments with intent inout:
TYPE (grid_real), INTENT(INOUT) :: grid
TYPE (grid_real), INTENT(INOUT) :: devst
!------------end of declaration------------------------------------------------
SELECT CASE (method)
CASE (1) !thiessen
CALL NearestNeighbor (network = network, &
grid = grid )
CASE (2) !IDW
CALL IDW (network = network, &
grid = grid, &
method = 1, &
power = idw_power, &
near = near)
CASE (3) !Kriging
CALL Krige (sitedata = network, &
anisotropy = anisotropy, &
nlags = lags, &
maxlag = maxlag, &
neighbors = near, &
varModel = varmodel, &
grid = grid, &
gridvar = devst )
END SELECT
RETURN
END SUBROUTINE Interpolate
!==============================================================================
!| Description:
! Shift back interpolated field to terrain surface
SUBROUTINE ShiftBackWithLapse &
!
(grid, dem, lapse, refelev, dt)
IMPLICIT NONE
!arguments with intent in:
TYPE (grid_real), INTENT(IN) :: dem
TYPE (grid_real), INTENT(IN) :: lapse
REAL (KIND = float), INTENT(IN) :: refelev !!ereference elevation
INTEGER (KIND = short), OPTIONAL, INTENT(IN) :: dt
!arguments with intent inout:
TYPE (grid_real), INTENT(INOUT) :: grid
!local declarations:
INTEGER (KIND = short) :: i,j
INTEGER (KIND = short) :: deltat
!------------end of declaration------------------------------------------------
IF (PRESENT (dt)) THEN
deltat = dt
ELSE
deltat = 1.
END IF
DO i = 1, grid % idim
DO j = 1, grid % jdim
IF (grid % mat(i,j) == grid % nodata) CYCLE
grid % mat(i,j) = grid % mat(i,j) - &
(refelev - dem % mat(i,j)) * &
lapse % mat(i,j) * deltat
END DO
END DO
RETURN
END SUBROUTINE ShiftBackWithLapse
END MODULE MeteoUtilities