Skip to content
Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
11100 lines (8726 sloc) 609 KB
!------------------------------------------------------------------------------
! IST/MARETEC, Water Modelling Group, Mohid modelling system
!------------------------------------------------------------------------------
!
! TITLE : Mohid Model
! PROJECT : Mohid Land
! MODULE : Basin
! URL : http://www.mohid.com
! AFFILIATION : IST/MARETEC, Marine Modelling Group
! DATE : May 2003
! REVISION : Frank - v4.0
! DESCRIPTION : Module Basin is the top level of RunOff and Infiltration
!
!------------------------------------------------------------------------------
! ATMOSPHERE : 0/1 [1] !Use Module Atmosphere
! POROUS_MEDIA : 0/1 [1] !Use Module Porous Media
! RUN_OFF : 0/1 [1] !Use Module RunOff
! DRAINAGE_NET : 0/1 [1] !Use Module DrainageNetork
! OUTPUT_TIME : sec. sec. sec. - !Output Time
! TIME_SERIE_LOCATION : char - !Path to time serie location file
! INITIAL_LOSS : real [0.0] !Coeficient of initial rainfall losses
!------------------------------------------------------------------------------
!
!This program is free software; you can redistribute it and/or
!modify it under the terms of the GNU General Public License
!version 2, as published by the Free Software Foundation.
!
!This program is distributed in the hope that it will be useful,
!but WITHOUT ANY WARRANTY; without even the implied warranty of
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!GNU General Public License for more details.
!
!You should have received a copy of the GNU General Public License
!along with this program; if not, write to the Free Software
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!------------------------------------------------------------------------------
Module ModuleBasin
use ModuleGlobalData
use ModuleEnterData
use ModuleTime
use ModuleTimeSerie
use ModuleHDF5
use ModuleFunctions, only : ReadTimeKeyWords, LatentHeat, ConstructPropertyID, &
TimeToString, ChangeSuffix, CHUNK_J, SetMatrixValue,&
GetPointer, LinearInterpolation, ConstructPropertyIDOnFly
use ModuleFillMatrix, only : ConstructFillMatrix, ModifyFillMatrix, &
KillFillMatrix,GetIfMatrixRemainsConstant, &
GetDefaultValue
use ModuleHorizontalGrid, only : ConstructHorizontalGrid, KillHorizontalGrid, &
WriteHorizontalGrid, GetHorizontalGridSize, &
GetGridCellArea, UnGetHorizontalGrid, &
GetHorizontalGrid, GetXYCellZ
use ModuleHorizontalMap, only : ConstructHorizontalMap, KillHorizontalMap, &
UpdateComputeFaces2D, GetOpenPoints2D, &
GetBoundaries, UngetHorizontalMap
use ModuleGridData, only : ConstructGridData, KillGridData, &
GetGridData, UngetGridData
use ModuleBasinGeometry, only : ConstructBasinGeometry, KillBasinGeometry, &
GetBasinPoints, GetRiverPoints, UngetBasin, &
GetRiverPointsFromDN, SetRiverPointsFromDN
use ModuleAtmosphere, only : StartAtmosphere, ModifyAtmosphere, &
GetAtmosphereProperty, &
GetNextAtmosphereDTPrediction, &
GetAtmospherePropertiesIDByIdx, &
GetAtmospherenProperties, AtmospherePropertyExists, &
UnGetAtmosphere, KillAtmosphere
use ModuleRunOff, only : ConstructRunOff, ModifyRunOff, GetOverLandFlow, &
GetFlowToChannels, GetNextRunOffDT, &
GetBoundaryFlux, UnGetRunOff, KillRunOff, &
SetBasinColumnToRunoff, GetRunoffWaterColumn, &
GetRunoffWaterColumnOld, GetRunoffWaterLevel, &
GetRunoffTotalStoredVolume, GetMassError, &
GetRunOffStoredVolumes, GetRunOffBoundaryFlowVolume,&
GetRunOffTotalDischargeFlowVolume
use ModuleRunoffProperties, &
only : ConstructRunoffProperties, &
ModifyRunoffProperties, &
KillRunoffProperties, GetRPConcentration, &
GetRPnProperties, GetRPOptions, &
GetRPPropertiesIDByIdx, SetDNConcRP, &
UngetRunoffProperties, SetBasinConcRP, &
SetBasinToRPSplash, GetRPMassBalance, &
CheckRPProperty, GetRPConcentrationOld, &
GetRPDecayRate, SetVegetationRP, GetRPConcentrationAT
use ModuleDrainageNetwork,only : ConstructDrainageNetwork, FillOutPutMatrix, &
ModifyDrainageNetwork, &
GetHasProperties, GetDNnProperties, &
GetHasToxicity,GetNeedsRadiation, &
GetNeedsAtmosphere, SetAtmosphereDrainageNet, &
GetDNPropertiesIDByIdx, GetNextDrainageNetDT, &
GetVolumes, GetPropHasBottomFluxes, &
GetChannelsNodeLength,GetChannelsID, &
SetPMPConcDN,SetRPConcDN, UnGetDrainageNetwork, &
KillDrainageNetwork, SetGWFlowLayersToDN, &
GetDNMassBalance, CheckDNProperty, &
GetDNConcentration, GetDNStoredVolume, &
SetInflowFromReservoir, SetReservoirsConcDN, &
GetOutflowToReservoir, GetNodeConcReservoirs
use ModulePorousMedia, only : ConstructPorousMedia, ModifyPorousMedia, &
KillPorousMedia, GetGWFlowToChannels, &
GetInfiltration, GetEfectiveEVTP, &
GetPorousMediaTotalStoredVolume, GetEvaporation, &
GetNextPorousMediaDT, UngetPorousMedia, GetGWLayer, &
GetGWFlowOption, GetGWFlowToChannelsByLayer, &
GetGWToChannelsLayers, GetIgnoreWaterColumnOnEVAP, &
GetPMStoredVolume, GetEVTPVolumes, &
GetPMBoundaryFlowVolume, &
GetPMTotalDischargeFlowVolume, GetWaterContent, &
GetRelativeWaterContent, GetWaterContentForHead, &
GetPMObjMap
use ModulePorousMediaProperties, &
only : ConstructPorousMediaProperties, &
ModifyPorousMediaProperties, &
KillPorousMediaProperties, GetPMPConcentration, &
SetVegetationPMProperties, GetPMPCoupled, &
SetWindVelocity, GetPMPnProperties, &
GetPMPPropertiesIDByIdx, SetDNConcPMP, &
UngetPorousMediaProperties, CheckPMPProperty, &
SetInfColConcPMP, GetPMPMassBalance, GetECw, &
GetPMPConcentrationOld
use ModuleVegetation, only : ConstructVegetation, ModifyVegetation, &
KillVegetation, GetLeafAreaIndex, &
GetSpecificLeafStorage, GetEVTPCropCoefficient, &
GetTranspiration, GetVegetationSoilFluxes, &
SetSoilConcVegetation, GetVegetationOptions, &
GetVegetationDT, GetRootDepthOld, GetNutrientFraction, &
UnGetVegetation, UnGetVegetationSoilFluxes, &
GetCanopyHeight, GetTranspirationBottomLayer, &
GetPotLeafAreaIndex, GetCanopyStorageType, SetECw, &
GetVegetationAerialFluxes, GetVegetationGrowing, &
UnGetVegetationAerialFluxes, GetRootDepth, &
GetLAISenescence, GetVegetationAccHU
use ModuleStopWatch, only : StartWatch, StopWatch
use ModuleBoxDif, only : StartBoxDif, BoxDif, KillBoxDif
use ModuleGeometry, only : GetGeometrySize, GetGeometryDistances, UnGetGeometry
use ModuleSnow
use ModuleIrrigation
use ModuleMap
use ModuleReservoirs
#ifdef _ENABLE_CUDA
use ModuleCuda
#endif _ENABLE_CUDA
implicit none
private
!Subroutines---------------------------------------------------------------
!Constructor
public :: ConstructBasin
private :: AllocateInstance
private :: ReadFileNames
private :: ReadDataFile
private :: VerifyOptions
private :: AllocateVariables
private :: ConstructCoupledModules
private :: ConstructHDF5Output
private :: ConstructEVTPHDFOutput
private :: ConstructTimeSeries
!private :: ReadInitialFile
!Selector
!Modifier
public :: ModifyBasin
private :: AtmosphereProcesses
private :: DividePrecipitation
private :: CalcPotEvapoTranspiration
private :: AdjustCropCoefficient
private :: VegetationProcesses
private :: OverLandProcesses
private :: DrainageNetworkProcesses
private :: PorousMediaProcesses
private :: PorousMediaPropertiesProcesses
private :: ComputeBasinWaterBalance
private :: HDF5Output
private :: EVTPHDFOutput
private :: TimeSerieOutput
private :: GlobalMassError
private :: ComputeNextDT
!Destructor
public :: KillBasin
private :: DeAllocateInstance
!private :: WriteFinalFile
!Management
private :: Ready
private :: LocateObjBasin
private :: ReadLockExternalVar
private :: ReadUnLockExternalVar
!Interfaces----------------------------------------------------------------
!Parameters----------------------------------------------------------------
character(LEN = StringLength), parameter :: block_begin = '<beginproperty>'
character(LEN = StringLength), parameter :: block_end = '<endproperty>'
character(*), parameter :: CharAccErrorInVolume = 'acc. error in volume'
!Separate evapotranspiration
integer, parameter :: SingleEvapoTranspiration = 1
integer, parameter :: SeparateEvapoTranspiration = 2
!Surface evaporation method
integer, parameter :: LatentHeatMethod = 1
integer, parameter :: ET0Method = 2
integer, parameter :: NoEvaporation = 3
!Initial or Final time instant, used on Basin Water Balance
integer, parameter :: InitialInstant = 1
integer, parameter :: FinalInstant = 2
!Gw link between porous media and drainage network
! integer, parameter :: Layer_ = 2
integer, parameter :: DormantVegetation = 1
integer, parameter :: GrowingVegetation = 2
!Restart fiels format
integer, parameter :: BIN_ = 1
integer, parameter :: HDF_ = 2
!Types---------------------------------------------------------------------
type T_OutPut
type (T_Time), dimension(:), pointer :: OutTime => null()
type (T_Time), dimension(:), pointer :: RestartOutTime => null()
integer :: NextOutPut = 1
real , dimension(:,:), pointer :: OutputChannels => null()
logical :: Yes = .false.
logical :: WriteRestartFile = .false.
logical :: RestartOverwrite = .false.
integer :: NextRestartOutput = 1
integer :: RestartFormat = BIN_
end type T_OutPut
type T_Coupling
logical :: Atmosphere = .false.
logical :: Evapotranspiration = .false.
logical :: RunOff = .false.
logical :: RunOffProperties = .false.
logical :: DrainageNetwork = .false.
logical :: PorousMedia = .false.
logical :: PorousMediaProperties = .false.
logical :: Vegetation = .false.
logical :: Reservoirs = .false.
logical :: SimpleInfiltration = .false.
logical :: SCSCNRunOffModel = .false.
logical :: Snow = .false.
logical :: Irrigation = .false.
end type T_Coupling
type T_ExtVar
integer, dimension(:,:), pointer :: BasinPoints => null()
integer, dimension(:,:), pointer :: RiverPoints => null()
integer, dimension(:,:), pointer :: OpenPoints2D => null()
integer, dimension(:,:), pointer :: BoundaryPoints2D => null()
real , dimension(:,:), pointer :: GridCellArea => null()
real , dimension(:,:), pointer :: Topography => null()
real , dimension(:,:), pointer :: LeafAreaIndex => null()
real , dimension(:,:), pointer :: PotLeafAreaIndex => null()
real , dimension(:,:), pointer :: SpecificLeafStorage => null()
real , dimension(:,:), pointer :: CropCoefficient => null()
real , dimension(:,:,:), pointer :: ActualTranspiration => null()
real , dimension(:,:), pointer :: MassError => null()
end type T_ExtVar
!External variables from Runoff but that will be updated and sent to Runoff
type T_ExtUpdate
real(8), dimension(:,:), pointer :: WaterLevel => null()
real(8), dimension(:,:), pointer :: WaterColumn => null()
real(8), dimension(:,:), pointer :: WaterColumnOld => null()
end type T_ExtUpdate
type T_Files
character(len=PathLength) :: ConstructData = null_str
character(len=PathLength) :: TopographicFile = null_str
character(len=PathLength) :: HDFFile = null_str
character(len=PathLength) :: EVTPHDFFile = null_str
character(len=PathLength) :: EVTPHDFFile2 = null_str
character(len=PathLength) :: EVTPInstHDFFile = null_str
character(len=PathLength) :: InitialFile = null_str
character(len=PathLength) :: FinalFile = null_str
character(len=PathLength) :: TimeSerieLocation = null_str
character(len=PathLength) :: BWBTimeSeriesLocation = null_str
character(len=PathLength) :: IntegrationTimeSeriesLocation = null_str
end type T_Files
type T_IntegratedFlow
logical :: On = .false.
real :: Flow = null_real
integer :: CurrentIndex = null_int
integer :: ObjTimeSerie = 0
end type T_IntegratedFlow
type T_PropMassBalance
!All masses in kg
!Initial and final volumes
real(8) :: InitialRPStoredMass = 0.
real(8) :: InitialVegetationStoredMass = 0.
real(8) :: InitialPMPStoredMass = 0.
real(8) :: InitialDNStoredMass = 0.
real(8) :: FinalRPStoredMass = 0.
real(8) :: FinalVegetationStoredMass = 0.
real(8) :: FinalPMPStoredMass = 0.
real(8) :: FinalDNStoredMass = 0.
!PorousMediaProperties Mass Fluxes
real(8) :: PMPTranspiredMass = 0.
real(8) :: PMPExchangeMassToDN = 0.
real(8) :: RPExchangeMassToPMP = 0.
!RunoffProperties Mass Fluxes
real(8) :: RPExchangeMassToDN = 0.
!DrainageNetwork Mass Fluxes
real(8) :: DNDischargeMass = 0.
real(8) :: DNOutflowMass = 0.
!Basin Mass Flux
real(8) :: TotalRainMass = 0. !above leafs (covered + uncovered)
real(8) :: CoveredRainMass = 0. !rain on leafs (covered)
real(8) :: UncoveredRainMass = 0. !direct rain (uncovered)
real(8) :: VegDrainedMass = 0. !leaf leak
real(8) :: RunoffInputMass = 0. !leaf leak + direct rain
end type T_PropMassBalance
type T_BasinProperty
type (T_PropertyID) :: ID
real, dimension(:,:), pointer :: Field => null()
logical :: Constant = .false. !in time
logical :: ConstantInSpace = .false. !in space
type (T_BasinProperty), pointer :: Next => null()
logical :: AdvectionDiffusion = .false.
!~ logical :: Particulate = .false.
logical :: Decay = .false.
logical :: DecayRate = .false.
type (T_PropMassBalance) :: MB
real(8), dimension(:,:), pointer :: VegetationConc => null()
real(8), dimension(:,:), pointer :: VegetationDrainage => null()
real(8), dimension(:,:), pointer :: VegetationOldMass => null()
logical :: Inherited = .false.
real :: VegTotalStoredMass = 0.
end type T_BasinProperty
type T_PropertyB
type (T_PropertyID) :: ID
real, dimension(:,:), pointer :: Field => null()
end type T_PropertyB
type T_SimpleInfiltration
type (T_PropertyB) :: Ks
type (T_PropertyB) :: MP ! MatricPotential
type (T_PropertyB) :: ThetaS
type (T_PropertyB) :: ThetaI
type (T_PropertyB) :: InfRate
type (T_PropertyB) :: AccInf
type (T_PropertyB) :: ImpFrac
type (T_PropertyB) :: TimeWithNoWC
real :: HoursToResetAccInf
end type T_SimpleInfiltration
type T_SCSCNRunOffModel
type (T_PropertyB) :: InfRate
type (T_PropertyB) :: CurveNumber
real :: IAFactor = 0.2 !Initial Abstraction Factor = 0.2 or 0.05
logical :: ConvertIAFactor = .false.
type (T_PropertyB) :: VegGrowthStage
type (T_PropertyB) :: ImpFrac
real, dimension (:,:,:), pointer :: Last5DaysAccRain => null ()
real, dimension (:,:), pointer :: Last5DaysAccRainTotal => null ()
real, dimension (:,:), pointer :: DailyAccRain => null ()
real(8), dimension (:,:), pointer :: Current5DayAccRain => null ()
real(8), dimension (:,:), pointer :: ActualCurveNumber => null ()
real, dimension (:,:), pointer :: S => null ()
type (T_Time) :: NextRainAccStart
real :: CIDormThreshold = 12.70, &
CIIIDormThreshold = 27.94, &
CIGrowthThreshold = 35.56, &
CIIIGrowthThreshold = 53.34
end type T_SCSCNRunOffModel
type T_WaterMassBalance
!Initial Mass
real(8) :: IniVolumeRunoff = 0.
real(8) :: IniVolumeVegetation = 0.
real(8) :: IniVolumePorousMedia = 0.
real(8) :: IniVolumeChannels = 0.
!Sink / Sources
real(8) :: EvapFromVegetation = 0.
real(8) :: EvapFromGround = 0.
real(8) :: EvapFromSoil = 0.
real(8) :: TotalRainIn = 0. !above leafs
real(8) :: RainDirect = 0. !on uncovered area
real(8) :: RainInVeg = 0. !on covered area (leafs)
real(8) :: DrainageFromVeg = 0. !leak from covered (leafs)
real(8) :: RainRunoff = 0. !arriving at WC (direct + drainage)
real(8) :: DischargesIn = 0.
real(8) :: OverTopOut = 0.
real(8) :: OutVolumeChannel = 0.
real(8) :: OutVolumeOverLand = 0.
!Final Mass
real(8) :: FinalVolumeRunoff = 0.
real(8) :: FinalVolumeVegetation = 0.
real(8) :: FinalVolumePorousMedia = 0.
real(8) :: FinalVolumeChannels = 0.
!Flow exchange between modules
real(8) :: OLFlowToRiver = 0.
real(8) :: GWFlowToRiver = 0.
real(8) :: Infiltration = 0.
end type T_WaterMassBalance
type T_BasinWaterBalance
real(8) :: Rain = 0.0 !m3
real(8) :: Irrigation = 0.0 !m3
real(8) :: SnowMelting = 0.0 !m3
real(8) :: DischargesOnSoil = 0.0 !m3
real(8) :: DischargesOnSurface = 0.0 !m3
real(8) :: DischargesOnChannels = 0.0 !m3
real(8) :: IniStoredInSoil = 0.0 !m3
real(8) :: IniStoredInChannels = 0.0 !m3
real(8) :: IniStoredInLeaves = 0.0 !m3
real(8) :: IniStoredInSurface = 0.0 !m3
real(8) :: IniStoredInStormWater = 0.0 !m3
real(8) :: FinStoredInSoil = 0.0 !m3
real(8) :: FinStoredInChannels = 0.0 !m3
real(8) :: FinStoredInLeaves = 0.0 !m3
real(8) :: FinStoredInSurface = 0.0 !m3
real(8) :: FinStoredInStormWater = 0.0 !m3
real(8) :: StoredInSoil = 0.0 !m3
real(8) :: StoredInChannels = 0.0 !m3
real(8) :: StoredInLeaves = 0.0 !m3
real(8) :: StoredInSurface = 0.0 !m3
real(8) :: StoredInStormWater = 0.0 !m3
real(8) :: OutletFlowVolume = 0.0 !m3
real(8) :: EvapFromSoil = 0.0 !m3
real(8) :: EvapFromLeaves = 0.0 !m3
real(8) :: EvapFromChannels = 0.0 !m3
real(8) :: EvapFromSurface = 0.0 !m3
real(8) :: Transpiration = 0.0 !m3
real(8) :: BoundaryFromSoil = 0.0 !m3
real(8) :: BoundaryFromSurface = 0.0 !m3
real(8) :: Input = 0.0 !m3 rain and irrigation
real(8) :: Stored = 0.0 !m3 on soil, on leaves, on channels, on surface
real(8) :: Output = 0.0 !m3 evap from (soil + leaves + surface + channels) + transpiration + outlet flow
real(8) :: Discharges = 0.0 !m3 on Soil, on surface, on channels (can be positive or negative)
real(8) :: Boundary = 0.0 !m3 on Soil and Surface
real(8) :: ErrorInVolume = 0.0 !m3
real(8) :: AccErrorInVolume = 0.0 !m3
real(8) :: ErrorInPercentage = 0.0 !% of error from the actual stored (variation from initial to final) water content
!to the expected due the inputs/outputs/discharges
logical :: StoreInitial = .true.
real(8) :: BasinArea = 0.0 !m2 -> this should be a line in the TS header.
integer :: NumberOfCells = 0
end type T_BasinWaterBalance
type T_Integration
logical :: Integrate = .false.
real :: Interval = 86400.0
logical :: IntegrateTemperature = .true.
logical :: IntegratePrecipitation = .true.
logical :: IntegrateEVTP = .true.
logical :: IntegrateIrrigation = .true.
integer :: ObjTimeSeries = 0
type(T_Time) :: NextOutputTime
real, pointer :: Temperature(:,:) => null()
real, pointer :: Precipitation(:,:) => null()
real, pointer :: EVTPRef(:,:) => null()
real, pointer :: EVTPCrop(:,:) => null()
real, pointer :: EVTPActual(:,:) => null()
real, pointer :: Irrigation(:,:) => null()
real, pointer :: Buffer(:) => null()
end type T_Integration
type T_BasinDT
real :: SyncDT = 86400.
real :: NextDT = 86400.
real :: MinDTThreshold = 0.
end type T_BasinDT
type T_Basin
integer :: InstanceID = 0
character(len=StringLength) :: ModelName = null_str
integer :: ModelType = MOHIDLAND_
logical :: StopOnBathymetryChange = .true.
type (T_Size2D) :: Size, WorkSize
type (T_Coupling) :: Coupled
type (T_Files) :: Files
type (T_ExtVar) :: ExtVar
type (T_ExtUpdate) :: ExtUpdate
type (T_SimpleInfiltration) :: SI
type (T_SCSCNRunOffModel) :: SCSCNRunOffModel
type (T_BasinProperty), pointer :: FirstProperty => null()
logical :: Continuous = .false.
logical :: StopOnWrongDate = .true.
logical :: VerifyGlobalMass = .false.
logical :: VerifyAtmosphereValues = .true.
logical :: Calibrating1D = .false.
logical :: ConcentrateRain = .false.
logical :: EvapFromWaterColumn = .false.
logical :: EvapFromCanopy = .false.
integer :: EvapMethod = null_int
real :: RefEvapotranspirationConstant = null_real
real :: RainAverageDuration = 600.0
real :: WCRemovalTime = 600.
real :: DTDuringRain = null_real
logical :: AdjustDTForRainEvent = .false.
real :: AdjustDTForRainEventFactor = null_real
logical :: DiffuseWaterSource = .false.
real :: FlowPerCapita = 0.0
character(PathLength) :: PopDensityFile = null_str
real :: ExtinctionCoef = 0.6
real :: CurrentDT = null_real
integer :: EvapoTranspirationMethod = null_int
logical :: ConstructEvaporation = .false.
logical :: ConstructTranspiration = .false.
real(8), dimension(:,:), pointer :: WaterColumnRemoved => null()
real(8), dimension(:,:), pointer :: CanopyStorageCapacity => null()
real(8), dimension(:,:), pointer :: CanopyStorage => null() !mH20 in m2 cov
real(8), dimension(:,:), pointer :: CanopyStorageOld => null() !mH20 in m2 cov
real(8), dimension(:,:), pointer :: CanopyDrainage => null() !mH20 in m2 cell
real(8), dimension(:,:), pointer :: SnowPack => null()
real(8), dimension(:,:), pointer :: ThroughFall => null() !mH20 in m2 cell
real(8), dimension(:,:), pointer :: RainUncovered => null() !mH20 in m2 cov
real(8), dimension(:,:), pointer :: RainCovered => null() !mH20 in m2 uncov
real , dimension(:,:), pointer :: CoveredFraction => null()
real , dimension(:,:), pointer :: CoveredFractionOld => null()
real , dimension(:,:), pointer :: CropEvapotrans => null()
real , dimension(:,:), pointer :: PotentialTranspiration => null()
real , dimension(:,:), pointer :: PotentialEvaporation => null()
real(8), dimension(:,:), pointer :: PotentialInfCol => null()
real(8), dimension(:,:), pointer :: FlowProduction => null()
real(8), dimension(:,:), pointer :: InfiltrationRate => null()
real(8), dimension(:,:), pointer :: SnowMeltingRate => null() !mm/hour
real(8), dimension(:,:), pointer :: PrecipRate => null()
real(8), dimension(:,:), pointer :: ThroughRate => null()
real(8), dimension(:,:), pointer :: EVTPRate => null()
!real(8), dimension(:,:), pointer :: EVTPRate2 => null()
real(8), dimension(:,:), pointer :: PlantWaterStress => null()
real(8), dimension(:,:), pointer :: AccInfiltration => null()
real(8), dimension(:,:), pointer :: AccFlowProduction => null()
real(8), dimension(:,:), pointer :: AccEVTP => null()
real(8), dimension(:,:), pointer :: AccSnowMelting => null() !m
real(8), dimension(:,:), pointer :: PartialAccEVTP => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVTPRef => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVTPCrop => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVPot => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVAct => null() !mm
real(8), dimension(:,:), pointer :: PartialAccETPot => null() !mm
real(8), dimension(:,:), pointer :: PartialAccETAct => null() !mm
real(8), dimension(:,:), pointer :: AccEVTP2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVTP2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVTPRef2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVTPCrop2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVPot2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccEVAct2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccETPot2 => null() !mm
real(8), dimension(:,:), pointer :: PartialAccETAct2 => null() !mm
real(8), dimension(:,:), pointer :: AccRainFall => null()
real(8), dimension(:,:), pointer :: AccEVPCanopy => null()
real, dimension(:,:), pointer :: AccRainHour => null()
real, dimension(:,:), pointer :: RainStartTime => null()
real, dimension(:,:), pointer :: RainDuration => null()
real, dimension(:,:), pointer :: DiffuseFlow => null()
! real :: WaterColumnCoef
real :: ETConversionFactor = 1
type (T_WaterMassBalance) :: MB
type (T_IntegratedFlow) :: DailyFlow
type (T_IntegratedFlow) :: MonthlyFlow
real, dimension(:), pointer :: TimeSeriesBuffer => null() !Water Error
real, dimension(:), pointer :: TimeSeriesBuffer2 => null()
real, dimension(:), pointer :: TimeSeriesBuffer3 => null() !Properties Error
real, dimension(:), pointer :: BWBBuffer => null() !buffer to be used for Basin Water Balance
!Basin Water Balance
type (T_BasinWaterBalance) :: BWB
logical :: ComputeBasinWaterBalance = .false.
!Basin is responsable by Total vegetation volume
real(8) :: VolumeVegetation = null_real
integer :: nReservoirs = null_int
type (T_Time) :: CurrentTime
type (T_Time) :: BeginTime
type (T_Time) :: EndTime
type (T_OutPut) :: OutPut
type (T_OutPut) :: EVTPOutPut
type (T_OutPut) :: EVTPOutPut2
type (T_OutPut) :: EVTPInstOutPut
!type (T_OutPut) :: EVTPRefOutPut
type (T_Integration) :: Integration
real :: DefaultKcWhenLAI0 = 0.3
logical :: UseDefaultKcWhenLAI0 = .false.
logical :: UsePotLAI = .false.
real :: KcMin = 0.3
logical :: UseKcMin = .false.
logical :: UseRefEVTPIfNeeded = .true.
logical :: ControlDTChanges = .false.
!Instance IDs
integer :: ObjTime = 0
integer :: ObjEnterData = 0
integer :: ObjHorizontalGrid = 0
integer :: ObjHorizontalMap = 0
integer :: ObjGridData = 0
integer :: ObjBasinGeometry = 0
integer :: ObjGeometry = 0 !only for getting KUB
integer :: ObjAtmosphere = 0
integer :: ObjRunOff = 0
integer :: ObjRunOffProperties = 0
integer :: ObjDrainageNetwork = 0
integer :: ObjPorousMedia = 0
integer :: ObjVegetation = 0
integer :: ObjReservoirs = 0
integer :: ObjSnow = 0
integer :: ObjIrrigation = 0
integer :: ObjHDF5 = 0
integer :: ObjEVTPHDF = 0
integer :: ObjEVTPHDF2 = 0
integer :: ObjEVTPInstHDF = 0
!integer :: ObjEVTPRefHDF = 0
integer :: ObjTimeSerie = 0
integer :: ObjTimeSerieBasin = 0
integer :: ObjTimeSerieBasinMass = 0
integer :: ObjPorousMediaProperties = 0
integer :: ObjBWB = 0 !Basin Water Balance Timeseries ID
integer :: ObjDischargesRunoff = 0 !Discharges in Runoff
integer :: ObjDischargesPM = 0 !Discharges in PorousMedia
#ifdef _ENABLE_CUDA
integer :: ObjCuda = 0
#endif _ENABLE_CUDA
type (T_Basin), pointer :: Next
!Used by PorousMediaProperties
real(8), dimension(:,:), pointer :: WaterColumnEvaporated => null() !in meters (m)
real, dimension(6) :: KcThresholds
logical :: UseKCThresholds = .false.
type(T_BasinDT) :: InternalDT
end type T_Basin
!Global Module Variables
type (T_Basin), pointer :: FirstObjBasin => null()
type (T_Basin), pointer :: Me => null()
!--------------------------------------------------------------------------
contains
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONS
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
subroutine ConstructBasin(ObjBasinID, ObjTime, ModelName, StopOnBathymetryChange, STAT)
!Arguments---------------------------------------------------------------
integer :: ObjBasinID
integer :: ObjTime
character(len=*) :: ModelName
logical :: StopOnBathymetryChange
integer, optional, intent(OUT) :: STAT
!Local-------------------------------------------------------------------
integer :: ready_
integer :: i, j
integer :: STAT_, STAT_CALL
logical :: VariableDT
character (Len = StringLength) :: WarningString
character (Len = StringLength) :: LockToWhichModules
character (Len = StringLength) :: UnLockToWhichModules
character (Len = StringLength) :: OptionsType
#ifdef _ENABLE_CUDA
type (T_Size3D) :: GeometrySize
#endif _ENABLE_CUDA
!------------------------------------------------------------------------
! integer :: TID, OMP_GET_THREAD_NUM
!!call OMP_SET_DYNAMIC(.false.)
!!call OMP_SET_NUM_THREADS(2)
!!!! $OMP PARALLEL SHARED(Me) PRIVATE(TID)
!!!!TID = OMP_GET_THREAD_NUM()
!!!!PRINT *, 'Hello World from thread = ', TID
!!!! $OMP END PARALLEL
STAT_ = UNKNOWN_
!Assures nullification of the global variable
if (.not. ModuleIsRegistered(mBasin_)) then
nullify (FirstObjBasin)
call RegisterModule (mBasin_)
endif
call Ready(ObjBasinID, ready_)
cd0 : if (ready_ .EQ. OFF_ERR_) then
call AllocateInstance
!Returns ID
ObjBasinID = Me%InstanceID
Me%ModelName = ModelName
Me%ModelType = MOHIDLAND_
!Associates External Instances
Me%ObjTime = AssociateInstance (mTIME_, ObjTime)
!stop the model on bathymetry change?
Me%StopOnBathymetryChange = StopOnBathymetryChange
call GetComputeCurrentTime (Me%ObjTime, CurrentTime = Me%CurrentTime, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR01'
call GetVariableDT (Me%ObjTime, VariableDT, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR02'
call GetComputeTimeLimits (Me%ObjTime, BeginTime = Me%BeginTime, &
EndTime = Me%EndTime, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR03'
call ReadFileNames
!Constructs Horizontal Grid
call ConstructHorizontalGrid(Me%ObjHorizontalGrid, Me%Files%TopographicFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR04'
!Constructs GridData
call ConstructGridData (Me%ObjGridData, Me%ObjHorizontalGrid, &
FileName = Me%Files%TopographicFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR05'
!Constructs BasinGeometry
call ConstructBasinGeometry (Me%ObjBasinGeometry, Me%ObjGridData, &
Me%ObjHorizontalGrid, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR06'
!Gets BasinPoints
call GetBasinPoints (Me%ObjBasinGeometry, Me%ExtVar%BasinPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR07'
!Constructs Mapping
call ConstructHorizontalMap (Me%ObjHorizontalMap, Me%ObjGridData, &
Me%ObjHorizontalGrid, Me%CurrentTime, &
Me%ExtVar%BasinPoints, 2, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR08'
!Gets the size of the grid
call GetHorizontalGridSize (Me%ObjHorizontalGrid, &
Size = Me%Size, &
WorkSize = Me%WorkSize, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR09a'
call GetGridCellArea(Me%ObjHorizontalGrid, Me%ExtVar%GridCellArea, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR09b'
Me%BWB%BasinArea = 0.0
Me%BWB%NumberOfCells = 0
do j = Me%Size%JLB, Me%Size%JUB
do i = Me%Size%ILB, Me%Size%IUB
if (Me%ExtVar%BasinPoints(i, j) == 1) then
Me%BWB%BasinArea = Me%BWB%BasinArea + Me%ExtVar%GridCellArea(i, j)
Me%BWB%NumberOfCells = Me%BWB%NumberOfCells + 1
endif
enddo
enddo
call UnGetHorizontalGrid(Me%ObjHorizontalGrid, Me%ExtVar%GridCellArea, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR09c'
!Ungets BasinPoints
call UngetBasin (Me%ObjBasinGeometry, Me%ExtVar%BasinPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR09d'
#ifdef _ENABLE_CUDA
! Construct a ModuleCuda instance.
call ConstructCuda(Me%ObjCuda, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR20'
call GetGeometrySize (Me%ObjGeometry, &
WorkSize = GeometrySize, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR21'
! JPW: Initialize a C++ Thomas instance for CUDA.
! This will allocate device memory for all Thomas variables (D, E, F, TI, Res)
! Do this seperately from ConstructCuda, because later on ModuleCuda might be used for things other than Thomas algorithm
call InitializeThomas(Me%ObjCuda, GeometrySize, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR22'
#endif _ENABLE_CUDA
!Gets ExternalVars
LockToWhichModules = 'AllModules'
OptionsType = 'ConstructBasin'
call ReadLockExternalVar (LockToWhichModules, OptionsType)
!Reads Data File
call ReadDataFile
!ChunkI and ChunkJ are global variables (defined in ModuleGlobalData)
!ChunkK is defined only if PorousMedia is ON and is defined in the ModulePorousMedia
!ReadDataFile must be called first, so Chunk(X)Factor user values are defined.
ChunkJ = max((Me%Size%JUB - Me%Size%JLB) / ChunkJFactor, 1)
ChunkI = max((Me%Size%IUB - Me%Size%ILB) / ChunkIFactor, 1)
!Allocates Variables
call AllocateVariables ()
!Verifies User Options
OptionsType = "GlobalOptions"
call VerifyOptions(OptionsType)
!Constructs Coupled Modules
#ifdef _ENABLE_CUDA
call ConstructCoupledModules(Me%ObjCuda)
#else
call ConstructCoupledModules()
#endif _ENABLE_CUDA
!Checks property related options
if (Me%Coupled%RunoffProperties) then
WarningString = "PropertyOptions"
call VerifyOptions(WarningString)
endif
!Constructs the property list
call ConstructPropertyList
!Constructs Output Time Series
call ConstructTimeSeries
!Reads conditions from previous run
if (Me%Continuous) then
if (Me%OutPut%RestartFormat == BIN_) then
call ReadInitialFile_Bin
else if (Me%OutPut%RestartFormat == HDF_) then
call ReadInitialFile_Hdf
endif
endif
!Closes Data File
call KillEnterData (Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructBasin - ModuleBasin - ERR99'
!compute vegetation mass on top of foils
if (Me%Coupled%Vegetation) then
call CalculateVegTotalStoredMass
endif
!First HDF 5 Output
if (Me%Output%Yes) then
call HDF5OutPut
endif
!UnGets ExternalVars
UnLockToWhichModules = 'AllModules'
OptionsType = 'ConstructBasin'
call ReadUnLockExternalVar (UnLockToWhichModules, OptionsType)
STAT_ = SUCCESS_
else cd0
stop 'ModuleBasin - ConstructBasin - ERR99'
end if cd0
if (present(STAT)) STAT = STAT_
!----------------------------------------------------------------------
end subroutine ConstructBasin
!--------------------------------------------------------------------------
subroutine AllocateInstance
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
type (T_Basin), pointer :: NewObjBasin
type (T_Basin), pointer :: PreviousObjBasin
!----------------------------------------------------------------------
!Allocates new instance
allocate (NewObjBasin)
nullify (NewObjBasin%Next)
nullify (NewObjBasin%ExtUpdate%WaterLevel)
nullify (NewObjBasin%ExtUpdate%WaterColumn)
nullify (NewObjBasin%Output%OutTime)
nullify (NewObjBasin%Output%OutputChannels)
nullify (NewObjBasin%EVTPOutput%OutTime)
nullify (NewObjBasin%EVTPOutput%OutputChannels)
nullify (NewObjBasin%EVTPOutput2%OutTime)
nullify (NewObjBasin%EVTPOutput2%OutputChannels)
nullify (NewObjBasin%EVTPInstOutput%OutTime)
nullify (NewObjBasin%EVTPInstOutput%OutputChannels)
nullify (NewObjBasin%ExtVar%BasinPoints)
nullify (NewObjBasin%ExtVar%RiverPoints)
nullify (NewObjBasin%ExtVar%OpenPoints2D)
nullify (NewObjBasin%ExtVar%BoundaryPoints2D)
nullify (NewObjBasin%ExtVar%GridCellArea)
nullify (NewObjBasin%ExtVar%Topography )
!Insert New Instance into list and makes Current point to it
if (.not. associated(FirstObjBasin)) then
FirstObjBasin => NewObjBasin
Me => NewObjBasin
else
PreviousObjBasin => FirstObjBasin
Me => FirstObjBasin%Next
do while (associated(Me))
PreviousObjBasin => Me
Me => Me%Next
enddo
Me => NewObjBasin
PreviousObjBasin%Next => NewObjBasin
endif
Me%InstanceID = RegisterNewInstance (mBASIN_)
end subroutine AllocateInstance
!--------------------------------------------------------------------------
subroutine ReadFileNames
!Local-------------------------------------------------------------------
integer :: STAT_CALL
!------------------------------------------------------------------------
!Opens Basin data file
call ReadFileName('BASIN_DATA', Me%Files%ConstructData, &
Message = "Basin Data", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadFileNames - ModuleBasin - ERR010'
!Reads file name of the topographic file
call ReadFileName('IN_BASIN', Me%Files%TopographicFile, &
Message = "Topographic Data File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadFileNames - ModuleBasin - ERR020'
!Reads file name of the hdf outupt
call ReadFileName('BASIN_HDF', Me%Files%HDFFile, &
Message = "Basin HDF Output File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadFileNames - ModuleBasin - ERR030'
!Reads file name of final output file
call ReadFileName('BASIN_FIN', Me%Files%FinalFile, &
Message = "Basin Final File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadFileNames - ModuleBasin - ERR050'
end subroutine ReadFileNames
!--------------------------------------------------------------------------
subroutine ReadDataFile
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
integer :: STAT_CALL
integer :: iflag
real :: dummy
!Constructs the DataFile
call ConstructEnterData (Me%ObjEnterData, Me%Files%ConstructData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR010'
!Basin Initial Water Column
call GetData(dummy, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INITIAL_WATER_COLUMN', &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR01'
if (iflag /= 0) then
write(*,*)'The keyword INITIAL_WATER_COLUMN was moved to Module Runoff'
write(*,*)'Change the data files'
stop 'ReadDataFile - ModuleBasin - ERR01.5'
endif
!Continuous Computation
call GetData(Me%Continuous, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CONTINUOUS', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR040'
call GetData(Me%StopOnWrongDate, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'STOP_ON_WRONG_DATE', &
default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR050'
!Verify Global Mass
call GetData(Me%VerifyGlobalMass, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'VERIFY_MASS', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR060'
!Verify if do not exist negative values in atmospheric properties
!they may be causes of error that the user does not get aware
call GetData(Me%VerifyAtmosphereValues, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'VERIFY_ATMOSPHERE_VALUES', &
default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR061'
call GetData(Me%ComputeBasinWaterBalance, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'COMPUTE_WATER_BALANCE', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR062'
if (Me%ComputeBasinWaterBalance) then
!Gets TimeSerieLocationFile
call GetData(Me%Files%BWBTimeSeriesLocation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'TIME_SERIE_LOCATION_BWB', &
ClientModule = 'ModuleBasin', &
Default = Me%Files%ConstructData, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR063'
endif
!Calibrating 1D column?
call GetData(Me%Calibrating1D, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CALIBRATING_1D', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR070'
!How much to remove for the watercolumn
if (Me%Calibrating1D) then
call GetData(Me%WCRemovalTime, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'WC_REMOVE_TIME', &
default = 600., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR080'
endif
!DT During Rain
call GetData(Me%DTDuringRain, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'DT_DURING_RAIN', &
default = 60.0, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR090'
call GetData(Me%AdjustDTForRainEvent, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'ADJUST_DT_FOR_RAIN', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR091'
if (Me%AdjustDTForRainEvent) then
call GetData(Me%AdjustDTForRainEventFactor, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'ADJUST_DT_FOR_RAIN_FACTOR', &
default = 2.0, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR092'
endif
!Concentrate Rain for subhourly steps
call GetData(Me%ConcentrateRain, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CONCENTRATE_RAIN', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR100'
!How long does rain last...
if (Me%ConcentrateRain) then
call GetData(Me%RainAverageDuration, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'RAIN_AVERAGE_DURATION', &
default = 600.00, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR110'
if (1.5 * Me%RainAverageDuration + Me%DTDuringRain > 3600.0) then
write(*,*)'1.5 * RainAverageDuration + DT During Rain cannot exceed 3600s'
stop 'ReadDataFile - ModuleBasin - ERR0120'
endif
endif
!Imposes difuse sewage from a grid data
call GetData(Me%DiffuseWaterSource, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'DIFFUSE_WATER_SOURCE', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR130'
call GetData(Me%EvapMethod, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'EVAP_METHOD', &
default = ET0Method, & !ET0Method
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR140'
if (Me%EvapMethod .NE. NoEvaporation) then
!
call GetData(Me%EvapFromWaterColumn, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'EVAP_FROM_WATER_COLUMN', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR150'
!
call GetData(Me%EvapFromCanopy, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'EVAP_FROM_CANOPY', &
default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR160'
if ((.NOT. Me%EvapFromWaterColumn) .AND. (.NOT. Me%EvapFromCanopy)) then
Me%EvapMethod = NoEvaporation
endif
else
Me%EvapFromWaterColumn = .false.
Me%EvapFromCanopy = .false.
endif
if (Me%DiffuseWaterSource) then
call GetData(Me%FlowPerCapita, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'FLOW_PER_CAPITA', &
default = 0.0, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR170'
call GetData(Me%PopDensityFile, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'POPULATION_DENSITY', &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR180'
if (iflag == 0) then
write(*,*)'Population Density file not given - keyword POPULATION_DENSITY'
stop 'ReadDataFile - ModuleBasin - ERR98'
endif
endif
!Extinction Coeficient (relates LAI to covered fraction)
call GetData(Me%ExtinctionCoef, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'EXTINCTION_COEF', &
default = 0.6, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR190'
!Reads file name of initial condition file
if (Me%Continuous) then
call ReadFileName('BASIN_INI', Me%Files%InitialFile, &
Message = "Basin Initial File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR200'
endif
!Verifies if the user wants to use the Atmosphere Condition
call GetData(Me%Coupled%Atmosphere, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'ATMOSPHERE', &
default = ON, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR210'
!Verifies if the user wants to use the Irrigation Module
call GetData(Me%Coupled%Irrigation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'IRRIGATION', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR211'
!Verifies if the user wants to use the Atmosphere Condition
call GetData(Me%Coupled%Evapotranspiration, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'EVAPOTRANSPIRATION', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR220'
if (Me%Coupled%Evapotranspiration) then
!Verifies which method user wants for evapotranspiration (1-EvapoTranspiration
!2-Evaporation and Transpiration separated)
call GetData(Me%EvapoTranspirationMethod, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'EVAPOTRANSPIRATION_METHOD', &
default = SingleEvapotranspiration, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR230'
endif
if ((Me%EvapoTranspirationMethod .EQ. 1) .AND. (Me%EvapMethod .NE. NoEvaporation)) then
write(*,*)
write(*,*) 'If EVAPOTRANSPIRATION_METHOD = 1, then '
write(*,*) 'EVAP_METHOD must be set to 3 (NoEvaporation)'
stop 'ReadDataFile - ModuleBasin - ERR240'
endif
!Verifies if the user wants to simulate Infiltration
call GetData(Me%Coupled%PorousMedia, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'POROUS_MEDIA', &
default = ON, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR250'
if (Me%Coupled%PorousMedia) then
! verifies if the user wants to simulate transport of properties
call GetData(Me%Coupled%PorousMediaProperties, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'POROUS_MEDIA_PROPERTIES', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR260'
endif
!Verifies if the user wants to simulate OverLand RunOff
call GetData(Me%Coupled%RunOff, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'RUN_OFF', &
default = ON, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR270'
if (Me%Coupled%RunOff) then
!Verifies if the user wants to simulate OverLand RunOff propertie transport
call GetData(Me%Coupled%RunOffProperties, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'RUN_OFF_PROPERTIES', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR0280'
endif
!A Drainage Network is coupled?
call GetData(Me%Coupled%DrainageNetwork, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'DRAINAGE_NET', &
default = ON, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR290'
!The Vegetation Module is coupled_
call GetData(Me%Coupled%Vegetation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'VEGETATION', &
default = ON, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR300'
!The Reservoirs Module is coupled_
call GetData(Me%Coupled%Reservoirs, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'RESERVOIRS', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR305'
!Verifies if the user wants to use simple
call GetData(Me%Coupled%SimpleInfiltration, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SIMPLE_INFILTRATION', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR310'
if (Me%Coupled%SimpleInfiltration) then
call GetData(Me%SI%HoursToResetAccInf, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'HOURS_TO_RESET_ACC_INF', &
default = 24.0, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR310.1'
endif
!Verifies if the user wants to use simple
call GetData(Me%Coupled%SCSCNRunOffModel, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SCSCN_RUNOFF_MODEL', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR311'
if (Me%Coupled%SCSCNRunOffModel) then
call GetData(Me%SCSCNRunOffModel%IAFactor, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'IA_FACTOR', &
default = 0.2, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR311.0'
if (Me%SCSCNRunOffModel%IAFactor == 0.05) then
Me%SCSCNRunOffModel%ConvertIAFactor = .true.
else if (Me%SCSCNRunOffModel%IAFactor /= 0.2) then
stop 'ReadDataFile - ModuleBasin - ERR311.0.1'
else
Me%SCSCNRunOffModel%ConvertIAFactor = .false.
endif
call GetData(Me%SCSCNRunOffModel%CIDormThreshold, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SCSCN_CI_DORM_THRESHOLD', &
default = 12.7, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR311.1'
call GetData(Me%SCSCNRunOffModel%CIIIDormThreshold, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SCSCN_CIII_DORM_THRESHOLD', &
default = 27.94, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR311.2'
call GetData(Me%SCSCNRunOffModel%CIGrowthThreshold, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SCSCN_CI_GROWTH_THRESHOLD', &
default = 35.56, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR311.3'
call GetData(Me%SCSCNRunOffModel%CIIIGrowthThreshold, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SCSCN_CIII_GROWTH_THRESHOLD', &
default = 53.34, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR311.4'
endif
!Gets Output Time
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%CurrentTime, &
EndTime = Me%EndTime, &
keyword = 'OUTPUT_TIME', &
SearchType = FromFile, &
OutPutsTime = Me%OutPut%OutTime, &
OutPutsOn = Me%OutPut%Yes, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR320'
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%CurrentTime, &
EndTime = Me%EndTime, &
keyword = 'EVTP_OUTPUT_TIME', &
SearchType = FromFile, &
OutPutsTime = Me%EVTPOutPut%OutTime, &
OutPutsOn = Me%EVTPOutPut%Yes, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR330'
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%CurrentTime, &
EndTime = Me%EndTime, &
keyword = 'EVTP_OUTPUT_TIME2', &
SearchType = FromFile, &
OutPutsTime = Me%EVTPOutPut2%OutTime, &
OutPutsOn = Me%EVTPOutPut2%Yes, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR331'
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%CurrentTime, &
EndTime = Me%EndTime, &
keyword = 'EVTPINST_OUTPUT_TIME', &
SearchType = FromFile, &
OutPutsTime = Me%EVTPInstOutPut%OutTime, &
OutPutsOn = Me%EVTPInstOutPut%Yes, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR332'
!Output for restart
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%CurrentTime, &
EndTime = Me%EndTime, &
keyword = 'RESTART_FILE_OUTPUT_TIME', &
SearchType = FromFile, &
OutPutsTime = Me%OutPut%RestartOutTime, &
OutPutsOn = Me%OutPut%WriteRestartFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR340'
call GetData(Me%OutPut%RestartFormat, &
Me%ObjEnterData, &
iflag, &
SearchType = FromFile, &
keyword = 'RESTART_FILE_FORMAT', &
Default = BIN_, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR342'
if (Me%OutPut%RestartFormat /= BIN_ .and. Me%OutPut%RestartFormat /= HDF_) then
write (*,*)
write (*,*) 'RESTART_FILE_FORMAT options are: 1 - Binary or 2 - HDF'
stop 'ReadDataFile - ModuleBasin - ERR345'
endif
call GetData(Me%OutPut%RestartOverwrite, &
Me%ObjEnterData, &
iflag, &
SearchType = FromFile, &
keyword = 'RESTART_FILE_OVERWRITE', &
Default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR350'
!Gets TimeSerieLocationFile
call GetData(Me%Files%TimeSerieLocation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'TIME_SERIE_LOCATION', &
ClientModule = 'ModuleBasin', &
Default = Me%Files%ConstructData, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR360'
!Output daily flow values?
call GetData(Me%DailyFlow%On, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'DAILY_FLOW', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR370'
!Output monthly flow values?
call GetData(Me%MonthlyFlow%On, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'MONTHLY_FLOW', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR380'
!Verifies if the user wants to have snow melting
call GetData(Me%Coupled%Snow, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SNOW', &
default = OFF, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR390'
!Set a default value for Kc if LAI = 0
call GetData(Me%DefaultKcWhenLAI0, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'DEFAULT_KC_WHEN_LAI_ZERO', &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR400'
if (iflag .EQ. 0) then
Me%UseDefaultKcWhenLAI0 = .false.
else
Me%UseDefaultKcWhenLAI0 = .true.
endif
!Set a minimum value for Kc (for LAI = 0)
call GetData(Me%KcMin, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'KC_MIN', &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR410'
if (iflag .EQ. 0) then
Me%UseKcMin = .false.
else
Me%UseKcMin = .true.
endif
call GetData(Me%UseRefEVTPIfNeeded, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'USE_REF_EVTP_IF_NEEDED', &
default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR420'
call GetData(Me%ControlDTChanges, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'CONTROL_DT_CHANGES', &
default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR430'
call GetData(ChunkKFactor, &
Me%ObjEnterData, iflag, &
keyword = 'CHUNK_K_FACTOR', &
ClientModule = 'ModuleBasin', &
Default = ChunkKFactor, &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadDataFile - ModuleBasin - ERR440")
call GetData(ChunkJFactor, &
Me%ObjEnterData, iflag, &
keyword = 'CHUNK_I_FACTOR', &
ClientModule = 'ModuleBasin', &
Default = ChunkJFactor, &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadDataFile - ModuleBasin - ERR450")
call GetData(ChunkIFactor, &
Me%ObjEnterData, iflag, &
keyword = 'CHUNK_J_FACTOR', &
ClientModule = 'ModuleBasin', &
Default = ChunkIFactor, &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadDataFile - ModuleBasin - ERR460")
call GetData(Me%KCThresholds, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'KC_THRESHOLDS', &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR470'
if (iflag > 0) then
Me%UseKcThresholds = .true.
else
Me%UseKcThresholds = .false.
endif
call GetData(Me%Integration%Integrate, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INTEGRATION', &
Default = .false., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR480'
if (Me%Integration%Integrate) then
call GetData(Me%Integration%Interval, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INTEGRATION_INTERVAL', &
Default = 86400.0, &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR490'
Me%Integration%NextOutputTime = Me%BeginTime + Me%Integration%Interval
call GetData(Me%Integration%IntegrateTemperature, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INTEGRATE_TEMPERATURE', &
Default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR500'
call GetData(Me%Integration%IntegratePrecipitation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INTEGRATE_PRECIPITATION', &
Default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR500'
call GetData(Me%Integration%IntegrateEVTP, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INTEGRATE_EVTP', &
Default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR500'
call GetData(Me%Integration%IntegrateIrrigation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'INTEGRATE_IRRIGATION', &
Default = .true., &
ClientModule = 'ModuleBasin', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR500'
call GetData(Me%Files%IntegrationTimeSeriesLocation, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'TIME_SERIE_LOCATION_INT', &
ClientModule = 'ModuleBasin', &
Default = Me%Files%ConstructData, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR063'
endif
call GetData(Me%InternalDT%SyncDT, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'SYNC_DT', &
ClientModule = 'ModuleBasin', &
Default = 86400., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR700'
Me%InternalDT%NextDT = Me%InternalDT%SyncDT
write (*,*) "Basin internal DT: ", Me%InternalDT%SyncDT
call GetData(Me%InternalDT%MinDTThreshold, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'MIN_DT', &
ClientModule = 'ModuleBasin', &
Default = Me%InternalDT%MinDTThreshold, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleBasin - ERR700'
end subroutine ReadDataFile
!--------------------------------------------------------------------------
subroutine VerifyOptions (WarningString)
!Arguments-------------------------------------------------------------
character (Len = StringLength) :: WarningString
!Local-----------------------------------------------------------------
integer :: nProperties, STAT_CALL
integer :: iProp, PropID
logical :: PropAdvDiff, PropParticulate
!Begin-----------------------------------------------------------------
if (WarningString == "GlobalOptions") then
if (Me%Coupled%DrainageNetwork .and. .not. Me%Coupled%Runoff) then
write(*,*)'You must enable module Runoff if you want to use module Drainage Network'
stop 'VerifyOptions - ModuleBasin - ERR01'
endif
! if (Me%Coupled%PorousMedia .and. .not. Me%Coupled%Vegetation) then
! write(*,*)'You must enable module Vegetation if you want to use module Porous Media'
! stop 'VerifyOptions - ModuleBasin - ERR02'
! endif
!if (Me%Coupled%PorousMedia .and. Me%Coupled%SimpleInfiltration) then
! write(*,*)'You can not use SimpleInfiltration and PorousMedia at the same time'
! stop 'VerifyOptions - ModuleBasin - ERR03'
!endif
!if (Me%Coupled%PorousMedia .and. Me%Coupled%SCSCNRunOffModel) then
! write(*,*)'You can not use SCS CN RunOff model and PorousMedia at the same time'
! stop 'VerifyOptions - ModuleBasin - ERR03.1'
!endif
if (Me%Coupled%SimpleInfiltration .and. Me%Coupled%SCSCNRunOffModel) then
write(*,*)'You can not use SCS CN RunOff model and SimpleInfiltration at the same time'
stop 'VerifyOptions - ModuleBasin - ERR03.2'
endif
if (Me%Coupled%Vegetation) then
if (.not. Me%Coupled%PorousMedia .or. .not. Me%Coupled%Evapotranspiration) then
write(*,*)'You can not use Vegetation without PorousMedia or Evapotranspiration'
write(*,*)'Check basin data file'
stop 'VerifyOptions - ModuleBasin - ERR04'
endif
Me%ConstructTranspiration = .true.
if (Me%EvapoTranspirationMethod == SeparateEvapoTranspiration) then
Me%ConstructEvaporation = .true.
else
Me%ConstructEvaporation = .false.
endif
else
if(Me%EvapoTranspirationMethod == SeparateEvapoTranspiration) then
write(*,*)'If Vegetation is not used then the consistent Evapotranspiration_Method '
write(*,*)'is the default - without implicit transpiration computation.'
write(*,*)'Check basin data file'
stop 'VerifyOptions - ModuleBasin - ERR05'
endif
Me%ConstructTranspiration = .false.
if (Me%Coupled%Evapotranspiration) then
Me%ConstructEvaporation = .true.
else
Me%ConstructEvaporation = .false.
endif
endif
if (Me%Coupled%PorousMediaProperties) then
if(.not. Me%Coupled%RunoffProperties) then
write(*,*)'If using porous media properties also need runoff properties active '
write(*,*)'Check basin data file in RUN_OFF_PROPERTIES'
stop 'VerifyOptions - ModuleBasin - ERR06'
endif
endif
if (Me%Coupled%PorousMediaProperties .and. .not. Me%Coupled%PorousMedia) then
write(*,*)'If using porous media properties also need porous media active '
write(*,*)'Check basin data file in POROUS_MEDIA'
stop 'VerifyOptions - ModuleBasin - ERR07'
endif
if (Me%Coupled%RunoffProperties .and. .not. Me%Coupled%Runoff) then
write(*,*)'If using runoff properties also need runoff active '
write(*,*)'Check basin data file in RUN_OFF'
stop 'VerifyOptions - ModuleBasin - ERR08'
endif
if (Me%Coupled%PorousMedia .or. Me%Coupled%SimpleInfiltration .or. ME%Coupled%SCSCNRunOffModel) then
if (.not. Me%Coupled%Runoff) then
write(*,*)'If using Porous Media/simple Infiltration/SCS CN Run Off model than need to link RUN_OFF '
write(*,*)'Because Runoff is now the module responsible for the'
write(*,*)'water column. Module Basin is now only an updater'
stop 'VerifyOptions - ModuleBasin - ERR09'
endif
endif
if (Me%Coupled%Irrigation) then
if (.not. Me%Coupled%PorousMedia) then
write(*,*)'Irrigation module is set to be used, but PorousMedia is not.'
write(*,*)'In this case, only FixedIrrigation schedules can be used.'
endif
if (.not. Me%Coupled%Vegetation) then
write(*,*)'Irrigation module is set to be used, but Vegetation is not.'
write(*,*)'In this case, Root Depth must be set on Irrigation.'
endif
endif
if (Me%Coupled%Reservoirs .and. .not. Me%Coupled%DrainageNetwork) then
write(*,*)'You must enable module Drainage Network if you want to use module Reservoirs'
stop 'VerifyOptions - ModuleBasin - ERR09a'
endif
elseif (WarningString == "PropertyOptions") then
!!!Check if properties that have advection diffusion have it in all modules
!Checking with Runoff Properties
if (Me%Coupled%RunoffProperties) then
call GetRPnProperties (Me%ObjRunoffProperties, nProperties, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR10'
do iProp = 1, nProperties
call GetRPPropertiesIDByIdx(RunoffPropertiesID = Me%ObjRunoffProperties, &
Idx = iProp, &
ID = PropID, &
PropAdvDiff = PropAdvDiff, &
Particulate = PropParticulate, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR20'
!Check in PMP if the same dissolved properties also have advection diffusion connected
!Only dissolved properties can communicate with PMP
!~ if (PropAdvDiff .and. (.not. Check_Particulate_Property(PropID))) then
if (PropAdvDiff .and. (.not. PropParticulate)) then
if (Me%Coupled%PorousMediaProperties) then
call CheckPMPProperty (Me%ObjPorousMediaProperties, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR30'
endif
endif
!Check in DN if the same properties have advection diffusion connected
!Dissolved and particulate properties can communicate with DN
if (PropAdvDiff) then
if (Me%Coupled%DrainageNetwork) then
call CheckDNProperty(Me%ObjDrainageNetwork, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR40'
endif
endif
enddo
endif
!Now checking with PMP
if (Me%Coupled%PorousMediaProperties) then
call GetPMPnProperties (Me%ObjPorousMediaProperties, nProperties, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR50'
do iProp = 1, nProperties
call GetPMPPropertiesIDByIdx(PorousMediaPropertiesID = Me%ObjPorousMediaProperties, &
Idx = iProp, &
ID = PropID, &
PropAdvDiff = PropAdvDiff, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR60'
!Check in RP if the same properties also have advection diffusion connected
!Only Dissolved properties can communicate with RP but particulate props may not have adv-diff
if (PropAdvDiff) then
if (Me%Coupled%RunoffProperties) then
call CheckRPProperty (Me%ObjRunoffProperties, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR70'
endif
endif
!Check in DN if the same properties have advection diffusion connected
!Only Dissolved properties can communicate with DN but particulate props may not have adv-diff
if (PropAdvDiff) then
if (Me%Coupled%DrainageNetwork) then
call CheckDNProperty(Me%ObjDrainageNetwork, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR80'
endif
endif
enddo
endif
!Now checking with DN
if (Me%Coupled%DrainageNetwork) then
call GetDNnProperties (Me%ObjDrainageNetwork, nProperties, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR90'
do iProp = 1, nProperties
call GetDNPropertiesIDByIdx(DrainageNetworkID = Me%ObjDrainageNetwork, &
Idx = iProp, &
ID = PropID, &
PropAdvDiff = PropAdvDiff, &
Particulate = PropParticulate, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR100'
!Check in RP if the same properties also have advection diffusion connected
!Dissolved and particulate properties can communicate with RP
if (PropAdvDiff) then
if (Me%Coupled%RunoffProperties) then
call CheckRPProperty (Me%ObjRunoffProperties, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR110'
endif
endif
!Check in PMP if the same properties have advection diffusion connected
!Only dissolved properties can communicate with PMP
if (PropAdvDiff .and. (.not. PropParticulate)) then
!~ if (PropAdvDiff .and. (.not. Check_Particulate_Property(PropID))) then
if (Me%Coupled%PorousMediaProperties) then
call CheckPMPProperty (Me%ObjPorousMediaProperties, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR120'
endif
endif
!All DN propeties with advection diffusion need to be in Reservoirs
if (PropAdvDiff) then
if (Me%Coupled%Reservoirs) then
call CheckReservoirProperty (Me%ObjReservoirs, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR130'
endif
else
!if DN property has no advection diffusion cant exist in reservoirs
if (Me%Coupled%Reservoirs) then
call CheckReservoirProperty (Me%ObjReservoirs, PropID, STAT_CALL)
if (STAT_CALL == SUCCESS_) then
write(*,*)
write(*,*)'Found property', GetPropertyName(PropID)
write(*,*)'in Reservoirs Module but it has no advection diffusion in DN.'
stop 'VerifyOptions - ModuleBasin - ERR131'
endif
endif
endif
enddo
endif
!Now checking with Reservoirs
if (Me%Coupled%Reservoirs) then
!properties
call GetReservoirsnProperties (Me%ObjReservoirs, nProperties, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR140'
do iProp = 1, nProperties
call GetReservoirsPropertiesIDByIdx(ObjReservoirsID = Me%ObjReservoirs, &
Idx = iProp, &
ID = PropID, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR150'
!All reservoir properties must exist in DN
if (Me%Coupled%DrainageNetwork) then
call CheckDNProperty(Me%ObjDrainageNetwork, PropID, STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'VerifyOptions - ModuleBasin - ERR160'
endif
enddo
endif
endif
end subroutine VerifyOptions
!--------------------------------------------------------------------------
subroutine ConstructSimpleInfiltration
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
!
call ConstructOneProperty (Me%SI%Ks, "Ks", "<BeginKS>", "<EndKS>")
call ConstructOneProperty (Me%SI%MP, "MP", "<BeginMP>", "<EndMP>")
call ConstructOneProperty (Me%SI%ThetaS, "ThetaS", "<BeginThetaS>", "<EndThetaS>")
call ConstructOneProperty (Me%SI%ThetaI, "ThetaI", "<BeginThetaI>", "<EndThetaI>")
!call ConstructOneProperty (Me%SI%InfRate, "InfRate", "<BeginInfRate>", "<EndInfRate>")
!call ConstructOneProperty (Me%SI%AccInf, "AccInf", "<BeginAccInf>", "<EndAccInf>")
call ConstructOneProperty (Me%SI%ImpFrac, "ImpFrac", "<BeginImpFrac>", "<EndImpFrac>")
Me%SI%InfRate%ID%Name = "InfRate"
Me%SI%AccInf%ID%Name = "AccInf"
Me%SI%TimeWithNoWC%ID%Name = "NotPondedTime"
end subroutine ConstructSimpleInfiltration
!--------------------------------------------------------------------------
subroutine ConstructSCSCNRunOffModel
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
integer :: i, j
allocate(Me%SCSCNRunOffModel%InfRate%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SCSCNRunOffModel%InfRate%Field = FillValueReal
allocate(Me%SCSCNRunOffModel%VegGrowthStage%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
call ConstructOneProperty (Me%SCSCNRunOffModel%VegGrowthStage, "VegGrowthStage", &
"<BeginVegGrowthStage>", "<EndVegGrowthStage>")
allocate(Me%SCSCNRunOffModel%ImpFrac%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
call ConstructOneProperty (Me%SCSCNRunOffModel%ImpFrac, "ImpFrac", "<BeginImpFrac>", "<EndImpFrac>")
allocate(Me%SCSCNRunOffModel%CurveNumber%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
call ConstructOneProperty (Me%SCSCNRunOffModel%CurveNumber, "CurveNumber", "<BeginCurveNumber>", "<EndCurveNumber>")
!verify input
do j = Me%Size%JLB, Me%Size%JUB
do i = Me%Size%ILB, Me%Size%IUB
if (Me%ExtVar%BasinPoints(i,j) == BasinPoint) then
if (Me%SCSCNRunOffModel%CurveNumber%Field(i,j) < 30) then
write(*,*)
write(*,*)'CNII in cell',i,j
write(*,*)'is lower than 30. Please Correct it'
stop 'Module Basin - ConstructSCSCNRunOffModel - ERR01'
elseif (Me%SCSCNRunOffModel%CurveNumber%Field(i,j) > 98) then
write(*,*)
write(*,*)'CNII in cell',i,j
write(*,*)'is higher than 98. Please Correct it'
stop 'Module Basin - ConstructSCSCNRunOffModel - ERR02'
endif
endif
enddo
enddo
if (Me%SCSCNRunOffModel%ConvertIAFactor) then
where(Me%ExtVar%BasinPoints(:,:) == BasinPoint)
Me%SCSCNRunOffModel%CurveNumber%Field(:,:) = 100.0 &
/ (1.879 * (100.0 / Me%SCSCNRunOffModel%CurveNumber%Field(:,:) - 1.0)**1.15 + 1.0)
end where
endif
Me%SCSCNRunOffModel%NextRainAccStart = Me%BeginTime + 86400
allocate (Me%SCSCNRunOffModel%Last5DaysAccRain (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB, 1:5))
Me%SCSCNRunOffModel%Last5DaysAccRain = 0.0
allocate (Me%SCSCNRunOffModel%Last5DaysAccRainTotal (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SCSCNRunOffModel%Last5DaysAccRainTotal = 0.0
allocate (Me%SCSCNRunOffModel%DailyAccRain (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SCSCNRunOffModel%DailyAccRain = 0.0
allocate (Me%SCSCNRunOffModel%Current5DayAccRain (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SCSCNRunOffModel%Current5DayAccRain = 0.0
allocate (Me%SCSCNRunOffModel%ActualCurveNumber (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SCSCNRunOffModel%ActualCurveNumber = Me%SCSCNRunOffModel%CurveNumber%Field
allocate (Me%SCSCNRunOffModel%S (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SCSCNRunOffModel%S = 0.0
end subroutine ConstructSCSCNRunOffModel
!--------------------------------------------------------------------------
subroutine ConstructOneProperty (NewProperty, PropertyName, BlockBegin, BlockEnd)
!Arguments-------------------------------------------------------------
type (T_PropertyB) :: NewProperty
character(Len=*) :: PropertyName, BlockBegin, BlockEnd
!Local-----------------------------------------------------------------
integer :: ClientNumber
logical :: BlockFound
integer :: FirstLine, LastLine
integer :: STAT_CALL
call RewindBuffer(Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructOneProperty - ModuleBasin - ERR01'
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
BlockBegin, BlockEnd, BlockFound, &
FirstLine, LastLine, STAT_CALL)
if (STAT_CALL /= SUCCESS_) then
write(*,*)BlockBegin, BlockEnd
write(*,*)BlockFound
write(*,*)STAT_CALL
stop 'ConstructOneProperty - ModuleBasin - ERR02'
endif
if (.not. BlockFound) then
write(*,*)"Block : ",BlockBegin, " ", BlockEnd, " missing."
stop 'ConstructOneProperty - ModuleBasin - ERR03'
endif
!Construct property ID
NewProperty%ID%Name = PropertyName
!call ConstructPropertyID (NewProperty%ID, Me%ObjEnterData, FromBlock)
call ConstructFillMatrix(PropertyID = NewProperty%ID, &
EnterDataID = Me%ObjEnterData, &
TimeID = Me%ObjTime, &
HorizontalGridID = Me%ObjHorizontalGrid, &
ExtractType = FromBlock, &
PointsToFill2D = Me%ExtVar%BasinPoints, &
Matrix2D = NewProperty%Field, &
TypeZUV = TypeZ_, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructOneProperty - ModuleBasin - ERR04'
if (.not. NewProperty%ID%SolutionFromFile) then
call KillFillMatrix (NewProperty%ID%ObjFillMatrix, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructOneProperty - ModuleBasin - ERR05'
endif
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructOneProperty - ModuleBasin - ERR06'
end subroutine ConstructOneProperty
!--------------------------------------------------------------------------
subroutine ConstructDiffuseWaterSource
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
integer :: STAT_CALL
integer :: ObjGD, i, j
real, dimension(:,:), pointer :: PopDensity
!Starts a GridData on PopDensity
ObjGD = 0
call ConstructGridData (ObjGD, Me%ObjHorizontalGrid, FileName = Me%PopDensityFile, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructDiffuseWaterSource - ModuleBasin - ERR10'
call GetGridData (ObjGD, PopDensity, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructDiffuseWaterSource - ModuleBasin - ERR20'
do j = Me%Size%JLB, Me%Size%JUB
do i = Me%Size%ILB, Me%Size%IUB
if (Me%ExtVar%RiverPoints(i, j) == 1) then
Me%DiffuseFlow(i, j) = PopDensity(i, j) * Me%FlowPerCapita * Me%ExtVar%GridCellArea(i, j)
endif
enddo
enddo
call UnGetGridData (ObjGD, PopDensity, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructDiffuseWaterSource - ModuleBasin - ERR30'
call KillGridData (ObjGD, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructDiffuseWaterSource - ModuleBasin - ERR40'
end subroutine ConstructDiffuseWaterSource
!--------------------------------------------------------------------------
subroutine ConstructHDF5Output
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
integer :: ILB, IUB, JLB, JUB
integer :: STAT_CALL
integer :: HDF5_CREATE
!------------------------------------------------------------------------
!Bounds
ILB = Me%WorkSize%ILB
IUB = Me%WorkSize%IUB
JLB = Me%WorkSize%JLB
JUB = Me%WorkSize%JUB
if (Me%Coupled%DrainageNetwork) then
allocate(Me%OutPut%OutputChannels(Me%Size%ILB:Me%Size%IUB, Me%Size%JLB:Me%Size%JUB))
endif
Me%OutPut%NextOutPut = 1
call GetHDF5FileAccess (HDF5_CREATE = HDF5_CREATE)
!Opens HDF File
call ConstructHDF5 (Me%ObjHDF5, trim(Me%Files%HDFFile)//"5", HDF5_CREATE, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleBasin - ERR02'
!Write the Horizontal Grid
call WriteHorizontalGrid(Me%ObjHorizontalGrid, Me%ObjHDF5, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleBasin - ERR02'
!Sets limits for next write operations
call HDF5SetLimits (Me%ObjHDF5, ILB, IUB, JLB, JUB, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleBasin - ERR05'
!Writes the Grid
call HDF5WriteData (Me%ObjHDF5, "/Grid", "Bathymetry", "m", &
Array2D = Me%ExtVar%Topography, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleRunOff - ERR05'
!WriteBasinPoints
call HDF5WriteData (Me%ObjHDF5, "/Grid", "BasinPoints", "-", &
Array2D = Me%ExtVar%BasinPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleBasin - ERR07'
!WriteBasinPoints
call HDF5WriteData (Me%ObjHDF5, "/Grid", "RiverPoints", "-", &
Array2D = Me%ExtVar%RiverPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleBasin - ERR07'
!Flushes All pending HDF5 commands
call HDF5FlushMemory (Me%ObjHDF5, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructHDF5Output - ModuleBasin - ERR08'
end subroutine ConstructHDF5Output
!--------------------------------------------------------------------------
subroutine ConstructTimeSeries
!External--------------------------------------------------------------
character(len=StringLength), dimension(:), pointer :: PropertyList
integer :: STAT_CALL
integer :: nProperties, ColNumber
real, dimension(6), target :: AuxTime
integer :: i, AuxInt
character(PathLength) :: AuxChar
integer :: TimeSerieNumber, dn, Id, Jd
real :: CoordX, CoordY
logical :: CoordON, IgnoreOK
character(len=StringLength) :: TimeSerieName
type (T_BasinProperty), pointer :: PropertyX
!Begin------------------------------------------------------------------
!Basin Water Balance====================================================
if (Me%ComputeBasinWaterBalance) then
!Time Serie for BASIN WATER BALANCE (BWB)
allocate(PropertyList(39))
allocate(Me%BWBBuffer(39))
PropertyList(1) = "Rain_m3"
PropertyList(2) = "Irrigation_m3"
PropertyList(3) = "SnowMelting_m3"
PropertyList(4) = "DischargesOnSoil_m3"
PropertyList(5) = "DischargesOnSurface_m3"
PropertyList(6) = "DischargesOnChannels_m3"
PropertyList(7) = "InitialStoredInSoil_m3"
PropertyList(8) = "FinalStoredInSoil_m3"
PropertyList(9) = "StoredInSoil_m3"
PropertyList(10) = "InitialStoredInChannels_m3"
PropertyList(11) = "FinalStoredInChannels_m3"
PropertyList(12) = "StoredInChannels_m3"
PropertyList(13) = "InitialStoredInStormWater_m3"
PropertyList(14) = "FinalStoredInStormWater_m3"
PropertyList(15) = "StoredInStormWater_m3"
PropertyList(16) = "InitialStoredInLeaves_m3"
PropertyList(17) = "FinalStoredInLeaves_m3"
PropertyList(18) = "StoredInLeaves_m3"
PropertyList(19) = "InitialStoredInSurface_m3"
PropertyList(20) = "FinalStoredInSurface_m3"
PropertyList(21) = "StoredInSurface_m3"
PropertyList(22) = "OutletFlowVolume_m3"
PropertyList(23) = "EvaporationFromSoil_m3"
PropertyList(24) = "EvaporationFromLeaves_m3"
PropertyList(25) = "EvaporationFromChannels_m3"
PropertyList(26) = "EvaporationFromSurface_m3"
PropertyList(27) = "Transpiration_m3"
PropertyList(28) = "BoundaryFromSoil_m3"
PropertyList(29) = "BoundaryFromSurface_m3"
PropertyList(30) = "Input_m3"
PropertyList(31) = "Discharges_m3"
PropertyList(32) = "Output_m3"
PropertyList(33) = "Stored_m3"
PropertyList(34) = "Boundary_m3"
PropertyList(35) = "Error_m3"
PropertyList(36) = "AccumulatedError_m3"
PropertyList(37) = "Error_%"
PropertyList(38) = "NumberOfBasinCells"
PropertyList(39) = "BasinArea_m2"
!PropertyList(38) = "HDFAccEVTP_m3"
call StartTimeSerie(Me%ObjBWB, Me%ObjTime, &
Me%Files%BWBTimeSeriesLocation, &
PropertyList, "srbx", &
ResultFileName = 'Basin Water Balance', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR01'
deallocate(PropertyList)
endif
!End of Basin Water Balance==============================================
!Basin Integration=======================================================
if (Me%Integration%Integrate) then
i = 0
if (Me%Integration%IntegratePrecipitation) i = i + 1
if (Me%Integration%IntegrateTemperature) i = i + 1
if (Me%Integration%IntegrateEVTP) i = i + 3
if (Me%Integration%IntegrateIrrigation) i = i + 1
allocate(PropertyList(i))
allocate(Me%Integration%Buffer(i))
Me%Integration%Buffer = 0.0
i = 0
if (Me%Integration%IntegratePrecipitation) then
i = i + 1
PropertyList(i) = "Precipitation_mm"
endif
if (Me%Integration%IntegrateTemperature) then
i = i + 1
PropertyList(i) = "AvgTemperature_C"
endif
if (Me%Integration%IntegrateEVTP) then
i = i + 1
PropertyList(i) = "ReferenceEVTP_mm"
i = i + 1
PropertyList(i) = "CropEVTP_mm"
i = i + 1
PropertyList(i) = "ActualEVTP_mm"
endif
if (Me%Integration%IntegrateIrrigation) then
i = i + 1
PropertyList(i) = "Irrigation_mm"
endif
call StartTimeSerie(Me%Integration%ObjTimeSeries, Me%ObjTime, &
Me%Files%IntegrationTimeSeriesLocation, &
PropertyList, "srbx", &
ResultFileName = 'Integration', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR02'
deallocate(PropertyList)
endif
!End of Basin Water Balance==============================================
!Time Serie of properties variable in the Basin
i = 7
if (Me%Coupled%SCSCNRunoffModel) then
i = i + 2
endif
if (Me%Coupled%Vegetation) then
i = i + 4
if (Me%EvapoTranspirationMethod == SeparateEvapoTranspiration) then
i = i + 4
endif
PropertyX => Me%FirstProperty
do while (associated (PropertyX))
if (PropertyX%Inherited) then
i = i + 2
endif
PropertyX => PropertyX%Next
enddo
endif
if (Me%Coupled%Evapotranspiration) then
i = i + 1
endif
if (Me%Coupled%Snow) then
i = i + 1
endif
allocate(PropertyList(i))
PropertyList(1) = 'water column [m]'
PropertyList(2) = 'water level [m]'
PropertyList(3) = 'Infil. Rate [mm/hour]'
PropertyList(4) = 'Precipitation Rate [mm/hour]'
PropertyList(5) = 'Throughfall Rate [mm/hour]'
PropertyList(6) = 'EvapoTranspiration Rate [mm/hour]'
PropertyList(7) = 'Water Column Removed [m]'
i = 8
if (Me%Coupled%SCSCNRunoffModel) then
PropertyList(i) = 'Actual Curve Vumber [-]'
i = i + 1
PropertyList(i) = '5 Day Accumulated Rain [mm]'
i = i + 1
endif
if (Me%Coupled%Vegetation) then
PropertyList(i) = 'Canopy Capacity [m]'
i = i + 1
PropertyList(i) = 'Canopy Storage [m]'
i = i + 1
PropertyList(i) = 'Canopy Drainage [m]'
i = i + 1
PropertyList(i) = 'Potential Crop EVTP [mm/h]'
i = i + 1
if (Me%EvapoTranspirationMethod == SeparateEvapoTranspiration) then
PropertyList(i) = 'Potential Evaporation [mm/h]'
i = i + 1
PropertyList(i) = 'Potential Transpiration [mm/h]'
i = i +1
PropertyList(i) = 'Actual Evaporation [mm/h]'
i = i + 1
PropertyList(i) = 'Actual Transpiration [mm/h]'
i = i +1
endif
PropertyX => Me%FirstProperty
do while (associated (PropertyX))
if (PropertyX%Inherited) then
PropertyList(i) = 'Leaf Conc '//trim(PropertyX%ID%Name)//'[mg/l]'
i = i + 1
PropertyList(i) = 'Leaf Mass '//trim(PropertyX%ID%Name)//'[g]'
i = i + 1
endif
PropertyX => PropertyX%Next
enddo
endif
if (Me%Coupled%Evapotranspiration) then
PropertyList(i) = 'Reference Evapotranspiration [mm/h]'
i = i + 1
endif
if (Me%Coupled%Snow) then
PropertyList(i) = 'Snow Melting Rate [mm/h]'
i = i + 1
endif
call StartTimeSerie(Me%ObjTimeSerie, Me%ObjTime, &
Me%Files%TimeSerieLocation, &
PropertyList, "srb", &
WaterPoints2D = Me%ExtVar%BasinPoints, &
ModelName = Me%ModelName, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR03'
deallocate(PropertyList)
if (Me%VerifyGlobalMass) then
!Time Serie of water error integrated for the basin
allocate(PropertyList(26))
PropertyList(1) = "Initial_Volume_Runoff_m3"
PropertyList(2) = "Initial_Volume_Vegetation_m3"
PropertyList(3) = "Initial_Volume_PorousMedia_m3"
PropertyList(4) = "Initial_Volume_Channels_m3"
PropertyList(5) = "Evap_From_Vegetation_m3"
PropertyList(6) = "Evap_From_Ground_m3"
PropertyList(7) = "Evap_From_Soil_m3"
PropertyList(8) = "Rain_Above_Leafs_m3"
PropertyList(9) = "Rain_Uncovered_m3"
PropertyList(10) = "Rain_Covered_m3"
PropertyList(11) = "Leaf_Drainage_m3"
PropertyList(12) = "Rain_Below_Leafs_m3"
PropertyList(13) = "Out_Volume_Channel_m3"
PropertyList(14) = "Out_Volume_Overland_m3"
PropertyList(15) = "Final_Volume_Runof_m3"
PropertyList(16) = "Final_Volume_Vegetation_m3"
PropertyList(17) = "Final_Volume_PorousMedia_m3"
PropertyList(18) = "Final_Volume_Channels_m3"
PropertyList(19) = "Volume_Error_Ratio_Global"
PropertyList(20) = "Volume_Error_Ratio_Runoff"
PropertyList(21) = "Volume_Error_Ratio_Porous"
PropertyList(22) = "Volume_Error_Ratio_DNet"
PropertyList(23) = "Volume_Error_Ratio_Veg"
PropertyList(24) = "Infiltration_m3"
PropertyList(25) = "OL_Volume_To_Channels_m3"
PropertyList(26) = "GW_Volume_To_Channels_m3"
call StartTimeSerie(Me%ObjTimeSerieBasin, Me%ObjTime, &
Me%Files%TimeSerieLocation, &
PropertyList, "srb", &
ResultFileName = 'Basin Water Error', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR010'
deallocate(PropertyList)
!Time Serie of properties mass balance integrated for the basin
if (Me%Coupled%RunoffProperties) then
nProperties = 0
PropertyX => Me%FirstProperty
do while (associated(PropertyX))
if (PropertyX%AdvectionDiffusion .and. PropertyX%Inherited) then
nProperties = nProperties + 1
endif
PropertyX => PropertyX%Next
enddo
! if (Me%Coupled%Evapotranspiration) then
! nProperties = nProperties - 1
! endif
!23 outputs per property
allocate(PropertyList(nProperties * 23))
allocate (Me%TimeSeriesBuffer3(nProperties * 23))
ColNumber = 1
PropertyX => Me%FirstProperty
do while (associated(PropertyX))
if (PropertyX%AdvectionDiffusion) then
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Initial_Mass_Runoff_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Initial_Mass_Vegetation_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Initial_Mass_PorousMedia_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Initial_Mass_Channels_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Transp_Mass_From_Soil_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Rain_Mass_In_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Rain_Mass_UnCovered_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Rain_Mass_Covered_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" LeafDrainage_Mass_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Drainage+Uncovered_Mass_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Out_Mass_Channel_kg"
ColNumber = ColNumber + 1
! PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Out_Mass_Overland_kg"
! ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Final_Mass_Runoff_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Final_Mass_Vegetation_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Final_Mass_PorousMedia_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Final_Mass_Channels_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Mass_Error_Ratio_Global"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Mass_Error_Ratio_Runoff"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Mass_Error_Ratio_Porous"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Mass_Error_Ratio_DNet"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Mass_Error_Ratio_Veg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" Infiltration_Mass_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" OL_Mass_To_Channels_kg"
ColNumber = ColNumber + 1
PropertyList(ColNumber) = trim(PropertyX%ID%Name)//" GW_Mass_To_Channels_kg"
ColNumber = ColNumber + 1
endif
PropertyX => PropertyX%Next
enddo
call StartTimeSerie(Me%ObjTimeSerieBasinMass, Me%ObjTime, &
Me%Files%TimeSerieLocation, &
PropertyList, "srb", &
ResultFileName = 'Basin Mass Error', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR020'
deallocate(PropertyList)
endif
endif
call ExtractDate (Me%CurrentTime, AuxTime(1), AuxTime(2), &
AuxTime(3), AuxTime(4), &
AuxTime(5), AuxTime(6))
AuxChar = Me%Files%TimeSerieLocation
!Ouput of daily values
if (Me%DailyFlow%On) then
allocate(PropertyList(1))
PropertyList(1) = "Daily Flow [m3]"
AuxInt = 0
call StartTimeSerie(AuxInt, Me%ObjTime, &
AuxChar, &
PropertyList, "srb", &
ResultFileName = 'Daily Flow', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR04'
Me%DailyFlow%ObjTimeSerie = AuxInt
deallocate(PropertyList)
Me%DailyFlow%CurrentIndex = AuxTime(3)
endif
!Ouput of monthly values
if (Me%MonthlyFlow%On) then
allocate(PropertyList(1))
PropertyList(1) = "Monthly Flow [m3]"
AuxInt = 0
call StartTimeSerie(AuxInt, Me%ObjTime, &
AuxChar, &
PropertyList, "srb", &
ResultFileName = 'Monthly Flow', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSeries - ModuleBasin - ERR03'
deallocate(PropertyList)
Me%MonthlyFlow%ObjTimeSerie = AuxInt
Me%MonthlyFlow%CurrentIndex = AuxTime(2)
endif
!Corrects if necessary the cell of the time serie based in the time serie coordinates
call GetNumberOfTimeSeries(Me%ObjTimeSerie, TimeSerieNumber, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR03'
do dn = 1, TimeSerieNumber
call GetTimeSerieLocation(Me%ObjTimeSerie, dn, &
CoordX = CoordX, &
CoordY = CoordY, &
CoordON = CoordON, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR04'
call GetTimeSerieName(Me%ObjTimeSerie, dn, TimeSerieName, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR04'
i1: if (CoordON) then
call GetXYCellZ(Me%ObjHorizontalGrid, CoordX, CoordY, Id, Jd, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR05'
if (Id < 0 .or. Jd < 0) then
call TryIgnoreTimeSerie(Me%ObjTimeSerie, dn, IgnoreOK, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR06'
if (IgnoreOK) then
write(*,*) 'Time Serie outside the domain - ',trim(TimeSerieName),' - ',trim(Me%ModelName)
cycle
else
stop 'ConstructTimeSerie - ModuleBasin - ERR07'
endif
endif
call CorrectsCellsTimeSerie(Me%ObjTimeSerie, dn, Id, Jd, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR08'
endif i1
call GetTimeSerieLocation(Me%ObjTimeSerie, dn, &
LocalizationI = Id, &
LocalizationJ = Jd, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructTimeSerie - ModuleBasin - ERR09'
if (Me%ExtVar%BasinPoints(Id, Jd) /= WaterPoint) then
write(*,*) 'Time Serie in a land cell - ',trim(TimeSerieName),' - ',trim(Me%ModelName)
endif
enddo
end subroutine ConstructTimeSeries
!--------------------------------------------------------------------------
subroutine ConstructEVTPHDFOutput
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
integer :: ILB, IUB, JLB, JUB
integer :: STAT_CALL
integer :: HDF5_CREATE
!------------------------------------------------------------------------
!Reads file name of the EVTP hdf outupt
if (Me%EVTPOutput%Yes) then
call ReadFileName('BASIN_EVTPHDF', Me%Files%EVTPHDFFile, &
Message = "Basin EVTPHDF Output File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR010'
!Bounds
ILB = Me%WorkSize%ILB
IUB = Me%WorkSize%IUB
JLB = Me%WorkSize%JLB
JUB = Me%WorkSize%JUB
Me%EVTPOutPut%NextOutPut = 1
call GetHDF5FileAccess (HDF5_CREATE = HDF5_CREATE)
!Opens HDF File
call ConstructHDF5 (Me%ObjEVTPHDF, trim(Me%Files%EVTPHDFFile)//"5", HDF5_CREATE, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR020'
!Write the Horizontal Grid
call WriteHorizontalGrid(Me%ObjHorizontalGrid, Me%ObjEVTPHDF, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR030'
!Sets limits for next write operations
call HDF5SetLimits (Me%ObjEVTPHDF, ILB, IUB, JLB, JUB, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR040'
!Writes the Grid
call HDF5WriteData (Me%ObjEVTPHDF, "/Grid", "Bathymetry", "m", &
Array2D = Me%ExtVar%Topography, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR050'
!WriteBasinPoints
call HDF5WriteData (Me%ObjEVTPHDF, "/Grid", "BasinPoints", "-", &
Array2D = Me%ExtVar%BasinPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR060'
!Flushes All pending HDF5 commands
call HDF5FlushMemory (Me%ObjEVTPHDF, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR070'
endif
!Reads file name of the EVTP 2 hdf outupt
if (Me%EVTPOutput2%Yes) then
call ReadFileName('BASIN_EVTPHDF2', Me%Files%EVTPHDFFile2, &
Message = "Basin EVTPHDF2 Output File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR011'
!Bounds
ILB = Me%WorkSize%ILB
IUB = Me%WorkSize%IUB
JLB = Me%WorkSize%JLB
JUB = Me%WorkSize%JUB
Me%EVTPOutPut2%NextOutPut = 1
call GetHDF5FileAccess (HDF5_CREATE = HDF5_CREATE)
!Opens HDF File
call ConstructHDF5 (Me%ObjEVTPHDF2, trim(Me%Files%EVTPHDFFile2)//"5", HDF5_CREATE, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR021'
!Write the Horizontal Grid
call WriteHorizontalGrid(Me%ObjHorizontalGrid, Me%ObjEVTPHDF2, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR031'
!Sets limits for next write operations
call HDF5SetLimits (Me%ObjEVTPHDF2, ILB, IUB, JLB, JUB, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR041'
!Writes the Grid
call HDF5WriteData (Me%ObjEVTPHDF2, "/Grid", "Bathymetry", "m", &
Array2D = Me%ExtVar%Topography, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR051'
!WriteBasinPoints
call HDF5WriteData (Me%ObjEVTPHDF2, "/Grid", "BasinPoints", "-", &
Array2D = Me%ExtVar%BasinPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR061'
!Flushes All pending HDF5 commands
call HDF5FlushMemory (Me%ObjEVTPHDF2, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR071'
endif
!Reads file name of the EVTP Instanteneous hdf outupt
if (Me%EVTPInstOutput%Yes) then
call ReadFileName('BASIN_EVTP_INST_HDF', Me%Files%EVTPInstHDFFile, &
Message = "Basin EVTP Instantaneous HDF Output File", STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR012'
!Bounds
ILB = Me%WorkSize%ILB
IUB = Me%WorkSize%IUB
JLB = Me%WorkSize%JLB
JUB = Me%WorkSize%JUB
Me%EVTPInstOutPut%NextOutPut = 1
call GetHDF5FileAccess (HDF5_CREATE = HDF5_CREATE)
!Opens HDF File
call ConstructHDF5 (Me%ObjEVTPInstHDF, trim(Me%Files%EVTPInstHDFFile)//"5", HDF5_CREATE, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR022'
!Write the Horizontal Grid
call WriteHorizontalGrid(Me%ObjHorizontalGrid, Me%ObjEVTPInstHDF, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR032'
!Sets limits for next write operations
call HDF5SetLimits (Me%ObjEVTPInstHDF, ILB, IUB, JLB, JUB, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR042'
!Writes the Grid
call HDF5WriteData (Me%ObjEVTPInstHDF, "/Grid", "Bathymetry", "m", &
Array2D = Me%ExtVar%Topography, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR052'
!WriteBasinPoints
call HDF5WriteData (Me%ObjEVTPInstHDF, "/Grid", "BasinPoints", "-", &
Array2D = Me%ExtVar%BasinPoints, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR062'
!Flushes All pending HDF5 commands
call HDF5FlushMemory (Me%ObjEVTPInstHDF, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ConstructEVTPHDFOutput - ModuleBasin - ERR072'
endif
end subroutine ConstructEVTPHDFOutput
!--------------------------------------------------------------------------
subroutine AllocateVariables
!Arguments-------------------------------------------------------------
!Local-----------------------------------------------------------------
integer :: ILB, IUB, JLB, JUB
! integer :: i, j
!Bounds
ILB = Me%WorkSize%ILB
IUB = Me%WorkSize%IUB
JLB = Me%WorkSize%JLB
JUB = Me%WorkSize%JUB
allocate(Me%ExtUpdate%WaterLevel (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%ExtUpdate%WaterColumn (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%ExtUpdate%WaterColumnOld (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%WaterColumnRemoved (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CanopyDrainage (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
if (Me%Coupled%Vegetation) then
allocate(Me%RainCovered (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CanopyStorageCapacity (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CanopyStorage (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CanopyStorageOld (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CoveredFraction (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CoveredFractionOld (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%CropEvapotrans (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
if (Me%EvapoTranspirationMethod == SeparateEvapoTranspiration) then
allocate(Me%PotentialTranspiration (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PotentialEvaporation (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
endif
endif
if (Me%Coupled%Snow) then
allocate(Me%SnowMeltingRate (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccSnowMelting (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SnowMeltingRate = 0.0
Me%AccSnowMelting = 0.0
endif
allocate(Me%ThroughFall (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%RainUncovered (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PotentialInfCol (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%FlowProduction (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%InfiltrationRate (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PrecipRate (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%ThroughRate (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%EVTPRate (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccInfiltration (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccFlowProduction (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccEVTP (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccRainFall (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccEVPCanopy (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%AccRainHour (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%RainStartTime (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%RainDuration (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%WaterColumnEvaporated (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
if (Me%Coupled%Evapotranspiration) then
if (Me%EVTPOutput%Yes) then
allocate(Me%PartialAccEVTP (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccEVTPRef (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%PartialAccEVTP = 0.0
Me%PartialAccEVTPRef = 0.0
if (Me%Coupled%Vegetation) then
allocate(Me%PartialAccEVTPCrop (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%PartialAccEVTPCrop = 0.0
endif
if (Me%EvapoTranspirationMethod .eq. SeparateEvapoTranspiration) then
allocate(Me%PartialAccEVPot (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccEVAct (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccETPot (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccETAct (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%PartialAccEVPot = 0.0
Me%PartialAccEVAct = 0.0
Me%PartialAccETPot = 0.0
Me%PartialAccETAct = 0.0
endif
endif
if (Me%EVTPOutput2%Yes) then
allocate(Me%PartialAccEVTP2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccEVTPRef2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%PartialAccEVTP2 = 0.0
Me%PartialAccEVTPRef2 = 0.0
if (Me%Coupled%Vegetation) then
allocate(Me%PartialAccEVTPCrop2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%PartialAccEVTPCrop2 = 0.0
endif
if (Me%EvapoTranspirationMethod .eq. SeparateEvapoTranspiration) then
allocate(Me%PartialAccEVPot2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccEVAct2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccETPot2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%PartialAccETAct2 (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%PartialAccEVPot2 = 0.0
Me%PartialAccEVAct2 = 0.0
Me%PartialAccETPot2 = 0.0
Me%PartialAccETAct2 = 0.0
endif
endif
endif
!if (Me%Coupled%Snow) allocate(Me%SnowPack (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%TimeSeriesBuffer (26))
allocate(Me%TimeSeriesBuffer2 (1))
Me%ExtUpdate%WaterLevel = FillValueReal
Me%ExtUpdate%WaterColumn = FillValueReal
Me%ExtUpdate%WaterColumnOld = FillValueReal
if (Me%Coupled%Vegetation) then
Me%RainCovered = 0.0
Me%CanopyStorageCapacity = FillValueReal
Me%CanopyStorage = 0.0
Me%CanopyStorageOld = 0.0
Me%CoveredFraction = 0.0 !This variable was used before had value definition
Me%CoveredFractionOld = 0.0
Me%CropEvapotrans = 0.0
if (Me%EvapoTranspirationMethod == SeparateEvapoTranspiration) then
Me%PotentialTranspiration = 0.0
Me%PotentialEvaporation = 0.0
endif
endif
Me%ThroughFall = 0.0
Me%RainUncovered = 0.0
Me%WaterColumnRemoved = 0.0
Me%CanopyDrainage = 0.0
Me%InfiltrationRate = FillValueReal
Me%PrecipRate = FillValueReal
Me%ThroughRate = FillValueReal
Me%EVTPRate = FillValueReal
!Me%EVTPRate2 = FillValueReal
Me%AccInfiltration = 0.0
Me%AccFlowProduction = 0.0
Me%AccEVTP = 0.0
Me%AccRainFall = 0.0
Me%AccEVPCanopy = 0.0
Me%PotentialInfCol = 0.0
Me%FlowProduction = null_real
Me%WaterColumnEvaporated = 0.0
!if (Me%Coupled%Snow) Me%SnowPack = FillValueReal
if (Me%Coupled%SimpleInfiltration) then
allocate(Me%SI%Ks%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%MP%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%ThetaS%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%ThetaI%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%InfRate%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%AccInf%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%ImpFrac%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%SI%TimeWithNoWC%Field (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%SI%Ks%Field = FillValueReal
Me%SI%MP%Field = FillValueReal
Me%SI%ThetaS%Field = FillValueReal
Me%SI%ThetaI%Field = FillValueReal
Me%SI%InfRate%Field = FillValueReal
Me%SI%AccInf%Field = AllmostZero
Me%SI%ImpFrac%Field = FillValueReal
Me%SI%TimeWithNoWC%Field = 0.0
endif
if (Me%DiffuseWaterSource) then
allocate(Me%DiffuseFlow (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%DiffuseFlow = null_real
endif
if (Me%Integration%Integrate) then
!EVTP
if (Me%Coupled%Evapotranspiration) then
allocate(Me%Integration%EVTPRef (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%Integration%EVTPCrop (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
allocate(Me%Integration%EVTPActual (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%Integration%EVTPRef = 0.0
Me%Integration%EVTPCrop = 0.0
Me%Integration%EVTPActual = 0.0
else
Me%Integration%IntegrateEVTP = .false.
endif
!Precipitation/Temperature
if (Me%Coupled%Atmosphere) then
allocate(Me%Integration%Precipitation (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%Integration%Precipitation = 0.0
allocate(Me%Integration%Temperature (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%Integration%Temperature = 0.0
else
Me%Integration%IntegratePrecipitation = .false.
Me%Integration%IntegrateTemperature = .false.
endif
!Irrigation
if (Me%Coupled%Irrigation) then
allocate(Me%Integration%Irrigation (Me%Size%ILB:Me%Size%IUB,Me%Size%JLB:Me%Size%JUB))
Me%Integration%Irrigation = 0.0
else
Me%Integration%IntegrateIrrigation = .false.
endif
endif
end subroutine AllocateVariables
!--------------------------------------------------------------------------
subroutine ConstructCoupledModules( &
#ifdef _ENABLE_CUDA
ObjCudaID &
#endif _ENABLE_CUDA
)
!Arguments-------------------------------------------------------------
#ifdef _ENABLE_CUDA
integer :: ObjCudaID
#endif
!Local-----------------------------------------------------------------
integer :: STAT_CALL
!logical :: VariableDT
integer :: MapID
logical :: IgnoreWaterColumnOnEvap
logical :: IsConstant
real :: ConstantValue