!! Compute average value of grid data over a given area
!|author: Giovanni Ravazzani
! license: GPL
!
!### History
!
! current version 1.4 - 3rd February 2023
!
! | version | date | comment |
! |----------|-------------|----------|
! | 1.0 | 02/Dec/2016 | Original code |
! | 1.1 | 16/May/2019 | added interception and plants dynamic variables |
! | 1.2 | 16/Jun/2021 | rewritten to manage new meteo configuration |
! | 1.3 | 18/Jan/2023 | module renamed from ArealAverage to SpatialAverage |
! | 1.4 | 03/Feb/2023 | modified to not open file if dtoutspatial = 0 |
!
!### License
! license: GNU GPL
!
!### Module Description
! routines to compute average value of grid data over a given area
! For every spatial extent, the average is computed and exported
! on file of the variables chosen by user in the configuration file.
! The configuration file includes specific sections
! for **_Meteorological input_**,
! **_Soil balance_**, **_Snow_**, **_Glacier_**,
! **_Canopy interception_**, **_Plants_**, and
! **_Sediment_** erosion and transport variables,
! as in the examples below.
!```
! epsg = 32632
!
! Table Start
! Title: mask grids for output
! Id: masks
! Columns: [count] [id] [name] [file]
! Units: [-] [-] [-] [-]
! 1 01 lago "./bacino_lago.asc"
! 2 02 gavardo "./gavardo.asc"
! 3 03 mezzane "./bacino_mezzane.asc"
! 4 04 asola "./bacino_asola.asc"
! Table End
!
! [meteo]
! precipitation = 1 # gross precipitation (mm)
! daily-precipitation = 0 # daily precipitation(mm)
! temperature = 1 # air temperature(°C)
! temperature-daily-mean = 1 # mean daily temperature (°C)
! temperature-daily-max = 1 # maximum daily temperature (°C)
! temperature-daily-min = 1 # minimum daily temperature (°C)
! relative-humidity = 0 # air relative humidity (% [0-1])
! solar-radiation = 0 # shortwave radiation (w/m2)
! net-radiation = 0 # net radiation (w/m2)
! wind-speed = 0 # wind speed (m/s)
! irrigation = 0 # irrigation amount (mm)
!
! [soil-balance]
! soil-moisture = 1 # soil moisture(m3/m3)
! runoff = 1 # runoff(mm)
! infiltration = 1 # infiltration(mm)
! percolation = 1 # percolation(mm)
! actual-ET = 1 # actual evapotranspiration(mm)
! potential-ET = 1 # potential evapotranspiration(mm)
! capillary-rise = 0 # capillary flux(mm)
! error = 1 # balance error (mm)
!
! [snow]
! rain = 1 # liquid precipitation(mm)
! snow-water-equivalent = 1 # snow water equivalent(mm)
! melt-coefficient = 1 # snow melt coefficient (mm/day/°C)
! snow-covered-area = 1 # percentage of snow cover (0-1)
! water-in-snow = 1 # water in snowpack (mm)
! snow-melt = 1 # snow melt (mm)
!
! [glacier]
! ice-water-equivalent = 1 # snow water equivalent(mm)
! ice-covered-area = 1 # percentage of glacial cover (0-1)
! water-in-ice = 1 # water in glaciers (mm)
! ice-melt = 1 # ice melt (mm)
!
! [sediment]
! detachment-rate = 0 # eroded sediment amount (kg)
!
! [canopy]
! canopy-storage = 0 # canopy water storage (mm)
! throughfall = 0 # canopy throughfall (mm)
! transpiration = 0 # canopy transpiration (mm)
!
! [plants]
! lai = 0 # leaf area index (m2/m2)
! gpp = 0 # gross primary production (t)
! npp = 0 # net primary production (t)
! stem = 0 # stem mass (t)
! root = 0 # root mass (t)
! leaf = 0 # leaf mass (t)
! cover = 0 # canopy cover (0-1)
! dbh = 0 # plant diameter at brest height (cm)
! height = 0 # plant heigth (m)
! density = 0 # plant density (tree/hectare)
! stem-yield = 0 # stem yield (t)
!```
!
! The value is computed for all variables marked with 1.
! When one variable is marked by 1 but it is not allocated
! because not computed by the FEST model according to options
! defined in the configuration files, value is not exported.
! For example, if user set to export wind speed in the
! meteorological section but wind speed is not used in
! the current simulation, values of wind speed are
! not written in the output file.
! The name of output files is the concatenation of result
! folder name defined in the main configuration file ,
! the name of the spatial extent , and a suffix recalling
! the process related to the variables, as listed in the following table.
!
! | variables | Output file name |
! |----------------|-------------------------------------|
! | meteorological | `` `` `_meteo.out` |
! | soil balance | `` `` `_balance.out` |
! | snow | `` `` `_snow.out` |
! | glaciers | `` `` `_glaciers.out` |
! | sediment | `` `` `_sediment.out` |
! | canopy | `` `` `_canopy.out` |
! | plants | `` `` `_plants.out` |
!
MODULE SpatialAverage
! Modules used:
USE DataTypeSizes, ONLY : &
! Imported Parameters:
float, short
USE GridLib, ONLY : &
!imported definitions:
grid_integer, grid_real, &
!Imported routines:
NewGrid, ExportGrid,&
!Imported parameters:
ESRI_ASCII
USE GridStatistics, ONLY : &
!imported routines:
GetMean, GetSum
USE GridOperations, ONLY : &
!imported routines
CellArea
USE Chronos, ONLY : &
!Imported definitions:
DateTime, &
!Imported variables:
timeString, &
!Imported operands:
ASSIGNMENT( = )
USE IniLib, ONLY: &
!Imported derived types:
IniList, &
!Imported routines:
IniOpen, IniClose, &
IniReadInt
USE Loglib, ONLY : &
!Imported routines:
Catch
USE TableLib, ONLY : &
!Imported definitions:
Table, &
!Imported routines:
TableNew, TableGetNrows, TableGetValue
USE GeoLib, ONLY: &
!imported routines:
DecodeEPSG, &
!DEBUG
ASSIGNMENT( = )
USE Utilities, ONLY : &
!imported routines:
GetUnit
IMPLICIT NONE
!variable definitions
TYPE Extent !PRIVATE
CHARACTER (LEN = 100) :: id
CHARACTER (LEN = 100) :: name
TYPE (grid_integer) :: mask
REAL (KIND = float) :: area !!surface area (m2)
!file unit
INTEGER (KIND = short) :: unitmeteo
INTEGER (KIND = short) :: unitbalance
INTEGER (KIND = short) :: unitsnow
INTEGER (KIND = short) :: unitice
INTEGER (KIND = short) :: unitsediment
INTEGER (KIND = short) :: unitcanopy
INTEGER (KIND = short) :: unitplants
!file name
CHARACTER (LEN = 1000) :: filemeteo
CHARACTER (LEN = 1000) :: filebalance
CHARACTER (LEN = 1000) :: filesnow
CHARACTER (LEN = 1000) :: fileice
CHARACTER (LEN = 1000) :: filesediment
CHARACTER (LEN = 1000) :: filecanopy
CHARACTER (LEN = 1000) :: fileplants
!average values
REAL (KIND = float), ALLOCATABLE :: meteo (:)
REAL (KIND = float), ALLOCATABLE :: balance (:)
REAL (KIND = float), ALLOCATABLE :: snow (:)
REAL (KIND = float), ALLOCATABLE :: ice (:)
REAL (KIND = float), ALLOCATABLE :: sediment (:)
REAL (KIND = float), ALLOCATABLE :: canopy (:)
REAL (KIND = float), ALLOCATABLE :: plants (:)
END TYPE Extent
!active output and header
LOGICAL :: meteoout (11) !1 = precipitation,
!2 = daily-precipitation,
!3 = air-temperature,
!4 = air-temperature-daily-mean,
!5 = air-temperature-daily-max
!6 = air-temperature-daily-min
!7 = relative-humidity
!8 = solar-radiation,
!9 = net-radiation
!10 = wind-speed
!11 = irrigation
CHARACTER (LEN = 40) :: meteoheader (11) = (/ 'precipitation_mm', & !1
'precipitation_daily_mm', & !2
'air-temperature_Celsius', & !3
'air-temperature-daily-mean_Celsius', & !4
'air-temperature-daily-max_Celsius', & !5
'air-temperature-daily-min_Celsius', & !6
'relative-humidity_0-100', & !7
'solar-radiation_wm-2', & !8
'net-radiation_wm-2', & !9
'wind-speed_ms-1' , & !10
'irrigation_mm' /) !11
LOGICAL :: balanceout (10) !1=soil-moisture, 2=soil-moisture-rz, 3=soil-moisture-tz,
!4 =runoff, 5=infiltration,6=percolation,
!7=actual evapotranspiration, 8 = PET, 9 = capillary rise,
!10=error
CHARACTER (LEN = 30) :: balanceheader (10) = (/ 'soil-moisture', & !1
'soil-moisture-rz', & !2
'soil-moisture-tz', & !3
'runoff_mm', & !4
'infiltration_mm', & !5
'percolation_mm', & !6
'actual_ET_mm', & !7
'PET_mm', & !8
'capillary-rise_mm', & !9
'error_mm'/) !10
LOGICAL :: snowout (6) !1=liquid-precipitation, 2= snow-water-equivalent, 3=melt-coefficient,
!4 =snow-covered-area, 5=water-in-snow, 6=snow-melt
CHARACTER (LEN = 30) :: snowheader (6) = (/ 'liquid-precipitation_mm', &
'snow-water-equivalent_mm', &
'melt-coefficient_mm/day/C', &
'snow-covered-area_01', &
'water-in-snow_mm', &
'snow-melt_mm' /)
LOGICAL :: iceout (4) !1=ice-water-equivalent, 2=glacier-covered-area,
!3=water-in-ice, 4=ice-melt
CHARACTER (LEN = 30) :: iceheader (4) = (/ 'ice-water-equivalent_mm', &
'glacier-covered-area_0-1', &
'water-in-ice_mm', &
'ice-melt_mm' /)
LOGICAL :: sedimentout (1) !1=erosion
CHARACTER (LEN = 30) :: sedimentheader (1) = (/ 'erosion_kg' /)
LOGICAL :: canopyout (3) !1=canopy-storage, 2=throughfall, 3=transpiration
CHARACTER (LEN = 30) :: canopyheader (3) = (/ 'canopy-storage_mm', &
'throughfall_mm', &
'canopy-transpiration_mm' /)
LOGICAL :: plantsout (11) !1=lai, 2 = GPP, 3 = NPP, 4 = stem-mass, 5 = root-mass, 6 = leaf-mass,
!7 = canopy-cover, 8 = dbh, 9 = height, 10 = density, 11 = stem-yield
CHARACTER (LEN = 30) :: plantsheader (11) = (/ 'LAI', &
'GPP_t', &
'NPP_t', &
'stem-mass_t', &
'root-mass_t', &
'leaf-mass_t', &
'canopy-cover_0-1', &
'DBH_cm', &
'Height_m', &
'density_tree-per-hectare', &
'stem-yield_t' /)
!times
TYPE (DateTime) :: timeSpatialAverageMeteo
TYPE (DateTime) :: timeSpatialAverageBalance
TYPE (DateTime) :: timeSpatialAverageSnow
TYPE (DateTime) :: timeSpatialAverageIce
TYPE (DateTime) :: timeSpatialAverageSediment
TYPE (DateTime) :: timeSpatialAverageCanopy
TYPE (DateTime) :: timeSpatialAveragePlants
!Public routines
PUBLIC :: InitSpatialAverageMeteo
PUBLIC :: InitSpatialAverageBalance
PUBLIC :: InitSpatialAverageSnow
PUBLIC :: InitSpatialAverageGlaciers
PUBLIC :: InitSpatialAverageSediment
PUBLIC :: InitSpatialAverageCanopy
PUBLIC :: InitSpatialAveragePlants
PUBLIC :: ComputeSpatialAverageMeteo
PUBLIC :: ComputeSpatialAverageBalance
PUBLIC :: ComputeSpatialAverageSnow
PUBLIC :: ComputeSpatialAverageGlaciers
PUBLIC :: ComputeSpatialAverageSediment
PUBLIC :: ComputeSpatialAverageCanopy
PUBLIC :: ComputeSpatialAveragePlants
PUBLIC :: ExportSpatialAverageMeteo
PUBLIC :: ExportSpatialAverageBalance
PUBLIC :: ExportSpatialAverageSnow
PUBLIC :: ExportSpatialAverageGlaciers
PUBLIC :: ExportSpatialAverageSediment
PUBLIC :: ExportSpatialAverageCanopy
PUBLIC :: ExportSpatialAveragePlants
!private declarations
TYPE (Table), PRIVATE :: extent_table
TYPE (Extent), PRIVATE, ALLOCATABLE :: extents (:) !store extents information
INTEGER (KIND = short), PRIVATE :: nextents !number of extents
INTEGER (KIND = short), PRIVATE :: countmeteo !!count number of meteo variables active for output
INTEGER (KIND = short), PRIVATE :: countbalance !!count number of soil balance variables active for output
INTEGER (KIND = short), PRIVATE :: countsnow !!count number of snow variables active for output
INTEGER (KIND = short), PRIVATE :: countice !!count number of glaciers variables active for output
INTEGER (KIND = short), PRIVATE :: countsediment !!count number of sediment variables active for output
INTEGER (KIND = short), PRIVATE :: countcanopy !!count number of canopy variables active for output
INTEGER (KIND = short), PRIVATE :: countplants !!count number of plants variables active for output
LOGICAL, PRIVATE :: meteoInitialized = .FALSE.
LOGICAL, PRIVATE :: balanceInitialized = .FALSE.
LOGICAL, PRIVATE :: snowInitialized = .FALSE.
LOGICAL, PRIVATE :: iceInitialized = .FALSE.
LOGICAL, PRIVATE :: sedimentInitialized = .FALSE.
LOGICAL, PRIVATE :: canopyInitialized = .FALSE.
LOGICAL, PRIVATE :: plantsInitialized = .FALSE.
!private routines
PRIVATE :: ConfigureExtents
!=======
CONTAINS
!=======
! Define procedures contained in this module.
!==============================================================================
!| Description:
! Initialization of spatial average of meteorological variables
SUBROUTINE InitSpatialAverageMeteo &
!
(fileini, pathout, temp, tmean, tmax, tmin, precipitation, &
rh, radiation, netradiation, windspeed, daily_precipitation, &
irrigation )
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: temp !!air temperarure (°C)
TYPE (grid_real), INTENT(IN) :: tmean !!air temperarure daily mean(°C)
TYPE (grid_real), INTENT(IN) :: tmax !!air temperarure daily max (°C)
TYPE (grid_real), INTENT(IN) :: tmin !!air temperarure daily min (°C)
TYPE (grid_real), INTENT(IN) :: precipitation !!precipitation rate (m/s)
TYPE (grid_real), INTENT(IN) :: rh !!air relative humidity (0-100)
TYPE (grid_real), INTENT(IN) :: radiation !!solar radiation (w/m2)
TYPE (grid_real), INTENT(IN) :: netradiation !!net radiation (w/m2)
TYPE (grid_real), INTENT(IN) :: windspeed !!wind speed (m/s)
TYPE (grid_real), INTENT(IN) :: daily_precipitation !!daily precipitation rate (m/s)
TYPE (grid_real), INTENT(IN) :: irrigation !!irrigation rate (m/s)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for meteo active variables ')
countmeteo = 0
!precipitation
IF ( IniReadInt ('precipitation', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (precipitation % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'precipitation not allocated, &
forced to not export spatial average ')
meteoout (1) = .FALSE.
ELSE
meteoout (1) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (1) = .FALSE.
END IF
!daily precipitation
IF ( IniReadInt ('daily-precipitation', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (daily_precipitation % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'daily precipitation not allocated, &
forced to not export spatial average ')
meteoout (2) = .FALSE.
ELSE
meteoout (2) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (2) = .FALSE.
END IF
!air temperature
IF ( IniReadInt ('temperature', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (temp % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'air temperature not allocated, &
forced to not export spatial average ')
meteoout (3) = .FALSE.
ELSE
meteoout (3) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (3) = .FALSE.
END IF
!daily mean air temperature
IF ( IniReadInt ('temperature-daily-mean', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (tmean % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'daily mean temperature not allocated, &
forced to not export spatial average ')
meteoout (4) = .FALSE.
ELSE
meteoout (4) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (4) = .FALSE.
END IF
!daily maximum air temperature
IF ( IniReadInt ('temperature-daily-max', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (tmax % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'daily maximum temperature not allocated, &
forced to not export spatial average ')
meteoout (5) = .FALSE.
ELSE
meteoout (5) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (5) = .FALSE.
END IF
!daily minimum air temperature
IF ( IniReadInt ('temperature-daily-min', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (tmin % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'daily minimum temperature not allocated, &
forced to not export spatial average ')
meteoout (6) = .FALSE.
ELSE
meteoout (6) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (6) = .FALSE.
END IF
!relative humidity
IF ( IniReadInt ('relative-humidity', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (rh % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'rh not allocated, &
forced to not export spatial average ')
meteoout (7) = .FALSE.
ELSE
meteoout (7) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (7) = .FALSE.
END IF
! solar radiation
IF ( IniReadInt ('solar-radiation', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (radiation % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'radiation not allocated, &
forced to not export spatial average ')
meteoout (8) = .FALSE.
ELSE
meteoout (8) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (8) = .FALSE.
END IF
! net radiation
IF ( IniReadInt ('net-radiation', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (netradiation % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'net radiation not allocated, &
forced to not export spatial average ')
meteoout (9) = .FALSE.
ELSE
meteoout (9) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (9) = .FALSE.
END IF
!wind speed
IF ( IniReadInt ('wind-speed', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (windspeed % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'windspeed not allocated, &
forced to not export spatial average ')
meteoout (10) = .FALSE.
ELSE
meteoout (10) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (10) = .FALSE.
END IF
!irrigation
IF ( IniReadInt ('irrigation', iniDB, section = 'meteo') == 1) THEN
IF ( .NOT. ALLOCATED (irrigation % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'irrigation not allocated, &
forced to not export spatial average ')
meteoout (11) = .FALSE.
ELSE
meteoout (11) = .TRUE.
countmeteo = countmeteo + 1
END IF
ELSE
meteoout (11) = .FALSE.
END IF
meteoInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAverageMeteo
!==============================================================================
!| Description:
! Initialization of spatial average of soil balance variables
SUBROUTINE InitSpatialAverageBalance &
!
(fileini, pathout, sm, smrz, smtz, runoff, infrate, perc, et, pet, &
caprise, error)
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: sm !!mean soil moisture (m3/m3)
TYPE (grid_real), INTENT(IN) :: smrz !!root zone soil moisture (m3/m3)
TYPE (grid_real), INTENT(IN) :: smtz !!transmission moisture (m3/m3)
TYPE (grid_real), INTENT(IN) :: runoff !!runoff rate (m/s)
TYPE (grid_real), INTENT(IN) :: infrate !!infiltration rate (m/s)
TYPE (grid_real), INTENT(IN) :: perc !!percolation (m/s)
TYPE (grid_real), INTENT(IN) :: et !!actual evapotranspiration rate (m/s)
TYPE (grid_real), INTENT(IN) :: pet !!potential evapotranspiration rate (m/s)
TYPE (grid_real), INTENT(IN) :: caprise !!actual evapotranspiration rate (m/s)
TYPE (grid_real), INTENT(IN) :: error !! balance error (mm)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for balance active variables ')
countbalance = 0
!mean soil volumetric water content
IF ( IniReadInt ('soil-moisture', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (sm % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'soil mositure not allocated, &
forced to not export spatial average ')
balanceout (1) = .FALSE.
ELSE
balanceout (1) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (1) = .FALSE.
END IF
!root zone volumetric water content
IF ( IniReadInt ('soil-moisture-rz', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (smrz % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'soil mositure rz not allocated, &
forced to not export spatial average ')
balanceout (2) = .FALSE.
ELSE
balanceout (2) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (2) = .FALSE.
END IF
!transmission zone volumetric water content
IF ( IniReadInt ('soil-moisture-tz', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (smtz % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'soil mositure tz not allocated, &
forced to not export spatial average ')
balanceout (3) = .FALSE.
ELSE
balanceout (3) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (3) = .FALSE.
END IF
!runoff
IF ( IniReadInt ('runoff', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (runoff % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'runoff not allocated, &
forced to not export spatial average ')
balanceout (4) = .FALSE.
ELSE
balanceout (4) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (4) = .FALSE.
END IF
!infiltration
IF ( IniReadInt ('infiltration', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (infrate % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'infiltration not allocated, &
forced to not export spatial average ')
balanceout (5) = .FALSE.
ELSE
balanceout (5) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (5) = .FALSE.
END IF
!percolation
IF ( IniReadInt ('percolation', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (perc % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'percolation not allocated, &
forced to not export spatial average ')
balanceout (6) = .FALSE.
ELSE
balanceout (6) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (6) = .FALSE.
END IF
!actual evapotranspiration
IF ( IniReadInt ('actual-ET', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (et % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'et not allocated, &
forced to not export spatial average ')
balanceout (7) = .FALSE.
ELSE
balanceout (7) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (7) = .FALSE.
END IF
!potential evapotranspiration
IF ( IniReadInt ('potential-ET', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (pet % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'pet not allocated, &
forced to not export spatial average ')
balanceout (8) = .FALSE.
ELSE
balanceout (8) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (8) = .FALSE.
END IF
!capillary rise
IF ( IniReadInt ('capillary-rise', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (caprise % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'capillary rise not allocated, &
forced to not export spatial average ')
balanceout (9) = .FALSE.
ELSE
balanceout (9) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (9) = .FALSE.
END IF
!balance error
IF ( IniReadInt ('error', iniDB, section = 'soil-balance') == 1) THEN
IF ( .NOT. ALLOCATED (error % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'balance error not allocated, &
forced to not export spatial average ')
balanceout (10) = .FALSE.
ELSE
balanceout (10) = .TRUE.
countbalance = countbalance + 1
END IF
ELSE
balanceout (10) = .FALSE.
END IF
balanceInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAverageBalance
!==============================================================================
!| Description:
! Initialization of spatial average of snow variables
SUBROUTINE InitSpatialAverageSnow &
!
(fileini, pathout, rain, swe, meltCoeff, freeWater, snowMelt )
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: rain !!rainfall rate (m/s)
TYPE (grid_real), INTENT(IN) :: swe !!snow water equivalent (m)
TYPE (grid_real), INTENT(IN) :: meltCoeff !!snow melt coefficient (mm/day/C)
TYPE (grid_real), INTENT(IN) :: freeWater !! water in snow pack (m)
TYPE (grid_real), INTENT(IN) :: snowMelt !!snow melt i the time step (m)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for snow active variables ')
countsnow = 0
!rainfall (liquid precipitation)
IF ( IniReadInt ('rain', iniDB, section = 'snow') == 1) THEN
IF ( .NOT. ALLOCATED (rain % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'liquid precipitation not allocated, &
forced to not export spatial average ')
snowout (1) = .FALSE.
ELSE
snowout (1) = .TRUE.
countsnow = countsnow + 1
END IF
ELSE
snowout (1) = .FALSE.
END IF
!snow water equivalent
IF ( IniReadInt ('snow-water-equivalent', iniDB, section = 'snow') == 1) THEN
IF ( .NOT. ALLOCATED (swe % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'swe not allocated, &
forced to not export spatial average ')
snowout (2) = .FALSE.
ELSE
snowout (2) = .TRUE.
countsnow = countsnow + 1
END IF
ELSE
snowout (2) = .FALSE.
END IF
!snow melt coefficient
IF ( IniReadInt ('melt-coefficient', iniDB, section = 'snow') == 1) THEN
IF ( .NOT. ALLOCATED (meltCoeff % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'melt-coefficient not allocated, &
forced to not export spatial average ')
snowout (3) = .FALSE.
ELSE
snowout (3) = .TRUE.
countsnow = countsnow + 1
END IF
ELSE
snowout (3) = .FALSE.
END IF
!snow covered area
IF ( IniReadInt ('snow-covered-area', iniDB, section = 'snow') == 1) THEN
IF ( .NOT. ALLOCATED (swe % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'snow water equivalent not allocated, &
forced to not export snow covered area ')
snowout (4) = .FALSE.
ELSE
snowout (4) = .TRUE.
countsnow = countsnow + 1
END IF
ELSE
snowout (4) = .FALSE.
END IF
!liquid water in snowpack
IF ( IniReadInt ('water-in-snow', iniDB, section = 'snow') == 1) THEN
IF ( .NOT. ALLOCATED (freeWater % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'water-in-snow not allocated, &
forced to not export spatial average ')
snowout (5) = .FALSE.
ELSE
snowout (5) = .TRUE.
countsnow = countsnow + 1
END IF
ELSE
snowout (5) = .FALSE.
END IF
!snow melt
IF ( IniReadInt ('snow-melt', iniDB, section = 'snow') == 1) THEN
IF ( .NOT. ALLOCATED (snowMelt % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'snow-melt not allocated, &
forced to not export spatial average ')
snowout (6) = .FALSE.
ELSE
snowout (6) = .TRUE.
countsnow = countsnow + 1
END IF
ELSE
snowout (6) = .FALSE.
END IF
snowInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAverageSnow
!==============================================================================
!| Description:
! Initialization of spatial average of glaciers variables
SUBROUTINE InitSpatialAverageGlaciers &
!
(fileini, pathout, iwe, freeWater, iceMelt)
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: iwe !!ice water equivalent (m)
TYPE (grid_real), INTENT(IN) :: freeWater !!water in ice (m)
TYPE (grid_real), INTENT(IN) :: iceMelt !! ice melt in the time step (m)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for glaciers active variables ')
countice = 0
!ice water equivalent
IF ( IniReadInt ('ice-water-equivalent', iniDB, section = 'glacier') == 1) THEN
IF ( .NOT. ALLOCATED (iwe % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'ice water equivalent not allocated, &
forced to not export spatial average ')
iceout (1) = .FALSE.
ELSE
iceout (1) = .TRUE.
countice = countice + 1
END IF
ELSE
iceout (1) = .FALSE.
END IF
!ice covered area
IF ( IniReadInt ('ice-covered-area', iniDB, section = 'glacier') == 1) THEN
IF ( .NOT. ALLOCATED (iwe % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'ice water equivalent not allocated, &
forced to not export ice covered area ')
iceout (2) = .FALSE.
ELSE
iceout (2) = .TRUE.
countice = countice + 1
END IF
ELSE
iceout (2) = .FALSE.
END IF
!liquid water in ice
IF ( IniReadInt ('water-in-ice', iniDB, section = 'glacier') == 1) THEN
IF ( .NOT. ALLOCATED (freeWater % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'water-in-ice not allocated, &
forced to not export water-in-ice ')
iceout (3) = .FALSE.
ELSE
iceout (3) = .TRUE.
countice = countice + 1
END IF
ELSE
iceout (3) = .FALSE.
END IF
!ice melt
IF ( IniReadInt ('ice-melt', iniDB, section = 'glacier') == 1) THEN
IF ( .NOT. ALLOCATED (iceMelt % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'ice-melt not allocated, &
forced to not export spatial average ')
iceout (4) = .FALSE.
ELSE
iceout (4) = .TRUE.
countice = countice + 1
END IF
ELSE
iceout (4) = .FALSE.
END IF
iceInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAverageGlaciers
!==============================================================================
!| Description:
! Initialization of spatial average of sediment variables
SUBROUTINE InitSpatialAverageSediment &
!
(fileini, pathout, detrate)
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: detrate !!sediment detachment rate (kg/s)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for sediment active variables ')
countsediment = 0
!detachment rate
IF ( IniReadInt ('detachment-rate', iniDB, section = 'sediment') == 1) THEN
IF ( .NOT. ALLOCATED (detrate % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'detachment rate not allocated, &
forced to not export spatial average ')
sedimentout (1) = .FALSE.
ELSE
sedimentout (1) = .TRUE.
countsediment = countsediment + 1
END IF
ELSE
sedimentout (1) = .FALSE.
END IF
sedimentInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAverageSediment
!==============================================================================
!| Description:
! Initialization of spatial average of canopy interception variables
SUBROUTINE InitSpatialAverageCanopy &
!
(fileini, pathout, canopyStorage, throughfall, pt)
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: canopyStorage !!water canopy storage (mm)
TYPE (grid_real), INTENT(IN) :: throughfall !! effective rain reaching soil surface (m/s)
TYPE (grid_real), INTENT(IN) :: pt!! potential transpiration from canopy (m/s)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for canopy active variables ')
countcanopy = 0
!canopy storage
IF ( IniReadInt ('canopy-storage', iniDB, section = 'canopy') == 1) THEN
IF ( .NOT. ALLOCATED (canopyStorage % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'canopy storage not allocated, &
forced to not export spatial average ')
canopyout (1) = .FALSE.
ELSE
canopyout (1) = .TRUE.
countcanopy = countcanopy + 1
END IF
ELSE
canopyout (1) = .FALSE.
END IF
!throughfall
IF ( IniReadInt ('throughfall', iniDB, section = 'canopy') == 1) THEN
IF ( .NOT. ALLOCATED (throughfall % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'throughfall not allocated, &
forced to not export spatial average ')
canopyout (2) = .FALSE.
ELSE
canopyout (2) = .TRUE.
countcanopy = countcanopy + 1
END IF
ELSE
canopyout (2) = .FALSE.
END IF
!canopy evaporation
IF ( IniReadInt ('transpiration', iniDB, section = 'canopy') == 1) THEN
IF ( .NOT. ALLOCATED (pt % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'transpiration not allocated, &
forced to not export spatial average ')
canopyout (3) = .FALSE.
ELSE
canopyout (3) = .TRUE.
countcanopy = countcanopy + 1
END IF
ELSE
canopyout (3) = .FALSE.
END IF
canopyInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAverageCanopy
!==============================================================================
!| Description:
! Initialization of spatial average of plants dynamic variables
SUBROUTINE InitSpatialAveragePlants &
!
(fileini, pathout, lai, gpp, npp, stem, root, leaf, cover, dbh, height, &
density, stemyield)
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
TYPE (grid_real), INTENT(IN) :: lai !!leaf area index (m2/m2)
TYPE (grid_real), INTENT(IN) :: gpp !!gross primary production (t)
TYPE (grid_real), INTENT(IN) :: npp !!net primary production (t)
TYPE (grid_real), INTENT(IN) :: stem !!stem biomass (t)
TYPE (grid_real), INTENT(IN) :: root !!root biomass (t)
TYPE (grid_real), INTENT(IN) :: leaf !!foliage biomass (t)
TYPE (grid_real), INTENT(IN) :: cover !!canopy cover (0-1)
TYPE (grid_real), INTENT(IN) :: dbh !!diameter at brest heigth (cm)
TYPE (grid_real), INTENT(IN) :: height !!tree height (m)
TYPE (grid_real), INTENT(IN) :: density !!tree density (tree/hectare)
TYPE (grid_real), INTENT(IN) :: stemyield !!stem yield (t)
!local declarations
TYPE(IniList) :: iniDB
!-------------------------------end of declaration-----------------------------
! open and read configuration file
CALL IniOpen (fileini, iniDB)
! search for active variable for output
CALL Catch ('info', 'SpatialAverage', 'checking for plants active variables ')
countplants = 0
!leaf area index
IF ( IniReadInt ('lai', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (lai % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'lai not allocated, &
forced to not export spatial average ')
plantsout (1) = .FALSE.
ELSE
plantsout (1) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (1) = .FALSE.
END IF
!gross primary production
IF ( IniReadInt ('gpp', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (gpp % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'gpp not allocated, &
forced to not export spatial average ')
plantsout (2) = .FALSE.
ELSE
plantsout (2) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (2) = .FALSE.
END IF
!net primary priduction
IF ( IniReadInt ('npp', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (npp % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'npp not allocated, &
forced to not export spatial average ')
plantsout (3) = .FALSE.
ELSE
plantsout (3) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (3) = .FALSE.
END IF
!stem biomass
IF ( IniReadInt ('stem', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (stem % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'stem biomass not allocated, &
forced to not export spatial average ')
plantsout (4) = .FALSE.
ELSE
plantsout (4) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (4) = .FALSE.
END IF
!root biomass
IF ( IniReadInt ('root', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (root % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'root biomass not allocated, &
forced to not export spatial average ')
plantsout (5) = .FALSE.
ELSE
plantsout (5) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (5) = .FALSE.
END IF
!leaf biomass
IF ( IniReadInt ('leaf', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (leaf % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'leaf biomass not allocated, &
forced to not export spatial average ')
plantsout (6) = .FALSE.
ELSE
plantsout (6) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (6) = .FALSE.
END IF
!canopy cover
IF ( IniReadInt ('cover', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (cover % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'canopy cover not allocated, &
forced to not export spatial average ')
plantsout (7) = .FALSE.
ELSE
plantsout (7) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (7) = .FALSE.
END IF
!diameter at brest heigth
IF ( IniReadInt ('dbh', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (dbh % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'dbh not allocated, &
forced to not export spatial average ')
plantsout (8) = .FALSE.
ELSE
plantsout (8) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (8) = .FALSE.
END IF
!tree height
IF ( IniReadInt ('height', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (height % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'height not allocated, &
forced to not export spatial average ')
plantsout (9) = .FALSE.
ELSE
plantsout (9) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (9) = .FALSE.
END IF
!tree density
IF ( IniReadInt ('density', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (density % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'density not allocated, &
forced to not export spatial average ')
plantsout (10) = .FALSE.
ELSE
plantsout (10) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (10) = .FALSE.
END IF
!stem yield
IF ( IniReadInt ('stem-yield', iniDB, section = 'plants') == 1) THEN
IF ( .NOT. ALLOCATED (stemyield % mat) ) THEN
CALL Catch ('warning', 'SpatialAverage', 'stem yield not allocated, &
forced to not export spatial average ')
plantsout (11) = .FALSE.
ELSE
plantsout (11) = .TRUE.
countplants = countplants + 1
END IF
ELSE
plantsout (11) = .FALSE.
END IF
plantsInitialized = .TRUE.
CALL IniClose (iniDB)
CALL ConfigureExtents (fileini, pathout)
RETURN
END SUBROUTINE InitSpatialAveragePlants
!==============================================================================
!| Description:
! Configure extents for computing and storing spatial average values
SUBROUTINE ConfigureExtents &
!
(fileini, pathout)
IMPLICIT NONE
!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN) :: fileini
CHARACTER(LEN = *), INTENT(IN) :: pathout
!local declarations
TYPE(IniList) :: iniDB
INTEGER (KIND = short) :: i, r, c
CHARACTER (LEN = 300) :: maskfile
CHARACTER (LEN = 300) :: filename
!-------------------------------end of declaration-----------------------------
IF ( .NOT. ( meteoInitialized .AND. &
balanceInitialized .AND. &
snowInitialized .AND. &
iceInitialized .AND. &
sedimentInitialized .AND. &
canopyInitialized .AND. &
plantsInitialized ) ) THEN
!initialization still not finished
RETURN
END IF
CALL Catch ('info', 'SpatialAverage', 'Configuring extents ')
! open and read configuration file
CALL IniOpen (fileini, iniDB)
!configure extents
CALL Catch ('info', 'SpatialAverage', 'configuring extents ')
CALL TableNew (fileini, extent_table)
nextents = TableGetNrows (extent_table)
ALLOCATE (extents(nextents))
DO i = 1, nextents
!read id
CALL TableGetValue ( REAL(i), extent_table, 'count', 'id', extents (i) % id)
!read name
CALL TableGetValue ( REAL(i), extent_table, 'count', 'name', extents (i) % name)
!read mask
CALL TableGetValue ( REAL(i), extent_table, 'count', 'file', maskfile)
CALL NewGrid (extents (i) % mask, maskfile, ESRI_ASCII)
extents (i) % mask % grid_mapping = DecodeEPSG ( IniReadInt ('epsg', iniDB))
!compute surface area
extents (i) % area = 0.
DO r = 1, extents (i) % mask % idim
DO c = 1, extents (i) % mask % jdim
IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN
extents (i) % area = extents (i) % area + &
CellArea (extents (i) % mask, r, c)
END IF
END DO
END DO
IF (countmeteo > 0) THEN
ALLOCATE ( extents (i) % meteo (countmeteo))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_meteo.out'
extents (i) % filemeteo = filename
END IF
IF (countbalance > 0) THEN
ALLOCATE ( extents (i) % balance (countbalance))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_balance.out'
extents (i) % filebalance = filename
END IF
IF (countsnow > 0) THEN
ALLOCATE ( extents (i) % snow (countsnow))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_snow.out'
extents (i) % filesnow = filename
END IF
IF (countice > 0) THEN
ALLOCATE ( extents (i) % ice (countice))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_glaciers.out'
extents (i) % fileice = filename
END IF
IF (countsediment > 0) THEN
ALLOCATE ( extents (i) % sediment (countsediment))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_sediment.out'
extents (i) % filesediment = filename
END IF
IF (countcanopy > 0) THEN
ALLOCATE ( extents (i) % canopy (countcanopy))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_canopy.out'
extents (i) % filecanopy = filename
END IF
IF (countplants > 0) THEN
ALLOCATE ( extents (i) % plants (countplants))
filename = TRIM(pathout) // TRIM(extents (i) % name) // '_plants.out'
extents (i) % fileplants = filename
END IF
END DO
CALL IniClose (iniDB)
RETURN
END SUBROUTINE ConfigureExtents
!==============================================================================
!| Description:
! Compute spatial average of meteorological variables
SUBROUTINE ComputeSpatialAverageMeteo &
!
(dt, temp, tmean, tmax, tmin, precipitation, rh, radiation, netradiation, &
windspeed, daily_precipitation, irrigation)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: temp !!air temperarure (°C)
TYPE (grid_real), INTENT(IN) :: tmean !!air temperarure daily mean(°C)
TYPE (grid_real), INTENT(IN) :: tmax !!air temperarure daily max (°C)
TYPE (grid_real), INTENT(IN) :: tmin !!air temperarure daily min (°C)
TYPE (grid_real), INTENT(IN) :: precipitation !!precipitation rate (m/s)
TYPE (grid_real), INTENT(IN) :: rh !!air relative humidity (0-100)
TYPE (grid_real), INTENT(IN) :: radiation !!solar radiation (w/m2)
TYPE (grid_real), INTENT(IN) :: netradiation !!net radiation (w/m2)
TYPE (grid_real), INTENT(IN) :: windspeed !!wind speed (m/s)
TYPE (grid_real), INTENT(IN) :: daily_precipitation !!daily precipitation (m/s)
TYPE (grid_real), INTENT(IN) :: irrigation !!irrigation rate (m/s)
!local declarations
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: count
!-------------------------------end of declaration-----------------------------
DO i = 1, nextents
count = 0
!precipitation
IF ( meteoout (1) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (precipitation, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!daily precipitation
IF ( meteoout (2) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (daily_precipitation, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!temperature
IF ( meteoout (3) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (temp, maskInteger = extents (i) % mask )
END IF
!temperature daily mean
IF ( meteoout (4) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (tmean, maskInteger = extents (i) % mask )
END IF
!temperature daily max
IF ( meteoout (5) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (tmax, maskInteger = extents (i) % mask )
END IF
!temperature daily min
IF ( meteoout (6) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (tmin, maskInteger = extents (i) % mask )
END IF
!relative humidity
IF ( meteoout (7) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (rh, maskInteger = extents (i) % mask )
END IF
!radiation
IF ( meteoout (8) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (radiation, maskInteger = extents (i) % mask )
END IF
!net radiation
IF ( meteoout (9) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (netradiation, maskInteger = extents (i) % mask )
END IF
!windspeed
IF ( meteoout (10) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (windspeed, maskInteger = extents (i) % mask )
END IF
!irrigation
IF ( meteoout (11) ) THEN
count = count + 1
extents (i) % meteo (count) = &
GetMean (irrigation, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAverageMeteo
!==============================================================================
!| Description:
! Compute spatial average of soil water balance variables
SUBROUTINE ComputeSpatialAverageBalance &
!
(dt, sm, smrz, smtz, runoff, infrate, perc, et, pet, caprise, error)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: sm !!mean soil moisture (m3/m3)
TYPE (grid_real), INTENT(IN) :: smrz !!root zone soil moisture (m3/m3)
TYPE (grid_real), INTENT(IN) :: smtz !!transmission zone soil moisture (m3/m3)
TYPE (grid_real), INTENT(IN) :: runoff !!runoff rate (m/s)
TYPE (grid_real), INTENT(IN) :: infrate !!infiltration rate (m/s)
TYPE (grid_real), INTENT(IN) :: perc !!percolation (m/s)
TYPE (grid_real), INTENT(IN) :: et !!actual evapotranspiration rate (m/s)
TYPE (grid_real), INTENT(IN) :: pet !!potential evapotranspiration rate (m/s)
TYPE (grid_real), INTENT(IN) :: caprise !!actual evapotranspiration rate (m/s)
TYPE (grid_real), INTENT(IN) :: error !! balance error (mm)
!local declarations
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: count
!-------------------------------end of declaration-----------------------------
DO i = 1, nextents
count = 0
!mean soil moisture
IF ( balanceout (1) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (sm, maskInteger = extents (i) % mask )
END IF
!root zone soil moisture
IF ( balanceout (2) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (smrz, maskInteger = extents (i) % mask )
END IF
!transmission zone soil moisture
IF ( balanceout (3) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (smtz, maskInteger = extents (i) % mask )
END IF
!runoff
IF ( balanceout (4) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (runoff, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!infiltration
IF ( balanceout (5) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (infrate, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!percolation
IF ( balanceout (6) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (perc, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!actual evapotranspiration
IF ( balanceout (7) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (et, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!potential evapotranspiration
IF ( balanceout (8) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (pet, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!capillary rise
IF ( balanceout (9) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (caprise, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!balance error
IF ( balanceout (10) ) THEN
count = count + 1
extents (i) % balance (count) = &
GetMean (error, maskInteger = extents (i) % mask )
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAverageBalance
!==============================================================================
!| Description:
! Compute spatial average of snow variables
SUBROUTINE ComputeSpatialAverageSnow &
!
(dt, rain, swe, meltCoeff, freeWater, snowMelt)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: rain !! liquid precipitation rate (m/s)
TYPE (grid_real), INTENT(IN) :: swe !! snow water equivalent (m)
TYPE (grid_real), INTENT(IN) :: meltCoeff !! melt coefficient (mm/day/°C)
TYPE (grid_real), INTENT(IN) :: freeWater !! liquid water in snow (m)
TYPE (grid_real), INTENT(IN) :: snowMelt !!snow melt (m)
!DEBUG intent(inout) to let modify grid_mapping
!local declarations
INTEGER (KIND = short) :: i, r, c
INTEGER (KIND = short) :: count
REAL (KIND = float) :: snowarea ![m2]
!-------------------------------end of declaration-----------------------------
!DEBUG
!force gridmapping on snow maps
!remeber to remove it after new release of snow module will be
!developed that sets CRS properly
!swe % grid_mapping = rain % grid_mapping
!water % grid_mapping = rain % grid_mapping
DO i = 1, nextents
count = 0
!rainfall (precipitation liquid fraction)
IF ( snowout (1) ) THEN
count = count + 1
extents (i) % snow (count) = &
GetMean (rain, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!snow water equivalent
IF ( snowout (2) ) THEN
count = count + 1
extents (i) % snow (count) = &
GetMean (swe, maskInteger = extents (i) % mask ) * 1000.
END IF
!snow melt coefficient
IF ( snowout (3) ) THEN
count = count + 1
extents (i) % snow (count) = &
GetMean (meltCoeff, maskInteger = extents (i) % mask )
END IF
!snow covered percentage
IF ( snowout (4) ) THEN
!compute snow covered area
snowarea = 0.
DO r = 1, extents (i) % mask % idim
DO c = 1, extents (i) % mask % jdim
IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN
IF (swe % mat (r,c) > 0.) THEN
snowarea = snowarea + CellArea (extents (i) % mask, r, c)
END IF
END IF
END DO
END DO
!compute snow covered percentage
count = count + 1
extents (i) % snow (count) = snowarea / extents (i) % area
END IF
!water in snow
IF ( snowout (5) ) THEN
count = count + 1
extents (i) % snow (count) = &
GetMean (freeWater, maskInteger = extents (i) % mask ) * 1000.
END IF
!snow melt
IF ( snowout (6) ) THEN
count = count + 1
extents (i) % snow (count) = &
GetMean (snowMelt, maskInteger = extents (i) % mask ) * 1000.
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAverageSnow
!==============================================================================
!| Description:
! Compute spatial average of glaciers variables
SUBROUTINE ComputeSpatialAverageGlaciers &
!
(dt, iwe, water, iceMelt)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: iwe !! ice water equivalent (m)
TYPE (grid_real), INTENT(INOUT) :: water !! free water in ice (m)
TYPE (grid_real), INTENT(IN) :: iceMelt !! ice melt in the time step (m)
!local declarations
INTEGER (KIND = short) :: i, r, c
INTEGER (KIND = short) :: count
REAL (KIND = float) :: icearea ![m2]
!-------------------------------end of declaration-----------------------------
DO i = 1, nextents
count = 0
!ice water equivalent
IF ( iceout (1) ) THEN
count = count + 1
extents (i) % ice (count) = &
GetMean (iwe, maskInteger = extents (i) % mask ) * 1000.
END IF
!glacier covered percentage
IF ( iceout (2) ) THEN
!compute glacier covered area
icearea = 0.
DO r = 1, extents (i) % mask % idim
DO c = 1, extents (i) % mask % jdim
IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN
IF (iwe % mat (r,c) > 0.) THEN
icearea = icearea + CellArea (extents (i) % mask, r, c)
END IF
END IF
END DO
END DO
!compute snow covered percentage
count = count + 1
extents (i) % ice (count) = icearea / extents (i) % area
END IF
!free water in ice pack
IF ( iceout (3) ) THEN
count = count + 1
extents (i) % ice (count) = &
GetMean (water, maskInteger = extents (i) % mask ) * 1000.
END IF
!ice melt
IF ( iceout (4) ) THEN
count = count + 1
extents (i) % ice (count) = &
GetMean (iceMelt, maskInteger = extents (i) % mask ) * 1000.
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAverageGlaciers
!==============================================================================
!| Description:
! Compute spatial average of sediment variables
SUBROUTINE ComputeSpatialAverageSediment &
!
(dt, erosion)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: erosion !! interril sediment detachment rate (kg/s)
!local declarations
INTEGER (KIND = short) :: i, r, c
INTEGER (KIND = short) :: count
REAL (KIND = float) :: icearea ![m2]
!-------------------------------end of declaration-----------------------------
DO i = 1, nextents
count = 0
!erosion (interril sediment detachment)
IF ( sedimentout (1) ) THEN
count = count + 1
extents (i) % sediment (count) = &
GetMean (erosion, maskInteger = extents (i) % mask ) * dt !conversion to kg over dt
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAverageSediment
!==============================================================================
!| Description:
! Compute spatial average of canopy interception variables
SUBROUTINE ComputeSpatialAverageCanopy &
!
(dt, canopyStorage, throughfall, pt)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: canopyStorage !!water canopy storage (mm)
TYPE (grid_real), INTENT(IN) :: throughfall !! effective rain reaching soil surface (m/s)
TYPE (grid_real), INTENT(IN) :: pt!! potential transpiration from canopy (m/s)
!local declarations
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: count
!-------------------------------end of declaration-----------------------------
DO i = 1, nextents
count = 0
!canopy storage
IF ( canopyout (1) ) THEN
count = count + 1
extents (i) % canopy (count) = &
GetMean (canopyStorage, maskInteger = extents (i) % mask )
END IF
!throughfall
IF ( canopyout (2) ) THEN
count = count + 1
extents (i) % canopy (count) = &
GetMean (throughfall, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
!transpiration (evaporation from canopy)
IF ( canopyout (3) ) THEN
count = count + 1
extents (i) % canopy (count) = &
GetMean (pt, maskInteger = extents (i) % mask ) * &
dt * 1000. !conversion to mm over dt
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAverageCanopy
!==============================================================================
!| Description:
! Compute spatial average of plants variables
SUBROUTINE ComputeSpatialAveragePlants &
!
(dt, lai, gpp, npp, stem, root, leaf, cover, dbh, height, density, stemyield)
IMPLICIT NONE
!arguments with intent in:
INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s)
TYPE (grid_real), INTENT(IN) :: lai !!leaf area index (m2/m2)
TYPE (grid_real), INTENT(IN) :: gpp !!gross primary production (t)
TYPE (grid_real), INTENT(IN) :: npp !!net primary production (t)
TYPE (grid_real), INTENT(IN) :: stem !!stem biomass (t)
TYPE (grid_real), INTENT(IN) :: root !!root biomass (t)
TYPE (grid_real), INTENT(IN) :: leaf !!foliage biomass (t)
TYPE (grid_real), INTENT(IN) :: cover !!canopy cover (0-1)
TYPE (grid_real), INTENT(IN) :: dbh !!diameter at brest heigth (cm)
TYPE (grid_real), INTENT(IN) :: height !!tree height (m)
TYPE (grid_real), INTENT(IN) :: density !!tree density (tree/hectare)
TYPE (grid_real), INTENT(IN) :: stemyield !!stem yield (t)
!local declarations
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: count
!-------------------------------end of declaration-----------------------------
DO i = 1, nextents
count = 0
!leaf area index
IF ( plantsout (1) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetMean (lai, maskInteger = extents (i) % mask )
END IF
!gross primary production
IF ( plantsout (2) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetSum (gpp, maskInteger = extents (i) % mask )
END IF
!net primary production
IF ( plantsout (3) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetSum (npp, maskInteger = extents (i) % mask )
END IF
!stem biomass
IF ( plantsout (4) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetSum (stem, maskInteger = extents (i) % mask )
END IF
!root biomass
IF ( plantsout (5) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetSum (root, maskInteger = extents (i) % mask )
END IF
!leaf biomass
IF ( plantsout (6) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetSum (leaf, maskInteger = extents (i) % mask )
END IF
!canopy cover
IF ( plantsout (7) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetMean (cover, maskInteger = extents (i) % mask )
END IF
!diameter at brest height
IF ( plantsout (8) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetMean (dbh, maskInteger = extents (i) % mask )
END IF
!tree height (m)
IF ( plantsout (9) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetMean (height, maskInteger = extents (i) % mask )
END IF
!tree density (tree/hectare)
IF ( plantsout (10) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetMean (density, maskInteger = extents (i) % mask )
END IF
!stem yield
IF ( plantsout (11) ) THEN
count = count + 1
extents (i) % plants (count) = &
GetSum (stemyield, maskInteger = extents (i) % mask )
END IF
END DO
RETURN
END SUBROUTINE ComputeSpatialAveragePlants
!==============================================================================
!| Description:
! Export spatial average of meteorological variables
SUBROUTINE ExportSpatialAverageMeteo &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countmeteo == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN ! open file and write header
DO i = 1, nextents
extents (i) % unitmeteo = GetUnit ()
OPEN (UNIT = extents (i) % unitmeteo, FILE = extents (i) % filemeteo)
WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a)') &
'spatial average values of meteorological variables'
WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,i5)') &
'number of variables: ', countmeteo
WRITE(UNIT = extents (i) % unitmeteo, FMT = *)
WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (meteoout)
IF (meteoout (k) ) THEN
count = count + 1
IF (count == countmeteo) THEN !last header
WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a)') TRIM(meteoheader (k))
ELSE
WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a,2x)', ADVANCE = 'no') TRIM(meteoheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAverageMeteo
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,2x, 11(E12.5,5x))') &
timeString, (extents (i) % meteo (k), k = 1, countmeteo)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAverageMeteo
!==============================================================================
!| Description:
! Export spatial average of soil balance variables
SUBROUTINE ExportSpatialAverageBalance &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countbalance == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN !open file and write header
DO i = 1, nextents
extents (i) % unitbalance = GetUnit ()
OPEN (UNIT = extents (i) % unitbalance, FILE = extents (i) % filebalance)
WRITE(UNIT = extents (i) % unitbalance, FMT ='(a)') &
'spatial average values of soil balance variables'
WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,i5)') &
'number of variables: ', countbalance
WRITE(UNIT = extents (i) % unitbalance, FMT = *)
WRITE(UNIT = extents (i) % unitbalance, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitbalance, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (balanceout)
IF (balanceout (k) ) THEN
count = count + 1
IF (count == countbalance) THEN !last header
WRITE(UNIT = extents (i) % unitbalance, FMT = '(a)') TRIM(balanceheader (k))
ELSE
WRITE(UNIT = extents (i) % unitbalance, FMT = '(a,2x)', ADVANCE = 'no') &
TRIM(balanceheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAverageBalance
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,2x, 10(E12.5,5x))') &
timeString, (extents (i) % balance (k), k = 1, countbalance)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAverageBalance
!==============================================================================
!| Description:
! Export spatial average of snow variables
SUBROUTINE ExportSpatialAverageSnow &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countsnow == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN !open file and write header
DO i = 1, nextents
extents (i) % unitsnow = GetUnit ()
OPEN (UNIT = extents (i) % unitsnow, FILE = extents (i) % filesnow)
WRITE(UNIT = extents (i) % unitsnow, FMT ='(a)') &
'spatial average values of snow variables'
WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,i5)') &
'number of variables: ', countsnow
WRITE(UNIT = extents (i) % unitsnow, FMT = *)
WRITE(UNIT = extents (i) % unitsnow, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitsnow, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (snowout)
IF (snowout (k) ) THEN
count = count + 1
IF (count == countsnow) THEN !last header
WRITE(UNIT = extents (i) % unitsnow, FMT = '(a)') TRIM(snowheader (k))
ELSE
WRITE(UNIT = extents (i) % unitsnow, FMT = '(a,2x)', ADVANCE = 'no') &
TRIM(snowheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAverageSnow
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,2x, 10(E12.5,5x))') &
timeString, (extents (i) % snow (k), k = 1, countsnow)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAverageSnow
!==============================================================================
!| Description:
! Export spatial average of glaciers variables
SUBROUTINE ExportSpatialAverageGlaciers &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countice == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN !open file and write header
DO i = 1, nextents
extents (i) % unitice = GetUnit ()
OPEN (UNIT = extents (i) % unitice, FILE = extents (i) % fileice)
WRITE(UNIT = extents (i) % unitice, FMT ='(a)') &
'spatial average values of glaciers variables'
WRITE(UNIT = extents (i) % unitice, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitice, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitice, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitice, FMT ='(a,i5)') &
'number of variables: ', countice
WRITE(UNIT = extents (i) % unitice, FMT = *)
WRITE(UNIT = extents (i) % unitice, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitice, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (iceout)
IF (iceout (k) ) THEN
count = count + 1
IF (count == countice) THEN !last header
WRITE(UNIT = extents (i) % unitice, FMT = '(a)') TRIM(iceheader (k))
ELSE
WRITE(UNIT = extents (i) % unitice, FMT = '(a,2x)', ADVANCE = 'no') &
TRIM(iceheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAverageIce
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitice, FMT ='(a,2x, 10(E12.5,5x))') &
timeString, (extents (i) % ice (k), k = 1, countice)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAverageGlaciers
!==============================================================================
!| Description:
! Export spatial average of sediment variables
SUBROUTINE ExportSpatialAverageSediment &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countsediment == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN !open file and write header
DO i = 1, nextents
extents (i) % unitsediment = GetUnit ()
OPEN (UNIT = extents (i) % unitsediment, FILE = extents (i) % filesediment)
WRITE(UNIT = extents (i) % unitsediment, FMT ='(a)') &
'spatial average values of sediment variables'
WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,i5)') &
'number of variables: ', countsediment
WRITE(UNIT = extents (i) % unitsediment, FMT = *)
WRITE(UNIT = extents (i) % unitsediment, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitsediment, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (sedimentout)
IF (sedimentout (k) ) THEN
count = count + 1
IF (count == countsediment) THEN !last header
WRITE(UNIT = extents (i) % unitsediment, FMT = '(a)') TRIM(sedimentheader (k))
ELSE
WRITE(UNIT = extents (i) % unitsediment, FMT = '(a,2x)', ADVANCE = 'no') &
TRIM(sedimentheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAverageSediment
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,2x, 10(E12.5,5x))') &
timeString, (extents (i) % sediment (k), k = 1, countsediment)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAverageSediment
!==============================================================================
!| Description:
! Export spatial average of canopy interception variables
SUBROUTINE ExportSpatialAverageCanopy &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countcanopy == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN !open file and write header
DO i = 1, nextents
extents (i) % unitcanopy = GetUnit ()
OPEN (UNIT = extents (i) % unitcanopy, FILE = extents (i) % filecanopy)
WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a)') &
'spatial average values of canopy interception variables'
WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,i5)') &
'number of variables: ', countcanopy
WRITE(UNIT = extents (i) % unitcanopy, FMT = *)
WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (canopyout)
IF (canopyout (k) ) THEN
count = count + 1
IF (count == countcanopy) THEN !last header
WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a)') TRIM(canopyheader (k))
ELSE
WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a,2x)', ADVANCE = 'no') &
TRIM(canopyheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAverageCanopy
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,2x, 10(E12.5,5x))') &
timeString, (extents (i) % canopy (k), k = 1, countcanopy)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAverageCanopy
!==============================================================================
!| Description:
! Export spatial average of plants variables
SUBROUTINE ExportSpatialAveragePlants &
!
(init)
IMPLICIT NONE
!arguments with intent in:
LOGICAL, OPTIONAL, INTENT(IN) :: init
!local declarations
INTEGER (KIND = short) :: i, k, count
!-------------------------------end of declaration-----------------------------
IF ( countplants == 0 ) THEN
RETURN
END IF
IF (PRESENT (init) .AND. init ) THEN !open file and write header
DO i = 1, nextents
extents (i) % unitplants = GetUnit ()
OPEN (UNIT = extents (i) % unitplants, FILE = extents (i) % fileplants)
WRITE(UNIT = extents (i) % unitplants, FMT ='(a)') &
'spatial average values of plants variables'
WRITE(UNIT = extents (i) % unitplants, FMT ='(a,a)') &
'extent id: ', TRIM(extents (i) % id)
WRITE(UNIT = extents (i) % unitplants, FMT ='(a,a)') &
'extent name: ', TRIM(extents (i) % name)
WRITE(UNIT = extents (i) % unitplants, FMT ='(a,f15.5)') &
'extent area (km2): ', extents (i) % area / 1000. ** 2.
WRITE(UNIT = extents (i) % unitplants, FMT ='(a,i5)') &
'number of variables: ', countplants
WRITE(UNIT = extents (i) % unitplants, FMT = *)
WRITE(UNIT = extents (i) % unitplants, FMT = '(a)') 'data'
WRITE(UNIT = extents (i) % unitplants, FMT = '(a)', ADVANCE = 'no' ) 'DateTime '
count = 0
DO k = 1, SIZE (plantsout)
IF (plantsout (k) ) THEN
count = count + 1
IF (count == countplants) THEN !last header
WRITE(UNIT = extents (i) % unitplants, FMT = '(a)') TRIM(plantsheader (k))
ELSE
WRITE(UNIT = extents (i) % unitplants, FMT = '(a,2x)', ADVANCE = 'no') &
TRIM(plantsheader (k))
END IF
END IF
END DO
END DO
ELSE !write spatial average values
timeString = timeSpatialAveragePlants
DO i = 1, nextents
WRITE(UNIT = extents (i) % unitplants, FMT ='(a,2x, 15(E12.5,5x))') &
timeString, (extents (i) % plants (k), k = 1, countplants)
END DO
END IF
RETURN
END SUBROUTINE ExportSpatialAveragePlants
END MODULE SpatialAverage