Skip to content
Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
19717 lines (14621 sloc) 922 KB
!------------------------------------------------------------------------------
! IST/MARETEC, Water Modelling Group, Mohid modelling system
!------------------------------------------------------------------------------
!
! TITLE : Mohid Model
! PROJECT : Mohid Base 1
! MODULE : DrainageNetwork
! URL : http://www.mohid.com
! AFFILIATION : IST/MARETEC, Marine Modelling Group
! DATE : May 2003
! REVISION : Frank Braunschweig / Rosa Trancoso
! DESCRIPTION : Module which simulates a 1D Drainage Network System
!------------------------------------------------------------------------------
!
!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.
!
!------------------------------------------------------------------------------
!
! Keywords read in the Data File
!
! Keyword : Data Type Default !Comment
!
! NETWORK_FILE : char - !Path to drainage network file
! CHECK_NODES : 0/1 [1] !Ckeck nodes consistency
! CHECK_REACHES : 0/1 [1] !Check reaches consistency
! DISCHARGES : 0/1 [0] !Use module discharges (WWTP, etc)
! HYDRODYNAMIC_APROX : int [1] !1 - KinematicWave, 2 - DiffusionWave, 3 - DynamicWave
! NUMERICAL_SCHEME : int [0] !0 - ExplicitScheme, 1 - ImplicitScheme
! If ImplicitScheme ------------------------------------------------------------
! TIME_WEIGHT_FACTOR : real [0.7] !Factor de ponderacao do peso dos termos explicitos e implicitos
! RELAXATION_FACTOR
! MASS_ERR : real(8) [0.001] !Max error in mass conservation
! GLOBAL_MANNING : real - !Rugosity in Channels
! MIN_WATER_DEPTH : real [0.001] !Min water depth in nodes (For h < MIN_WATER_DEPTH water stops flowing)
! MIN_WATER_DEPTH_PROCESS : real [0.01] !Water Quality Process / Surface Fluxes shutdown
! INITIAL_WATER_DEPTH : real [0.0] !Initial water depth
! TRANSMISSION_LOSSES : 0/1 [0] !If user wants to use transmission losses
! HYDRAULIC_CONDUCTIVITY : real - !Hydraulic Conductivity to calculate transmission losses
! REMOVE_OVERTOP : 0/1 [0] !Removes Water if channels are overtoped
! STORM_WATER_MODEL_LINK : 0/1 [0] !If linked to a StormWaterModel
! MINIMUM_SLOPE : real [0.0] !Minimum Slope for Kinematic Wave
! STABILIZE : 0/1 [0] !Restart time iteration if high volume gradients
! STABILIZE_FACTOR : real [0.1] !max gradient in time steps as fraction of old volume
! MAX_ITERATIONS : int [100] !Max iterations for stabilized check
! DT_FACTOR : real [0.8] !Factor for DT Prediction
! MAX_DT_FLOOD : real [10.0] !Max DT if channel water level exceeds full bank
! AERATION_METHOD : int [-] !1 - PoolAndRifle, 2 - ChannelControled_
! T90_DECAY_MODEL : 0 [1] !0 - Constant, 1 - Canteras, 2 - Chapra
! T90 : real [7200.] !if T90_DECAY_MODEL = Constant
! SHADING_FACTOR : real [1.] !0-1 fraction of riparian shading
! FRACTION_SEDIMENT : 0/1 [0]
! GLOBAL_TOXICITY : char ['SUM'] !Global Toxicity Computation Method : SUM,MAX,RISKRATIO
! GEO_CONVERSATION_FACTOR : real [1.] !Lat to Meters rough estimation
! OUTPUT_TIME : int int... [-]
! DOWNSTREAM_BOUNDARY : int [1] !0 - Dam, 1 - ZDG, 2 - CD, 3 - ImposedWaterLevel, 4 - ImposedVelocity
! If ImposedWaterLevel--------------------------------------------------------
! FILE_IN_TIME : char [NONE] !NONE, TIMESERIE
! DEFAULT_VALUE : real - !Default value for water level at downstream boundary
! If FILE_IN_TIME = TIMESERIE---------------------------------------------
! FILENAME : char - !Name of timeserie file for the downstream boundary
! DATA_COLUMN : int - !Number of column with data
!
! TIME_SERIE_LOCATION : char - !Path to time serie especification nodes
! MAX_BUFFER_SIZE : 1000
! COMPUTE_RESIDUAL : 1
! DT_OUTPUT_TIME : 1200
! TIME_SERIE_BY_NODES : 0/1 [0] !Keyword to see if the user wants the time series to be written by
!nodes, i.e.,
!One file per node, with all variables in the headers list
!if FALSE, its one file per variable with nodes in the headers.
!<BeginNodeTimeSerie>
!NODE_ID : integer !Node ID to create TimeSeries
!NAME : char !Node Name that will appear in TimeSeries
! <EndNodeTimeSerie>
!<beginproperty>
! NAME : cohesive sediment
! UNITS : mg/L
! DESCRIPTION : cohesive sediment
! DEFAULTVALUE : 100.00
! MIN_VALUE : 0.0
! ADVECTION_DIFUSION : 1
! ADVECTION_SCHEME : 1 !Upwind
! DIFFUSION_SCHEME : 5 !CentralDif
! DIFFUSIVITY : 1E-8 !m2/s
! VIRTUAL_COEF : 0.01
! WATER_QUALITY : 0
! BENTHOS : 0
! MACROALGAE : 0
! DECAY_T90 : 0 !uses T90 decay model for fecal coliforms
! DECAY_GENERIC : 0 !uses generic decay (for now 1st order)
! [2] -
! TIME_SERIE : 1
!<endproperty>
!
!Network file ##################################################################
!
!<BeginNode>
! ID : int - !Node ID number
! COORDINATES : real real - !Node coordinates
! GRID_I : int - !I position of node, if grid
! GRID_J : int - !J position of node, if grid
! TERRAIN_LEVEL : real - !Bottom level of cross section
! MANNING_CHANNEL : real GLOBAL_MANNING !Node rugosity
! WATER_DEPTH : real INITIAL_WATER_DEPTH !Node initial water depth
! CROSS_SECTION_TYPE : int [1] !1 - Trapezoidal, 2 - TrapezoidalFlood, 3 - Tabular
! 1 - Trapezoidal, 2 - TrapezoidalFlood
! BOTTOM_WIDTH : real - !Bottom width of cross section
! TOP_WIDTH : real - !Top width of cross section
! HEIGHT : real - !Max height of cross section
! 2 - TrapezoidalFlood
! MIDDLE_WIDTH : real - !Middle width of cross section
! MIDDLE_HEIGHT : real - !Middle height of cross section
! 3 - Tabular
! N_STATIONS : integer - !number os stations that define the cross section
! STATION : real real ... - !station values
! ELEVATION/LEVEL : real real ... - !elevation values
! 4 - Culvert
! INVERT_LEVEL : real - !Invert Level of the Culvert
! DIAMETER : real
!<EndNode>
!<BeginReach>
! ID : int - !Reach ID Number
! DOWNSTREAM_NODE : int - !Downstream node ID
! UPSTREAM_NODE : int - !Upstream node ID
! ACTIVE : boolean - !Active Reach. If Inactive, no flow is calculated
!<EndReach>
!
! EcoToxicity model ################################################################
!
! Every toxic property must be discharged.
! Its concentration in the river network is set to 0.0.
! Discharge concentration must be equal to 1, because we are measuring the dilution
! D = 1 - C_new / C_ini
! the variable property%toxicity%concentration represents C/c_ini so it starts by being 1.
! This is not even close to a final version.
! For more details, or sugestions/corrections, contact Rosa.
Module ModuleDrainageNetwork
use ModuleGlobalData
use ModuleEnterData
use ModuleTime
use ModuleHDF5
use ModuleFunctions , only: InterpolateValueInTime, ConstructPropertyID, ComputeT90_Chapra, &
ComputeT90_Canteras, LongWaveDownward, LongWaveUpward, &
LatentHeat, SensibleHeat, OxygenSaturation, &
OxygenSaturationHenry, OxygenSaturationCeQualW2, AerationFlux, &
TimeToString, ChangeSuffix, DistanceBetweenTwoGPSPoints, &
LinearInterpolation, SetMatrixValue
use ModuleTimeSerie , only: StartTimeSerie, StartTimeSerieInput, WriteTimeSerieLine, &
GetTimeSerieValue, KillTimeSerie, WriteTimeSerieLineNow
use ModuleStopWatch , only: StartWatch, StopWatch
use ModuleDischarges , only: Construct_Discharges, GetDischargesNumber, GetDischargesNodeID, &
GetDischargeWaterFlow, GetDischargeConcentration, Kill_Discharges
use ModuleLightExtinction , only: ConstructLightExtinction, GetLightExtinctionOptions, &
GetRadiationPercentages, GetShortWaveExtinctionField, &
ModifyLightExtinctionField, UnGetLightExtinction, &
KillLightExtinction, GetLongWaveExtinctionCoef
use ModuleInterface , only: ConstructInterface, Modify_Interface, KillInterface, GetWQRatio, &
GetRateFlux, SetSOD
implicit none
private
!Subroutines---------------------------------------------------------------
!Constructor
public :: ConstructDrainageNetwork
private :: AllocateInstance
private :: ReadDataFile
private :: ConstructDownstreamBoundary
private :: ConstructNetwork
private :: ConstructNodeList
private :: CountTotalNodes
private :: ConstructNode
private :: InitializeTabularCrossSection
private :: ComputeExtraArea
private :: TrapezoidGeometry
private :: CheckNodesConsistency
private :: ConstructReachList
private :: CountTotalReaches
private :: ConstructReach
private :: CheckReachesConsistency
private :: CalculateReaches
private :: ConnectNetwork
private :: OrderNodes
private :: WriteOrderedNodes
private :: CountOutlets
private :: ConstructPropertyList
private :: ConstructProperty
private :: ConstructPropertyValues
private :: InitializeProperty
private :: Add_Property
private :: CheckSelectedProp
private :: InitializeVariables
!private :: ReadInitialFile
private :: InitializeNodes
private :: ComputeXSFromWaterDepth
private :: TabularGeometry
private :: InitializeReaches
private :: ConstructSubModules
private :: CoupleLightExtinction
private :: CoupleWaterQuality
private :: CoupleCEQUALW2
private :: CoupleBenthos
private :: CoupleMacroAlgae
private :: ConstructOutput
private :: ReadTimeSerieNodeList
private :: ConstructTimeSerieList
private :: ConstructTimeSeries
private :: FillPropNameVector
private :: ConstructHDF5Output
private :: ConstructLog
private :: FindNodePosition
private :: FindReachPosition
!Selector
public :: GetDrainageSize
public :: GetChannelsID
public :: GetChannelsWaterLevel
public :: GetChannelsVelocity
public :: GetChannelsBottomLevel
public :: GetChannelsSurfaceWidth
public :: GetChannelsBottomWidth
public :: GetChannelsBankSlope
public :: GetChannelsNodeLength
public :: GetChannelsVolume
public :: GetChannelsMaxVolume
public :: GetChannelsTopArea
public :: GetChannelsOpenProcess
public :: GetChannelsActiveState
public :: GetHasProperties
public :: GetDNnProperties
public :: GetDNPropertiesIDByIdx
public :: GetHasToxicity
public :: GetPropHasBottomFluxes
public :: GetNeedsRadiation
public :: GetNeedsAtmosphere
public :: GetNextDrainageNetDT
public :: GetVolumes
public :: GetDNStoredVolume
public :: GetDNConcentration
public :: GetDNMassBalance !To Basin get the property mass balance values
public :: CheckDNProperty
public :: UnGetDrainageNetwork
public :: SetAtmosphereDrainageNet !To be called from MOHID Land
public :: SetAtmosphereRiverNet !To be called from River Network
public :: SetPMPConcDN !DrainageNetwork gets the conc from Porous Media Properties
public :: SetRPConcDN !DrainageNetwork gets the conc from Runoff Properties
public :: SetGWFlowLayersToDN !DrainageNetwork gets the Porous Media layers limits for GWFlow (faster process)
private :: SearchProperty
public :: SetInflowFromReservoir !DrainageNetwork gets inflow from Reservoirs (Reservoirs outflow)
public :: GetOutflowToReservoir !Reservoirs gets outflow from DN (Reservoirs inflow)
public :: SetReservoirsConcDN !Drainage Network gets the Reservoir concentrations
public :: GetNodeConcReservoirs !Reservoirs get node conc before conc was zeroed
!Modifier
public :: FillOutPutMatrix
public :: ModifyDrainageNetwork
private :: ModifyDrainageNetLocal
private :: StoreInitialValues
private :: ModifyWaterDischarges
private :: ModifyWaterExchange
private :: ModifyTransmissionLosses
private :: UpdateAreasAndMappings
private :: UpdateCrossSections
private :: ComputeCrossSection
private :: TrapezoidWaterHeight
private :: TabularWaterLevel
private :: ModifyDownstreamTimeSerie
private :: UpdateReachCrossSection
private :: UpdateComputeFaces
private :: UpdateOpenPoints
private :: ModifyHydrodynamics
private :: ModifyReach
private :: ComputeCriticalFlow
private :: ComputeKinematicWave
private :: ComputeStVenant
private :: HydroAdvection
private :: ModifyNode
private :: ComputeNodeInFlow
private :: ComputeNodeOutFlow
private :: CheckStability
! private :: Cascade
private :: ResetToInitialValues
private :: TransportProperties
private :: Advection_Diffusion
private :: ComputeAdvection
private :: ComputeDiffusion
private :: SetLimitsConcentration
private :: ModifyTopRadiation
private :: ComputeSurfaceFluxes
private :: ColiformDecay
private :: ModifyToxicity
private :: ComputeToxicityForEachEffluent
private :: ModifyWaterQuality
private :: ModifyCEQUALW2
private :: ModifyBenthos
private :: ModifyMacroAlgae
private :: ComputeBottomFluxes
private :: ModifyShearStress
private :: ComputeErosionFluxes
private :: ComputeDepositionFluxes
private :: SettlingVelocity
private :: UpdateChannelsDynamicMatrix
private :: ComputeNextDT
private :: WriteTimeSeries
private :: WriteTimeSeriesByNodes
private :: WriteTimeSeriesByProp
private :: HDF5Output
private :: MaxStationValues
private :: CalculateLoad
private :: CalculateTSS
private :: CalculateVSS
!Destructor
public :: KillDrainageNetwork
private :: MaxStationValuesOutput
!private :: WriteFinalFile
private :: Write_Errors_Messages
!Management
private :: Ready
private :: LocateObjDrainageNetwork
!Interfaces----------------------------------------------------------------
interface ModifyDrainageNetwork
module procedure ModifyDrainageNetWithGrid
module procedure ModifyDrainageNetWithoutGrid
end interface
interface UnGetDrainageNetwork
module procedure UnGetDrainageNetworkR4
module procedure UnGetDrainageNetworkI4
module procedure UnGetDrainageNetworkA4
module procedure UnGetDrainageNetwork1DR4
end interface
!Parameters------------------------------------------------------------------------------------
character(StringLength), parameter :: BeginNode = '<BeginNode>'
character(StringLength), parameter :: EndNode = '<EndNode>'
character(StringLength), parameter :: BeginReach = '<BeginReach>'
character(StringLength), parameter :: EndReach = '<EndReach>'
character(StringLength), parameter :: BeginNodeTimeSerie = '<BeginNodeTimeSerie>'
character(StringLength), parameter :: EndNodeTimeSerie = '<EndNodeTimeSerie>'
character(StringLength), parameter :: BeginReachTimeSerie = '<BeginReachTimeSerie>'
character(StringLength), parameter :: EndReachTimeSerie = '<EndReachTimeSerie>'
character(LEN = StringLength), parameter :: block_begin = '<beginproperty>'
character(LEN = StringLength), parameter :: block_end = '<endproperty>'
!CrossSections
integer, parameter :: Trapezoidal = 1
integer, parameter :: TrapezoidalFlood = 2
integer, parameter :: Tabular = 3
integer, parameter :: Culvert = 4
!Culvert - section type
integer, parameter :: circular_area = 1
integer, parameter :: rectangular_area = 2
!DownstreamBoundary
integer, parameter :: Dam = 0
integer, parameter :: ZeroDepthGradient = 1
integer, parameter :: CriticalDepth = 2
integer, parameter :: ImposedWaterLevel = 3
integer, parameter :: ImposedVelocity = 4
integer, parameter :: Flow_vs_WaterLevel = 5
!HydrodynamicApproximation
integer, parameter :: KinematicWave = 1 !Manning com declive de fundo
integer, parameter :: DiffusionWave = 2 !Manning com declive de superficie
integer, parameter :: DynamicWave = 3 !Todos os termos de StVenant
!Toxicity Function types
integer, parameter :: Saturation = 1
integer, parameter :: Linear = 2
integer, parameter :: RiskRatio = 3
!Variable downstream boundary
integer, parameter :: None = 1
integer, parameter :: ReadTimeSerie = 2
integer, parameter :: OpenMI = 3
!TimeSerie hydrodynamic properties
integer, parameter :: pWaterDepth = 1
integer, parameter :: pWaterLevel = 2
integer, parameter :: pPercentageMaxVolume = 3
integer, parameter :: pVerticalArea = 4
integer, parameter :: pFlowToChannels = 5
integer, parameter :: pVolume = 6
integer, parameter :: pFlow = 7
integer, parameter :: pVelocity = 8
integer, parameter :: pGWFlowToChannels = 9
integer, parameter :: pPoolDepth = 10
integer, parameter :: pDT = 11
integer, parameter :: pDTLocal = 12
integer, parameter :: BaseTimeSeries = 12
!OutputHydro
integer, parameter :: pHydroTimeGradient = 13
integer, parameter :: pHydroAdvection = 14
integer, parameter :: pHydroPressure = 15
integer, parameter :: pHydroGravity = 16
integer, parameter :: pHydroFriction = 17
!T90 Calc Method
integer, parameter :: Constant = 0
integer, parameter :: Canteras = 1
integer, parameter :: Chapra = 2
!O2 Aeration Method
integer, parameter :: PoolAndRifle_ = 1
integer, parameter :: ChannelControled_ = 2
!Restart fiels format
integer, parameter :: BIN_ = 1
integer, parameter :: HDF_ = 2
!TimeSerie hydrodynamic properties
character(StringLength), parameter :: Char_WaterDepth = trim(adjustl('channel water depth'))
character(StringLength), parameter :: Char_WaterLevel = trim(adjustl('channel water level'))
character(StringLength), parameter :: Char_PercentageMaxVolume = trim(adjustl('percentage max volume'))
character(StringLength), parameter :: Char_VerticalArea = trim(adjustl('vertical area'))
character(StringLength), parameter :: Char_FlowToChannels = trim(adjustl('flow to channels'))
character(StringLength), parameter :: Char_Volume = trim(adjustl('volume'))
character(StringLength), parameter :: Char_Flow = trim(adjustl('channel flow'))
character(StringLength), parameter :: Char_Velocity = trim(adjustl('velocity'))
character(StringLength), parameter :: Char_GWFlowToChannels = trim(adjustl('GW flow to channels'))
character(StringLength), parameter :: Char_PoolDepth = trim(adjustl('pool water depth'))
character(StringLength), parameter :: Char_DT = trim(adjustl('DT'))
character(StringLength), parameter :: Char_DTLocal = trim(adjustl('Local DT'))
character(StringLength), parameter :: Char_HydroTimeGradient = trim(adjustl('hydro time gradient'))
character(StringLength), parameter :: Char_HydroAdvection = trim(adjustl('hydro advection'))
character(StringLength), parameter :: Char_HydroPressure = trim(adjustl('hydro pressure'))
character(StringLength), parameter :: Char_HydroGravity = trim(adjustl('hydro gravity'))
character(StringLength), parameter :: Char_HydroFriction = trim(adjustl('hydro friction'))
integer, parameter :: UnitMax = 80
!water column computation in faces
integer, parameter :: WDMaxBottom_ = 1
integer, parameter :: WDAverageBottom_ = 2
!Types---------------------------------------------------------------------
type T_ID
integer :: ID = null_int
integer :: IDNumber = null_int
character(LEN = StringLength) :: Name = null_str
character(LEN = StringLength) :: Description = null_str
character(LEN = StringLength) :: Units = null_str
end type T_ID
type T_FlowFrequency
type (T_Time) :: StartDate
type (T_Time) :: StopDate
real :: MinimumFlow = null_real
end type T_FlowFrequency
type T_IntFlow
real :: IntFlowDTOutput = null_real
type (T_Time) :: IntFlowNextOutput
end type T_IntFlow
type T_OutPut
type (T_Time), dimension(:), pointer :: OutTime => null()
type (T_Time), dimension(:), pointer :: RestartOutTime => null()
integer :: NextOutPut = null_int
logical :: Yes = .false.
logical :: WriteRestartFile = .false.
logical :: RestartOverwrite = .false.
integer :: NextRestartOutput = 1
logical :: ComputeFlowFrequency = .false.
type (T_FlowFrequency) :: FlowFrequency
logical :: ComputeIntegratedFlow = .false.
logical :: ComputeIntegratedMass = .false.
type (T_IntFlow ) :: IntFlow
logical :: Rates = .false.
integer :: RestartFormat = BIN_
end type T_OutPut
!IN PROGRESS
type T_ReachIntegration
real :: AccFlowVolume = 0.0, &
MaxFlow = 0.0, &
MinFlow = 0.0
end type T_ReachIntegration
type T_NodeIntegration
real :: AccWeightedVolume = 0.0, &
MaxVolume = 0.0, &
MinVolume = 0.0, &
AccWeightedDepth = 0.0, &
MaxDepth = 0.0, &
MinDepth = 0.0, &
AccWeightedLevel = 0.0, &
MaxLevel = 0.0, &
MinLevel = 0.0, &
OverlandFlowVolume = 0.0, &
GWFlowVolume = 0.0
end type T_NodeIntegration
!IN PROGRESS
type T_IntegratedOutput
type (T_Time), dimension(:), pointer :: OutTime => null()
integer :: NextOutPut = null_int
logical :: Yes = .false., &
Initialize = .true.
real :: AccTime = 0.0, &
OldAccTime = 0.0
type(T_ReachIntegration), dimension(:), pointer :: OldReachStatus => null(), &
ReachStatus => null()
type(T_NodeIntegration), dimension(:), pointer :: OldNodeStatus => null(), &
NodeStatus => null()
end type T_IntegratedOutput
type T_Files
character(PathLength) :: InputData = null_str
character(PathLength) :: FinalFile = null_str
character(PathLength) :: HDFFile = null_str
character(PathLength) :: IntegratedHDFFile = null_str
character(PathLength) :: InitialFile = null_str
character(PathLength) :: Network = null_str
integer :: ObjEnterDataNetwork = 0
integer :: ObjEnterDataInitial = 0
end type T_Files
type T_CrossSection
integer :: Form = null_int
real :: BottomWidth = null_real
real :: TopWidth = null_real
real :: Slope = null_real
real :: Height = null_real !Total: from bottomlevel to surface
real :: TerrainLevel = null_real !dado input da net
real :: BottomLevel = null_real !isto passa a ser calculado
real :: ManningCH = null_real
real :: PoolDepth = null_real
real :: MiddleWidth = null_real
real :: MiddleHeight = null_real
real :: SlopeTop = null_real
logical :: CorrectBanks = .true.
!Tabular
integer :: IBottom = 0
integer :: NStations = 0
integer :: NLevels = 0
real, dimension(:), pointer :: Station => null() !length NStations
real, dimension(:), pointer :: Elevation => null() !length NStations
real, dimension(:), pointer :: BankSlope => null() !length NStations
real, dimension(:), pointer :: Level => null() !length NLevels
real, dimension(:), pointer :: LevelSlopeLeft => null() !length NLevels
real, dimension(:), pointer :: LevelSlopeRight => null() !length NLevels
real, dimension(:), pointer :: LevelBottomWidth => null() !length NLevels
real, dimension(:), pointer :: LevelVerticalArea => null() !length NLevels
real, dimension(:), pointer :: LevelWetPerimeter => null() !length NLevels
real, dimension(:), pointer :: LevelSurfaceWidth => null() !length NLevels
!Culvert
integer :: CulvertSectionType = null_int
real :: CulvertDiameter = null_real
real :: CulvertHeight = null_real
real :: CulvertWidth = null_real
end type T_CrossSection
type T_MaxValues
real :: Depth = null_real
real :: Flow = null_real
real :: Vel = null_real
character(len=StringLength) :: Time = null_str
end type
type T_Node
integer :: ID = null_int
real :: X = null_real
real :: Y = null_real
real :: VerticalArea = null_real
real :: WaterDepth = null_real !cotas (inclui z bottom)
real :: InitialWaterDepth = null_real
real :: WaterLevel = null_real
real(8) :: VolumeNew = 0.0
real(8) :: VolumeOld = 0.0
real(8) :: InitialVolumeOld = 0.0
real(8) :: InitialVolumeNew = 0.0
real :: VolumeMax = null_real
real :: VolumeMaxTrapez1 = null_real
real :: VolumeMin = null_real
real :: WetPerimeter = null_real
real :: Length = null_real
real :: SurfaceArea = null_real
real :: SurfaceWidth = null_real
logical :: HasGrid = .FALSE.
logical :: HasTwoGridPoints = .FALSE.
integer :: GridI = null_int
integer :: GridJ = null_int
integer :: LeftGridI = null_int
integer :: LeftGridJ = null_int
integer :: RightGridI = null_int
integer :: RightGridJ = null_int
integer :: nUpstreamReaches = 0
integer :: nDownstreamReaches = 0
integer :: Order = null_int
integer, dimension (:), pointer :: UpstreamReaches => null()
integer, dimension (:), pointer :: DownstreamReaches => null()
logical :: TimeSerie = .FALSE.
character(LEN = StringLength) :: TimeSerieName = ''
logical :: Discharges = .FALSE.
type (T_CrossSection) :: CrossSection
character(len=StringLength) :: StationName = ''
real :: SingCoef = 1.0
type(T_MaxValues) :: Max
real :: EVTP = null_real !m/s evapotranspiration in pools
real :: MinimunToStabilize = 0.0
real :: SODRate = 0.0
end type T_Node
type T_Reach
private
integer :: ID = null_int
logical :: Active = .true.
integer :: UpstreamNode = null_int
integer :: DownstreamNode = null_int
real :: Length = null_real
real :: Slope = null_real
real :: FlowNew = 0.0
real :: FlowOld = 0.0
real :: InitialFlowOld = 0.0
real :: InitialFlowNew = 0.0
real :: Velocity = 0.0
real :: VerticalArea = 0.0
real :: PoolVerticalArea = 0.0
real :: HydraulicRadius = 0.0
real :: Manning = 0.0
logical :: TimeSerie = .false.
real :: HydroTimeGradient = 0.0
real :: HydroAdvection = 0.0
real :: HydroPressure = 0.0
real :: HydroGravity = 0.0
real :: HydroFriction = 0.0
!Flow accumulation analisys
real :: InitialFlowAccTime = 0.0
real :: FlowAccTime = 0.0
real :: FlowAccPerc = 0.0
real :: InitialOutputVolume = 0.0
real :: OutputVolume = 0.0
real :: InitialOutputTime = 0.0
real :: OutputTime = 0.0
end type T_Reach
type T_TimeSerie
integer :: ObjEnterData = 0
logical :: ByNodes = .false.
character(PathLength) :: Location = null_str
character(PathLength) :: LocationInt = null_str
integer :: nNodes = 0
integer :: nProp = 0
integer , dimension (:), pointer :: ObjTimeSerie => null()
integer , dimension (:), pointer :: ObjTimeSerieMass => null() !for integrated mass
logical , dimension (:), pointer :: ComputeMass => null() !for integrated mass
character(StringLength) , dimension (:), pointer :: Name => null()
real , dimension (:), pointer :: X => null()
real , dimension (:), pointer :: Y => null()
real, dimension(:), pointer :: DataLine => null()
real, dimension(:), pointer :: DataLine2 => null() !for integrated volume
real, dimension(:), pointer :: DataLine3 => null() !for integrated mass
integer :: ObjTimeSerieIntFlow = 0
end type T_TimeSerie
type T_ExtVar
real :: DT = null_real
logical :: CoupledPMP = .false.
logical :: CoupledRP = .false.
real, dimension(:,:), pointer :: Topography => null()
end type T_ExtVar
type T_Downstream
integer :: Boundary = null_int
integer :: Evolution = null_int
real :: DefaultValue = null_real !WaterColumn in meters
character(PathLength) :: FileName = null_str
integer :: DataColumn = null_int
integer :: ObjTimeSerie = 0
end type T_Downstream
type T_Toxicity
integer :: Evolution = null_int
real :: Slope = null_real
real :: EC50 = null_int !Concentration that causes 50% effect (Tox = 0.5)
real, dimension (:), pointer :: Field => null()
end type T_Toxicity
type T_MacroAlgae
logical :: VariableHeight = .false.
real, pointer, dimension(: ) :: Distribution !kgC/m2
real :: DefaultValue, HBRatio, HeightConstant
!real, pointer, dimension(:) :: ShearStress3D
!real, pointer, dimension(:) :: SPMDepFlux3D
real, pointer, dimension(:) :: Occupation
!real, pointer, dimension(:,:,:) :: DistFromTop
real, pointer, dimension(:) :: ShearStress, Height
real, pointer, dimension(:) :: SPMDepFlux
end type T_MacroAlgae
type T_ComputeOptions
logical :: TimeSerie = .false.
logical :: Discharges = .false.
logical :: Toxicity = .false.
logical :: T90_Decay = .false.
logical :: Generic_Decay = .false.
logical :: SurfaceFluxes = .false.
logical :: BottomFluxes = .false.
logical :: Erosion = .false.
logical :: Deposition = .false.
logical :: AdvectionDiffusion = .false.
logical :: WaterQuality = .false.
logical :: Benthos = .false.
logical :: CeQualW2 = .false.
logical :: Life = .false.
logical :: MacroAlgae = .false.
logical :: MinConcentration = .false.
logical :: WarnOnNegativeValues = .false.
logical :: TopRadiation = .false.
logical :: LightExtinction = .false.
logical :: TransmissionLosses = .false.
logical :: RemoveOverTop = .false.
logical :: SumTotalConc = .false.
logical :: ComputeLoad = .false.
logical :: CalcFractionSediment = .false.
logical :: EVTPFromReach = .false.
logical :: StormWaterModelLink = .false.
logical :: ReservoirLink = .false.
logical :: LimitToCriticalFlow = .true.
integer :: FaceWaterColumn = WDMaxBottom_
logical :: IntMassFlux = .false.
logical :: RadiationBottomNoFlux = .true.
logical :: MassFluxes = .true.
logical :: DTIntervalAssociated = .false.
end type T_ComputeOptions
type T_Coupling
type(T_Time) :: NextCompute
real :: DT_Compute = FillValueReal
logical :: Yes = .false.
integer :: NumberOfProperties = 0
end type T_Coupling
type T_Coupled
type(T_Coupling) :: WQM
type(T_Coupling) :: CEQUALW2
type(T_Coupling) :: Life
type(T_Coupling) :: Benthos
type(T_Coupling) :: MacroAlgae
end type T_Coupled
type T_MassBalance
real(8) :: TotalStoredMass = 0.
real(8) :: TotalDischargeMass = 0.
real(8) :: TotalOutFlowMass = 0.
end type T_MassBalance
type T_Property
type (T_PropertyID) :: ID
type (T_ComputeOptions) :: ComputeOptions
!Concentrations
real, dimension (:), pointer :: Concentration => null()
real, dimension (:), pointer :: ConcentrationOld => null()
real, dimension (:), pointer :: InitialConcentration => null()
real, dimension (:), pointer :: InitialConcentrationOld => null()
real, dimension (:), pointer :: MassCreated => null() !kg
real, dimension (:), pointer :: OverLandConc => null()
real, dimension (:), pointer :: GWaterConc => null()
real, dimension (:, :, :), pointer :: GWaterConcLayers => null() !for computation by layers
real, dimension (:), pointer :: DWaterConc => null()
real, dimension (:), pointer :: BottomConc => null() !kg m-2
real, dimension (:), pointer :: MassInKg => null() !kg (run with Benthos)
real, dimension (:), pointer :: Load => null()
real, dimension (:), pointer :: TotalConc => null() !**WASSIM 16/11/2005
real, dimension (:), pointer :: ErosionRate => null() !kg m-2 s-1
real, dimension (:), pointer :: DepositionRate => null() !kg m-3 s-1
real, dimension (:), pointer :: Ws => null() !m s-1 (vertical velocity)
!positive direction is downswards
real, dimension (:), pointer :: OutputMass => null() !g
real, dimension (:), pointer :: InitialOutputMass => null() !g
real, dimension (:), pointer :: OutputTime => null() !s
real, dimension (:), pointer :: InitialOutputTime => null() !s
real :: MinValue = null_real
logical :: WarnOnNegativeValues = .false.
real :: InitialValue = null_real
real :: BottomMinConc = null_real !kg m-2
real :: BoundaryConcentration = null_real
!Advection Diffusion
real :: Diffusivity = null_real
integer :: Advection_Scheme = null_int
integer :: Diffusion_Scheme = null_int
!Toxicity
type (T_Toxicity) :: Toxicity
!Decay
real :: DecayRate = null_real
type (T_MassBalance) :: MB
real :: IScoefficient = null_real
real :: ExtinctionCoefficient = null_real
real :: ErosionCriticalShear = null_real
real :: DepositionCriticalShear = null_real
real :: ErosionCoefficient = null_real
real :: CHS = null_real
integer :: Ws_Type = null_int
real :: Ws_Value = null_real
real :: KL = null_real
real :: KL1 = null_real
real :: ML = null_real
real :: M = null_real
!Mass integration output
real :: IntMassFluxDT = null_real
type (T_Time) :: IntMassFluxNextOutput
character(PathLength) :: OutputName = null_str
type (T_Property), pointer :: Next => null()
type (T_Property), pointer :: Prev => null()
!property dt in quality modules
real :: DTInterval = null_real
type(T_Time) :: LastCompute
type(T_Time) :: NextCompute
end type T_Property
type T_WQRate
type (T_ID) :: ID
type (T_ID) :: FirstProp, SecondProp
type (T_OutPut) :: OutPut
real, pointer, dimension(:) :: Field => null()
character(len=StringLength) :: Model = null_str
type(T_WQRate), pointer :: next => null()
type(T_WQRate), pointer :: prev => null()
integer :: CeQualID = null_int
end type T_WQRate
type T_StormWaterModelLink
integer :: nOutflowNodes = 0 !Nº of nodes where water flows from here to SWMM
integer :: nInflowNodes = 0 !Nº of nodes where water flows from SWMM to here
integer, dimension(:), allocatable :: OutflowIDs
integer, dimension(:), allocatable :: InflowIDs
real, dimension(:), allocatable :: Outflow
real, dimension(:), allocatable :: Inflow
end type T_StormWaterModelLink
type T_ReservoirLink
integer, dimension(:), pointer :: ReservoirDNNodeID => null() !from reservoirs - the node ID location
integer, dimension (:), pointer :: ReservoirsExchangeNodePos => null() !reservoir node ID (after check outlet)
real, dimension (:,:), pointer :: ReservoirsConc => null()
real, dimension (:,:), pointer :: NodeConc => null()
integer :: nReservoirs = null_int
real, dimension (:), pointer :: ReservoirsInflow => null()
real, dimension (:), pointer :: ReservoirsOutflow => null()
end type T_ReservoirLink
type T_Converge
integer :: MinIterations = 1
integer :: MaxIterations = 1024
logical :: IgnoreMaxIterations = .false.
logical :: Stabilize = .false.
real :: StabilizeFactor = 0.01
real :: DTFactorUp = 1.25
real :: DTFactorDown = 1.25
real :: StabilizeHardCutLimit = 128
real :: DTSplitFactor = 2.0
real :: CurrentDT = null_real
real :: NextDT = null_real
integer :: LastGoodNiteration = 1
integer :: NextNiteration = 1
logical :: LimitDTCourant = .false.
real :: MaxCourant = 1.0
integer :: MinToRestart = 0
real :: MinimumValueToStabilize = 0.001
logical :: CheckDecreaseOnly = .false.
real :: StabilizeCoefficient = 0.0001
end type T_Converge
type T_DrainageNetwork
integer :: InstanceID = 0
character(len=StringLength) :: ModelName = null_str
integer :: ObjEnterData = 0
integer :: ObjDischarges = 0
integer :: ObjTime = 0
integer :: ObjInterface = 0
integer :: ObjBenthicInterface = 0
integer :: ObjInterfaceMacroAlgae = 0
integer :: ObjLightExtinction = 0
integer :: ObjHDF5 = 0
integer :: ObjIntegratedHDF5 = 0
type (T_Time) :: BeginTime
type (T_Time) :: EndTime
type (T_Time) :: CurrentTime
type (T_Node) , dimension(:), pointer :: Nodes => null()
type (T_Reach), dimension(:), pointer :: Reaches => null()
integer , dimension(:), pointer :: ComputeFaces => null()
integer , dimension(:), pointer :: OpenPointsFlow => null()
integer , dimension(:), pointer :: OpenPointsProcess => null()
integer , dimension(:), pointer :: RiverPoints => null()
integer :: TotalNodes = 0
integer :: TotalReaches = 0
integer :: TotalOutlets = 0
integer, dimension(:), pointer :: OutletReachID => null()
integer, dimension(:), pointer :: OutletNodeID => null()
integer :: HighestOrder = 0
logical :: CheckNodes = .false.
logical :: CheckReaches = .false.
logical :: CorrectBanks = .false.
integer :: XSCalc = null_int
logical :: HasGrid = .true.
integer :: CoordType = null_int
type (T_OutPut) :: OutPut
type (T_IntegratedOutput) :: IntegratedOutput
type (T_ComputeOptions) :: ComputeOptions
type (T_TimeSerie) :: TimeSerie
type (T_Files ) :: Files
type (T_Coupled ) :: Coupled
type (T_StormWaterModelLink) :: StormWaterModelLink
type (T_ReservoirLink) :: Reservoirs
logical :: Continuous = .false.
logical :: PropertyContinuous = .false.
logical :: StopOnWrongDate = .false.
type (T_Property), pointer :: FirstProperty => null()
type (T_Property), pointer :: LastProperty => null()
real , dimension(:), pointer :: SODRate => null()
logical :: UseSOD = .false.
integer :: PropertiesNumber = 0
integer :: WQratesNumber = 0
type(T_WqRate), pointer :: FirstWQrate => null()
type(T_WqRate), pointer :: LastWQrate => null()
type(T_MacroAlgae) :: MacroAlgae
logical :: HasProperties = .false.
type(T_Converge) :: CV
real :: GlobalManning = null_real
logical :: AllowBackwardWater = .false.
real :: MinimumSlope = null_real
real :: InitialWaterDepth = null_real
real :: InitialWaterLevel = null_real
logical :: InitialWaterLevelON = .false.
real :: MinimumWaterDepth = null_real
real :: MinimumWaterDepthProcess = null_real
real :: MinimumWaterDepthAdvection = null_real
real :: HminChezy = null_real
integer :: HydrodynamicApproximation = null_int
real :: NumericalScheme = null_real
real, dimension(:) , pointer :: RunOffVector => null()
real, dimension(:) , pointer :: GroundVector => null()
real, dimension(:,:,:), pointer :: GroundVectorLayers => null()
real, dimension(:) , pointer :: DiffuseVector => null()
real, dimension(:) , pointer :: TransmissionFlow => null()
logical :: GWFlowByLayers = .false.
integer, dimension(:), pointer :: GWFlowBottomLayer => null()
integer, dimension(:), pointer :: GWFlowTopLayer => null()
real, dimension(:,:), pointer :: ChannelsWaterLevel => null()
real, dimension(:,:), pointer :: ChannelsBottomLevel => null()
real, dimension(:,:), pointer :: ChannelsBottomWidth => null()
real, dimension(:,:), pointer :: ChannelsSurfaceWidth => null()
real, dimension(:,:), pointer :: ChannelsBankSlope => null()
real, dimension(:,:), pointer :: ChannelsNodeLength => null()
real, dimension(:,:), pointer :: ChannelsVolume => null()
real, dimension(:,:), pointer :: ChannelsTopArea => null()
real, dimension(:,:), pointer :: ChannelsMaxVolume => null()
real, dimension(:,:), pointer :: ChannelsVelocity => null()
integer, dimension(:,:), pointer :: ChannelsOpenProcess => null()
integer, dimension(:,:), pointer :: ChannelsActiveState => null()
real, dimension(:) , pointer :: ShortWaveExtinction => null()
real, dimension(:) , pointer :: ShortWaveField => null()
real, dimension(:) , pointer :: LongWaveField => null()
real, dimension(:) , pointer :: NodesDWZ => null()
real, dimension(:) , pointer :: TopRadiation => null()
real, dimension(:) , pointer :: AirTemperature => null()
real, dimension(:) , pointer :: CloudCover => null()
real, dimension(:) , pointer :: RelativeHumidity => null()
real, dimension(:) , pointer :: WindSpeed => null()
real, dimension(:) , pointer :: SedimentTemperature => null()
integer, dimension(:) , pointer :: DischargesLink => null()
real, dimension(:) , pointer :: DischargesFlow => null()
real, dimension(:,:), pointer :: DischargesConc => null()
logical, dimension(:) , pointer :: DischargesActive => null()
integer, dimension(:,:), pointer :: ChannelsID => null()
logical :: Discharges = OFF
type (T_Downstream) :: Downstream
type (T_Size2D) :: Size
type (T_ExtVar) :: ExtVar
! real :: NextDT = null_real
! integer :: LastGoodNiter = 1
! integer :: NextNiter = 1
! real :: InternalTimeStepSplit = 1.5
real, dimension (:), pointer :: GlobalToxicity => null()
integer :: nToxicProp = 0
character(len=StringLength) :: GlobalToxicityEvolution = null_str
!MassBalance
logical :: CheckMass = .false.
real(8) :: TotalStoredVolume = 0.0
real(8) :: TotalOutputVolume = 0.0
real(8) :: TotalFlowVolume = 0.0 !TotalOutput trough outlets
real(8) :: TotalInputVolume = 0.0 !by discharges
real(8) :: TotalEvapFromSurfaceVolume = 0.0 !by surface evaporation
real(8) :: TotalOverTopVolume = 0.0 !OverTopping
real(8) :: TotalStormWaterOutput = 0.0 !Total outflow to the Storm Water System
real(8) :: TotalStormWaterInput = 0.0
real(8) :: TotalReservoirInput = 0.0 !input from reservoirs
real(8) :: TotalReservoirOutput = 0.0 !exit to reservoirs
real(8) :: InitalTotalEvapFromSurfaceVolume = 0.0
real(8) :: InitialTotalOutputVolume = 0.0
real(8) :: InitialTotalFlowVolume = 0.0
real(8) :: InitialTotalInputVolume = 0.0 !by discharges
real(8) :: InitialTotalEvapFromSurfaceVolume = 0.0
real(8) :: OutletFlowVolume = 0.0 !Acc. Outlet Flow Vol for the Input DT.
!type(T_Reach), pointer :: OutletReach => null()
! logical :: Stabilize = .true.
! real :: StabilizeFactor = null_real
! real :: StabilizeCoefficient = null_real
! integer :: MaxIterations = null_int
! real :: DTFactor = null_real
! real :: DTFactorUp = null_real
! real :: DTFactorDown = null_real
! logical :: LimitDTCourant = .false.
! logical :: LimitDTVariation = .true.
! real :: MaxCourant = 1.0
! integer :: MinNodesToRestart = 0
! real :: PercentToRestart = 0.
! integer :: MinIterations = 1
! logical :: CheckDecreaseOnly = .false.
integer :: nPropWithDischarges = 0 !Performance
!T90
integer :: T90Var_Method = null_int
real :: T90 = null_real
!Ripirian Shading
real :: ShadingFactor = null_real
logical :: DTIntervalAssociated = .false.
!Transmission Losses
real :: HydraulicConductivity = null_real
integer :: AerationEquation = null_int
real, dimension(:) , pointer :: ShearStress => null()
logical :: WriteMaxStationValues = .false.
logical :: OutputHydro = .false.
logical :: ChangedNodes = .false. !change nodes according to DTM
!Evapotranspirate in reach pools
real :: EVTPMaximumDepth = null_real
real :: EVTPCropCoefficient = null_real
logical :: DecreaseDT = .false.
type (T_DrainageNetwork), pointer :: Next => null()
end type T_DrainageNetwork
!Global Module Variables
type (T_DrainageNetwork), pointer :: FirstDrainageNetwork => null()
type (T_DrainageNetwork), pointer :: Me => null()
!--------------------------------------------------------------------------
contains
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONS
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!----------------------------------------------------------------------------
subroutine ConstructDrainageNetwork(ModelName, DrainageNetworkID, TimeID, Size2D, &
CheckMass, CoupledPMP, CoupledRP, CoupledReservoirs, &
ReservoirDNNodeID, Topography, STAT)
!Arguments---------------------------------------------------------------
character(len=*) :: ModelName
integer :: DrainageNetworkID
integer :: TimeID
type (T_Size2D), optional :: Size2D
logical, optional :: CheckMass
logical, optional :: CoupledPMP, CoupledRP, CoupledReservoirs
integer, dimension(:), pointer, optional :: ReservoirDNNodeID
real, dimension(:,:), pointer, optional :: Topography
integer, optional, intent(OUT) :: STAT
!Local-------------------------------------------------------------------
integer :: STAT_CALL
integer :: ready_
integer :: NodeID
type (T_Node), pointer :: CurrNode
type(T_Property), pointer :: Property
real :: BottomMass
!------------------------------------------------------------------------
STAT_CALL = UNKNOWN_
!Assures nullification of the global variable
if (.not. ModuleIsRegistered(mDRAINAGENETWORK_)) then
nullify (FirstDrainageNetwork)
call RegisterModule (mDrainageNetwork_)
endif
call Ready(DrainageNetworkID, ready_)
cd0 : if (ready_ .EQ. OFF_ERR_) then
call AllocateInstance
Me%ModelName = ModelName
!Associates module Time
Me%ObjTime = AssociateInstance (mTIME_, TimeID)
if (present(CoupledPMP)) then
Me%ExtVar%CoupledPMP = CoupledPMP
endif
if (present(CoupledRP)) then
Me%ExtVar%CoupledRP = CoupledRP
endif
if (present(CoupledReservoirs)) then
Me%ComputeOptions%ReservoirLink = CoupledReservoirs
Me%Reservoirs%ReservoirDNNodeID => ReservoirDNNodeID
Me%Reservoirs%nReservoirs = size(Me%Reservoirs%ReservoirDNNodeID)
endif
!DN will be forced with Topography (to check nodes terrain level and heights)
!This is used when DN is forced over DTM (the latter without removed depressions)
nullify(Me%ExtVar%Topography)
if (present (Topography)) then
Me%ExtVar%Topography => Topography
endif
!Gets Current Compute Time
call GetComputeCurrentTime(Me%ObjTime, Me%CurrentTime, STAT = STAT_CALL)
if (STAT_CALL/=SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR01'
!Gets Compute Time Limits
call GetComputeTimeLimits (Me%ObjTime, BeginTime = Me%BeginTime, &
EndTime = Me%EndTime, STAT = STAT_CALL)
if (STAT_CALL/=SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR01a'
!Verifies if Drainage Network Runs coupled to a grid or not
if (present(Size2D)) then
Me%HasGrid = .true.
Me%Size = Size2D
else
Me%HasGrid = .false.
endif
if (present(CheckMass)) then
Me%CheckMass = CheckMass
else
Me%CheckMass = .false.
end if
!Reads main user options
call ReadDataFile
call ConstructDownstreamBoundary
!Connects nodes / reaches
call ConstructNetwork
call ReadConvergenceParameters
!Finds wich reach is the outlet and associate it with Me%OutletReach
!call FindOutlet
!Set up properties to be transported
call ConstructPropertyList
!Constructs the list of WQRates
call Construct_WQRateList
!Verifies Global consistence of properties
call CheckSelectedProp
!Initial all variables
call InitializeVariables
if (Me%ComputeOptions%Discharges) then
call ConstructDischarges
endif
!Link to StormWaterModel
if (Me%ComputeOptions%StormWaterModelLink) then
call ConstructStormWaterModelLink
endif
if (Me%ComputeOptions%ReservoirLink) then
call ConstructReservoirs
endif
!Couples other modules
call ConstructSubModules
!Opens Output files
call ConstructOutput
!first TimeSeries Output
if (Me%TimeSerie%nNodes .GT.0) call WriteTimeSeries (0.)
!First HDF Output
if (Me%Output%Yes) &
call HDF5Output
if (Me%IntegratedOutput%Yes) &
call IntegratedHDF5Output
!User Feed-Back
call ConstructLog
if (Me%CheckMass) then
Me%TotalStoredVolume = 0.0
Property => Me%FirstProperty
do while (associated(Property))
Property%MB%TotalStoredMass = 0.0
Property => Property%Next
enddo
do NodeID = 1, Me%TotalNodes
if (Me%Nodes(NodeID)%nDownStreamReaches /= 0) then
Me%TotalStoredVolume = Me%TotalStoredVolume + Me%Nodes(NodeID)%VolumeNew
endif
Property => Me%FirstProperty
do while (associated(Property))
CurrNode => Me%Nodes(NodeID)
BottomMass = 0.0
!~ if (Check_Particulate_Property(Property%ID%IDNumber).and.(Property%ComputeOptions%BottomFluxes)) then
if (Property%ID%IsParticulate .and. (Property%ComputeOptions%BottomFluxes)) then
![kg] = [kg/m2] * [m2]
BottomMass = Property%BottomConc(NodeID) * CurrNode%CrossSection%BottomWidth * CurrNode%Length
else
BottomMass = 0.0
endif
![kg] = [kg] + [kg] + [g/m3] * [m3] * [1e-3kg/g]
Property%MB%TotalStoredMass = Property%MB%TotalStoredMass + BottomMass &
+ Property%Concentration (NodeID) &
* Property%ISCoefficient &
* Me%Nodes(NodeID)%VolumeNew
Property => Property%Next
enddo
enddo
end if
!Close input data file
call KillEnterData (Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR03'
!Returns ID
DrainageNetworkID = Me%InstanceID
STAT_CALL = SUCCESS_
else cd0
stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR04'
end if cd0
if (present(STAT)) STAT = STAT_CALL
!-----------------------------------------------------------------------
end subroutine ConstructDrainageNetwork
!---------------------------------------------------------------------------
subroutine ConstructDischarges
!Arguments--------------------------------------------------------------
!Local------------------------------------------------------------------
integer :: STAT_CALL
integer :: nDischarges, iDis, NodePos, NodeID
logical :: Found
type (T_Node), pointer :: CurrNode
call Construct_Discharges(Me%ObjDischarges, &
Me%ObjTime, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR02'
!Build Discharge NodeID / NodePos link
!Gets the number of discharges
call GetDischargesNumber(Me%ObjDischarges, nDischarges, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR03'
allocate(Me%DischargesLink(nDischarges))
allocate(Me%DischargesFlow(nDischarges))
allocate(Me%DischargesConc(nDischarges, Me%nPropWithDischarges))
allocate(Me%DischargesActive(nDischarges))
do iDis = 1, nDischarges
call GetDischargesNodeID (Me%ObjDischarges, iDis, NodeID, STAT = STAT_CALL)
if (STAT_CALL/=SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR04'
!ignore discharges from reservoir (that can cohesist)
if (NodeID > 0) then
Me%DischargesActive(iDis) = .true.
call FindNodePosition (NodeID, NodePos, Found)
CurrNode => Me%Nodes(NodePos)
CurrNode%Discharges = .true.
if (Found) then
Me%DischargesLink(iDis) = NodePos
else
write (*,*) 'Discharge Node not found'
write (*,*) 'Node ID = ', NodeID
stop 'ModuleDrainageNetwork - ConstructDrainageNetwork - ERR05'
end if
else
Me%DischargesActive(iDis) = .false.
endif
end do
endsubroutine ConstructDischarges
!--------------------------------------------------------------------------
subroutine AllocateInstance
!Arguments--------------------------------------------------------------
!Local------------------------------------------------------------------
type (T_DrainageNetwork), pointer :: NewObjDrainageNetwork
type (T_DrainageNetwork), pointer :: PreviousObjDrainageNetwork
!Allocates new instance
allocate (NewObjDrainageNetwork)
nullify (NewObjDrainageNetwork%Next)
!Insert New Instance into list and makes Current point to it
if (.not. associated(FirstDrainageNetwork)) then
FirstDrainageNetwork => NewObjDrainageNetwork
Me => NewObjDrainageNetwork
else
PreviousObjDrainageNetwork => FirstDrainageNetwork
Me => FirstDrainageNetwork%Next
do while (associated(Me))
PreviousObjDrainageNetwork => Me
Me => Me%Next
enddo
Me => NewObjDrainageNetwork
PreviousObjDrainageNetwork%Next => NewObjDrainageNetwork
endif
Me%InstanceID = RegisterNewInstance (mDrainageNetwork_)
end subroutine AllocateInstance
!---------------------------------------------------------------------------
subroutine ReadDataFile
!Local------------------------------------------------------------------
integer :: flag, STAT_CALL
integer :: GeoConversationFactor
character(len=StringLength) :: AuxString
!begin------------------------------------------------------------------
!Reads name of the data file from nomfich.dat
call ReadFileName('DRAINAGE_NETWORK', Me%Files%InputData, &
Message = "Drainage Network Data File", &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR01'
call ReadFileName('DRAINAGE_NETWORK_FIN', Me%Files%FinalFile, &
Message = "Drainage Network Final File", &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR02'
call ReadFileName('DRAINAGE_NETWORK_HDF', Me%Files%HDFFile, &
Message = "Drainage Network HDF File", &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR03'
call ConstructEnterData (Me%ObjEnterData, Me%Files%InputData, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR04'
call GetData(Me%Files%Network, &
Me%ObjEnterData, flag, &
keyword = 'NETWORK_FILE', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR05'
call GetData(Me%CheckNodes, &
Me%ObjEnterData, flag, &
keyword = 'CHECK_NODES', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR06'
call GetData(Me%CheckReaches, &
Me%ObjEnterData, flag, &
keyword = 'CHECK_REACHES', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR07'
call GetData(Me%CorrectBanks, &
Me%ObjEnterData, flag, &
keyword = 'CORRECT_BANKS', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR07a'
call GetData(Me%ComputeOptions%Discharges, &
Me%ObjEnterData, flag, &
keyword = 'DISCHARGES', &
default = .false., &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR08'
call GetData(Me%HydrodynamicApproximation, &
Me%ObjEnterData, flag, &
keyword = 'HYDRODYNAMIC_APROX', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = KinematicWave, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR09'
call GetData(Me%NumericalScheme, &
Me%ObjEnterData, flag, &
keyword = 'NUMERICAL_SCHEME', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = ExplicitScheme, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR010'
if (Me%NumericalScheme /= ExplicitScheme .and. Me%NumericalScheme /= ImplicitScheme) &
stop 'ModuleDrainageNetwork - ReadDataFile - ERR09b'
call GetData(Me%GlobalManning, &
Me%ObjEnterData, flag, &
keyword = 'GLOBAL_MANNING', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = null_real, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR11'
call GetData(Me%AllowBackwardWater, &
Me%ObjEnterData, flag, &
keyword = 'ALLOW_BACKWATER', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = .false., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR11a'
call GetData(Me%MinimumSlope, &
Me%ObjEnterData, flag, &
keyword = 'MINIMUM_SLOPE', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 0.0, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR12'
call GetData(Me%MinimumWaterDepth, &
Me%ObjEnterData, flag, &
keyword = 'MIN_WATER_DEPTH', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 0.001, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR13'
if (Me%MinimumWaterDepth.LT.0.0) then
write (*,*)'Invalid Number of Minimum Water Level [MIN_WATER_DEPTH]'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR14'
end if
call GetData(Me%MinimumWaterDepthProcess, &
Me%ObjEnterData, flag, &
keyword = 'MIN_WATER_DEPTH_PROCESS', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 0.01, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR15'
if (Me%MinimumWaterDepthProcess.LT.0.0) then
write (*,*)'Invalid Number of Minimum Water Level [MIN_WATER_DEPTH_PROCESS]'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR16'
end if
call GetData(Me%MinimumWaterDepthAdvection, &
Me%ObjEnterData, flag, &
keyword = 'MIN_WATER_DEPTH_ADVECTION', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 0.0, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR16a'
if (Me%MinimumWaterDepthAdvection.LT.0.0) then
write (*,*)'Invalid Number of Minimum Water Level for advection [MIN_WATER_DEPTH_ADVECTION]'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR16b'
end if
!Min water column for chezy computation - used if erosion active
call GetData(Me%HminChezy, &
Me%ObjEnterData, flag, &
SearchType = FromFile, &
keyword = 'HMIN_CHEZY', &
Default = AlmostZero, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR16c'
if (Me%HminChezy .lt. 0.0) then
write(*,*)'Minimum water column height for chezy computation HMIN_CHEZY can not be negative'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR16cd'
endif
!check boundary condition for solar radiation - if all transformed in heat (zero flux)
!or what is not extincted goes to sediment (in this case it should heat sediment but it is not)
call GetData(Me%ComputeOptions%RadiationBottomNoFlux, &
Me%ObjEnterData, flag, &
SearchType = FromFile, &
keyword = 'RADIATION_BOTTOM_NOFLUX', &
Default = .true., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR16d'
!For now mass evaporation. Only used if ssurface fluxes ON
call GetData(Me%ComputeOptions%MassFluxes, &
Me%ObjEnterData, flag, &
SearchType = FromFile, &
keyword = 'MASS_FLUXES', &
Default = .true., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR16e'
! !Method for computing water column in the face (1 - Using max height and max bottom; 2- using average of WC)
! call GetData(Me%ComputeOptions%FaceWaterColumn, &
! ObjEnterData, iflag, &
! keyword = 'WATER_DEPTH_FACE', &
! ClientModule = 'ModuleDraianageNetork', &
! SearchType = FromFile, &
! Default = WDMaxBottom_, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR16b'
call GetData(Me%Continuous, &
Me%ObjEnterData, flag, &
keyword = 'CONTINUOUS', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = OFF, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR17'
if (Me%Continuous) then
call GetData(Me%PropertyContinuous, &
Me%ObjEnterData, flag, &
keyword = 'PROP_CONTINUOUS', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = ON, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR17a'
call ReadFileName('DRAINAGE_NETWORK_INI', Me%Files%InitialFile, &
Message = "Drainage Network Initial File", &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR18'
call GetData(Me%StopOnWrongDate, &
Me%ObjEnterData, flag, &
keyword = 'STOP_ON_WRONG_DATE', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = .true., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR19'
else
call GetData(Me%InitialWaterDepth, &
Me%ObjEnterData, flag, &
keyword = 'INITIAL_WATER_DEPTH', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 0.0, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR20'
if (Me%InitialWaterDepth.LT.0.0) then
write (*,*)'Invalid Number of Initial Water Level [INITIAL_WATER_DEPTH]'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR21'
end if
call GetData(Me%InitialWaterLevel, &
Me%ObjEnterData, flag, &
keyword = 'INITIAL_WATER_LEVEL', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 0.0, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR21'
if(flag == 1)then
Me%InitialWaterLevelON = .true.
endif
end if
! call GetData(Me%Stabilize, &
! Me%ObjEnterData, flag, &
! keyword = 'STABILIZE', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = .true., &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR22'
!
! if (Me%Stabilize) then
!
! call GetData(Me%StabilizeFactor, &
! Me%ObjEnterData, flag, &
! keyword = 'STABILIZE_FACTOR', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 0.1, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR23'
!
! call GetData(Me%StabilizeCoefficient, &
! Me%ObjEnterData, flag, &
! keyword = 'STABILIZE_COEFFICIENT', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 0.05, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR24'
!
! call GetData(Me%MaxIterations, &
! Me%ObjEnterData, flag, &
! keyword = 'MAX_ITERATIONS', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 100, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR25'
!
! call GetData(Me%PercentToRestart, &
! Me%ObjEnterData, flag, &
! keyword = 'PERCENT_TO_RESTART', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 0., &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR26'
! if (Me%PercentToRestart <= 0.) then
! Me%PercentToRestart = 0
! endif
!
! call GetData(Me%MinIterations, &
! Me%ObjEnterData, flag, &
! keyword = 'MIN_ITERATIONS', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 1, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR27'
! if (Me%MinIterations < 1) then
! write (*,*) 'MIN_ITERATIONS must be greater or equal to 1'
! stop 'ReadDataFile - ModuleDrainageNetwork - ERR27a'
! endif
!
! call GetData(Me%CheckDecreaseOnly, &
! Me%ObjEnterData, flag, &
! keyword = 'CHECK_DEC_ONLY', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = .false., &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR28'
!
! !Me%LastGoodNIter = Me%MinIterations
! !Me%NextNIter = Me%MinIterations
!
!
! end if
!
! !Factor for DT Prediction
! call GetData(Me%DTFactor, &
! Me%ObjEnterData, flag, &
! keyword = 'DT_FACTOR', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 1.05, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR29'
!
! if (Me%DTFactor <= 1.0) then
! write (*,*)'Invalid DT Factor [DT_FACTOR]'
! write (*,*)'Value must be greater then 1.0'
! stop 'ModuleDrainageNetwork - ReadDataFile - ERR29a'
! endif
!
! call GetData(Me%DTFactorUp, &
! Me%ObjEnterData, flag, &
! keyword = 'DT_FACTOR_UP', &
! ClientModule = 'ModuleDrainageNetwork', &
! SearchType = FromFile, &
! Default = Me%DTFactor, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR29b'
! if (flag /= 1) then
! write(*,*) 'Assumed a value of ', Me%DTFactor, ' for DrainageNetwork DT_FACTOR_UP'
! endif
! if (Me%DTFactorUp <= 1.0) then
! write (*,*)'Invalid DT Factor Up [DT_FACTOR_UP]'
! write (*,*)'Value must be greater then 1.0'
! stop 'ReadDataFile - ModuleDrainageNetwork - ERR29c'
! endif
!
! call GetData(Me%DTFactorDown, &
! Me%ObjEnterData, flag, &
! keyword = 'DT_FACTOR_DOWN', &
! ClientModule = 'ModuleDrainageNetwork', &
! SearchType = FromFile, &
! Default = Me%DTFactor, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR29d'
! if (flag /= 1) then
! write(*,*) 'Assumed a value of ', Me%DTFactor, ' for DrainageNetwork DT_FACTOR_DOWN'
! endif
! if (Me%DTFactorDown <= 1.0) then
! write (*,*)'Invalid DT Factor Down [DT_FACTOR_DOWN]'
! write (*,*)'Value must be greater then 1.0'
! stop 'ReadDataFile - ModuleDrainageNetwork - ERR29e'
! endif
!
! !Internal Time Step Split
! call GetData(Me%InternalTimeStepSplit, &
! Me%ObjEnterData, flag, &
! keyword = 'DT_SPLIT_FACTOR', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 1.5, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR30'
! if (Me%InternalTimeStepSplit <= 1.0) then
! write (*,*)'Invalid DT Factor [DT_SPLIT_FACTOR]'
! write (*,*)'Value must be greater then 1.0'
! stop 'ModuleDrainageNetwork - ReadDataFile - ERR31'
! endif
!
!
! !Gets flag of DT is limited by the courant number
! call GetData(Me%LimitDTCourant, &
! Me%ObjEnterData, flag, &
! keyword = 'LIMIT_DT_COURANT', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = .false., &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR32'
!
! if (Me%LimitDTCourant) then
!
! !Gets Maximum allowed Courant Number
! call GetData(Me%MaxCourant, &
! Me%ObjEnterData, flag, &
! keyword = 'MAX_COURANT', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = 1.0, &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR33'
!
! endif
!
! !Gets flag of DT is limited by the volume variation
! call GetData(Me%LimitDTVariation, &
! Me%ObjEnterData, flag, &
! keyword = 'LIMIT_DT_VARIATION', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromFile, &
! Default = .true., &
! STAT = STAT_CALL)
! if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR34'
!
call GetData(Me%AerationEquation, &
Me%ObjEnterData, flag, &
Keyword ='AERATION_METHOD', &
SearchType = FromFile, &
ClientModule = 'DrainageNetwork', &
Default = PoolAndRifle_, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR35'
if (Me%AerationEquation /= PoolAndRifle_ .and. Me%AerationEquation /= ChannelControled_) then
write (*,*)'Invalid O2 Aeration Method'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR28'
endif
call GetData(Me%T90Var_Method, &
Me%ObjEnterData, flag, &
Keyword = 'T90_DECAY_MODEL', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = Canteras, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR36'
if (Me%T90Var_Method == Constant) then
call GetData(Me%T90, &
Me%ObjEnterData, flag, &
Keyword = 'T90', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = 7200., &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR37'
endif
call GetData(Me%ShadingFactor, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'SHADING_FACTOR', &
Default = 1.0, &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR38'
call GetData(Me%ComputeOptions%TransmissionLosses, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'TRANSMISSION_LOSSES', &
Default = .false., &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR39'
call GetData(Me%ComputeOptions%RemoveOverTop, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'REMOVE_OVERTOP', &
Default = .false., &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR40'
call GetData(Me%ComputeOptions%CalcFractionSediment, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'FRACTION_SEDIMENT', &
Default = .false., &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR41'
if (Me%ComputeOptions%TransmissionLosses) then
call GetData(Me%HydraulicConductivity, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'HYDRAULIC_CONDUCTIVITY', &
Default = 1.e-5, &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR42'
endif
!Reads Global Toxicity Computation Method
call GetData(AuxString, Me%ObjEnterData, flag, &
keyword = 'GLOBAL_TOXICITY', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 'SUM', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR43'
select case (trim(adjustl(AuxString)))
case ("Max", "MAX", "max")
Me%GlobalToxicityEvolution = 'MAX'
case ("Sum", "SUM", "sum")
Me%GlobalToxicityEvolution = 'SUM'
case ("Riskratio", "RiskRatio", "RISKRATIO", "riskratio")
Me%GlobalToxicityEvolution = 'RISKRATIO'
case default
write(*,*)'Invalid option for keyword GLOBAL_TOXICITY'
stop 'ModuleDrainageNetwork - ReadDataFile - ERR44'
end select
!Reads Global GeoConversation Factor (Lat/ to Meters) rough estimation
call GetData(GeoConversationFactor, Me%ObjEnterData, flag, &
keyword = 'GEO_CONVERSATION_FACTOR', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR45'
if (flag == 1) then
call SetError(WARNING_, INTERNAL_, 'The keyword GEO_CONVERSATION_FACTOR is obselete and not used any more', ON)
endif
!Output Hydrodynamic properties
call GetData(Me%OutputHydro, Me%ObjEnterData, flag, &
keyword = 'OUTPUT_HYDRO', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = .FALSE., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR46'
!IN PROGRESS
!Sets Integrated Output Time
call GetOutPutTime(Me%ObjEnterData, &
CurrentTime = Me%CurrentTime, &
EndTime = Me%EndTime, &
keyword = 'INTEGRATION_TIME', &
SearchType = FromFile, &
OutPutsTime = Me%IntegratedOutput%OutTime, &
OutPutsOn = Me%IntegratedOutput%Yes, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR47.0'
if (Me%IntegratedOutput%Yes) then
call ReadFileName('DRAINAGE_NETWORK_INT_HDF', Me%Files%IntegratedHDFFile, &
Message = "Drainage Network Integration HDF File", &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ReadDataFile - ERR47.1'
endif
!Sets 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 'ModuleDrainageNetwork - ReadDataFile - ERR47'
!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 - ModuleDrainageNetwork - ERR48'
call GetData(Me%OutPut%RestartFormat, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'RESTART_FILE_FORMAT', &
Default = HDF_, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR48.5'
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 - ModuleDrainageNetwork - ERR48.7'
endif
call GetData(Me%OutPut%RestartOverwrite, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'RESTART_FILE_OVERWRITE', &
Default = .true., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR49'
call GetData(Me%Output%ComputeFlowFrequency, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'OUTPUT_FLOW_FREQUENCY', &
Default = .false., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR50'
if (Me%Output%ComputeFlowFrequency) then
!Reads Begin Time for frequency analisys
call GetData(Me%Output%FlowFrequency%StartDate, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'FLOW_FREQUENCY_STARTDATE', &
Default = Me%BeginTime, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR55'
call GetData(Me%Output%FlowFrequency%StopDate, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'FLOW_FREQUENCY_ENDDATE', &
Default = Me%EndTime, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR60'
call GetData(Me%Output%FlowFrequency%MinimumFlow, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'FLOW_FREQUENCY_MINIMUMFLOW', &
Default = 0.0, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR65'
endif
!to evapotrnaspirate from reach - in drying pools where vegetation accumulates and removes water
call GetData(Me%ComputeOptions%EVTPFromReach, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'EVTP_FROM_REACH', &
Default = .false., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR70'
if (Me%ComputeOptions%EVTPFromReach) then
!The EVTP_FROM_REACH is disabled because it will not work since REACH%EVTP is never actualized?
write (*,*) 'EVTP_FROM_REACH is disabled'
stop 'ReadDataFile - ModuleDrainageNetwork - ERR71'
!maximum depth to happen evtp (vegetation only installs in low flow conditions)
call GetData(Me%EVTPMaximumDepth, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'EVTP_MAXIMUM_DEPTH', &
Default = 0.1, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR80'
!crop coefficient - multiply by potential evapotransp.
call GetData(Me%EVTPCropCoefficient, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'EVTP_CROP_COEF', &
Default = 1.0, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR90'
endif
call GetData(Me%Output%ComputeIntegratedFlow, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'INTEGRATE_FLOW', &
Default = .false., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR95'
if (Me%Output%ComputeIntegratedFlow) then
call GetData(Me%Output%IntFlow%IntFlowDTOutput, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'INTEGRATE_FLOW_DT', &
Default = 86400., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR95b'
!first output date is current (beggining)
Me%Output%IntFlow%IntFlowNextOutput = Me%BeginTime + Me%Output%IntFlow%IntFlowDTOutput
endif
!If linked to a StormWaterModel
call GetData(Me%ComputeOptions%StormWaterModelLink, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'STORM_WATER_MODEL_LINK', &
Default = .false., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR100'
!If limit flow to criticl one
call GetData(Me%ComputeOptions%LimitToCriticalFlow, &
Me%ObjEnterData, &
flag, &
SearchType = FromFile, &
keyword = 'LIMIT_TO_CRITICAL_FLOW', &
Default = .true., &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadDataFile - ModuleDrainageNetwork - ERR110'
end subroutine ReadDataFile
!---------------------------------------------------------------------------
subroutine ReadConvergenceParameters
!Local-----------------------------------------------------------------
integer :: STAT_CALL, &
iflag, &
STABILIZE_COEFFICIENT_flag
real :: dummy_real
!----------------------------------------------------------------------
!----------------------------------------------------------------------
!Find deprecated keywords in data file
!----------------------------------------------------------------------
call GetData(dummy_real, &
Me%ObjEnterData, STABILIZE_COEFFICIENT_flag, &
SearchType = FromFile, &
keyword ='STABILIZE_COEFFICIENT', &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR010")
if (STABILIZE_COEFFICIENT_flag > 0) then
write (*,*) '======================================================================='
write (*,*) 'The following deprecated keywords were found in DrainageNetwork data file:'
write (*,*) ''
if (STABILIZE_COEFFICIENT_flag > 0) &
write(*,*) 'STABILIZE_COEFFICIENT: Use STABILIZE_MIN_FACTOR instead.'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR070")
endif
!----------------------------------------------------------------------
!Read convergence options
!----------------------------------------------------------------------
call GetData(Me%CV%Stabilize, &
Me%ObjEnterData, iflag, &
keyword = 'STABILIZE', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR080")
if (iflag <= 0) then
write(*,*) 'WARNING: Missing STABILIZE keyword in Drainage Network input data file.'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR081")
endif
if (Me%CV%Stabilize) then
!Maximum change of water content (in %) allowed in one time step.
call GetData(Me%CV%StabilizeFactor, &
Me%ObjEnterData, iflag, &
keyword = 'STABILIZE_FACTOR', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = 0.1, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR082")
if (Me%CV%StabilizeFactor < 0.0 .or. Me%CV%StabilizeFactor > 1.0) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR083")
call GetData(Me%CV%MinimumValueToStabilize, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'STABILIZE_MIN_FACTOR', &
default = 0.05, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR084")
if (Me%CV%MinimumValueToStabilize < 0.0) then
write (*,*)'Invalid Minimun Water Column to Stabilize value [STABILIZE_MIN]'
write (*,*)'Value must be greater than 0.0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR085")
endif
call GetData(dummy_real, &
Me%ObjEnterData, iflag, &
keyword = 'STABILIZE_RESTART_FACTOR', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = 0., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR086")
if (dummy_real <= 0.) then
Me%CV%MinToRestart = 0
else
Me%CV%MinToRestart = max(int(dummy_real * Me%TotalNodes), 0)
endif
call GetData(Me%CV%CheckDecreaseOnly, &
Me%ObjEnterData, iflag, &
keyword = 'CHECK_DEC_ONLY', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = .false., &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR087")
endif
!Number of iterations threshold for starting to ask for a lower DT
call GetData(Me%CV%MinIterations, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword ='MIN_ITERATIONS', &
Default = 1, &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR090")
if (Me%CV%MinIterations < 1) then
write (*,*)'Invalid Minimun Iterations value [MIN_ITERATIONS]'
write (*,*)'Value must be greater than 0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR091")
endif
!Number of iterations threshold that causes the model to stop
call GetData(Me%CV%MaxIterations, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword ='MAX_ITERATIONS', &
Default = 1024, &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR100")
if (Me%CV%MaxIterations < Me%CV%MinIterations) then
write (*,*)'Invalid Maximun Iterations value [MAX_ITERATIONS]'
write (*,*)'Value must be greater than the value of MIN_ITERATIONS'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR101")
endif
call GetData(Me%CV%IgnoreMaxIterations, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword ='IGNORE_MAX_ITERATIONS', &
Default = .false., &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR102")
!% of the maximun iterations that causes the DT to be cut to the value of one internal time step
call GetData(dummy_real, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword = 'DT_CUT_FACTOR', &
default = 0.1, &
ClientModule = 'ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR110")
if (dummy_real <= 0.0 .or. dummy_real > 1.0) then
write (*,*)'Invalid DT Cut Factor [DT_CUT_FACTOR]'
write (*,*)'Value must be >= 0.0 and < 1.0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR111")
endif
Me%CV%StabilizeHardCutLimit = dummy_real * Me%CV%MaxIterations
!Internal Time Step Split
call GetData(Me%CV%DTSplitFactor, &
Me%ObjEnterData, iflag, &
keyword = 'DT_SPLIT_FACTOR', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = 2.0, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ReadConvergenceParameters - ModuleDrainageNetwork - ERR120'
if (Me%CV%DTSplitFactor <= 1.0) then
write (*,*)'Invalid DT Split Factor [DT_SPLIT_FACTOR]'
write (*,*)'Value must be greater then 1.0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR121")
endif
call GetData(dummy_real, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword ='DT_FACTOR', &
Default = 1.25, &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR130")
if (dummy_real <= 1.0) then
write (*,*)'Invalid DT Factor [DT_FACTOR]'
write (*,*)'Value must be greater then 1.0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR131")
endif
call GetData(Me%CV%DTFactorUp, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword ='DT_FACTOR_UP', &
Default = dummy_real, &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR140")
if (Me%CV%DTFactorUp <= 1.0) then
write (*,*)'Invalid DT Factor Up [DT_FACTOR_UP]'
write (*,*)'Value must be greater then 1.0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR141")
endif
call GetData(Me%CV%DTFactorDown, &
Me%ObjEnterData, iflag, &
SearchType = FromFile, &
keyword ='DT_FACTOR_DOWN', &
Default = dummy_real, &
ClientModule ='ModuleDrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR150")
if (Me%CV%DTFactorDown <= 1.0) then
write (*,*)'Invalid DT Factor Down [DT_FACTOR_DOWN]'
write (*,*)'Value must be greater then 1.0'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR151")
endif
call GetData(Me%CV%LimitDTCourant, &
Me%ObjEnterData, iflag, &
keyword = 'LIMIT_DT_COURANT', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR180")
if (iflag <= 0) then
write(*,*) 'WARNING: Missing LIMIT_DT_COURANT keyword in Drainage Network input data file.'
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR181")
endif
if (Me%CV%LimitDTCourant) then
!Gets Maximum allowed Courant Number
call GetData(Me%CV%MaxCourant, &
Me%ObjEnterData, iflag, &
keyword = 'MAX_COURANT', &
ClientModule = 'ModuleDrainageNetwork', &
SearchType = FromFile, &
Default = 1.0, &
STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) &
call SetError(FATAL_, KEYWORD_, "ReadConvergenceParameters - ModuleDrainageNetwork - ERR182")
endif
!----------------------------------------------------------------------
end subroutine ReadConvergenceParameters
!--------------------------------------------------------------------------
subroutine ConstructDownstreamBoundary
!Arguments--------------------------------------------------------------
!Local------------------------------------------------------------------
integer :: flag, STAT_CALL
character(len=StringLength) :: AuxString
call GetData(Me%Downstream%Boundary, &
Me%ObjEnterData, flag, &
keyword = 'DOWNSTREAM_BOUNDARY', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = ZeroDepthGradient, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR01'
if1: if (Me%Downstream%Boundary == ImposedWaterLevel .or. Me%Downstream%Boundary == ImposedVelocity) then
!Reads Time Evolution
call GetData(AuxString, Me%ObjEnterData, flag, &
keyword = 'FILE_IN_TIME', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = 'None', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR03'
select case (trim(adjustl(AuxString)))
case ("None", "NONE", "none")
Me%Downstream%Evolution = None
case ("Timeserie", "TIMESERIE", "timeserie", "TimeSerie")
Me%Downstream%Evolution = ReadTimeSerie
if (Me%Downstream%Boundary == ImposedVelocity) &
stop 'not ready - ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR04a'
case ("OpenMI", "OPENMI", "openmi", "OpenMi")
Me%Downstream%Evolution = OpenMI
case default
write(*,*)'Invalid option for keyword FILE_IN_TIME'
stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR04'
end select
call GetData(Me%Downstream%DefaultValue, Me%ObjEnterData, flag, &
keyword = 'DEFAULT_VALUE', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
Default = FillValueReal, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR05'
if (flag == 0) then
write(*,*)'Please define default value for downstream boundary'
stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR06'
end if
if2: if (Me%Downstream%Evolution == ReadTimeSerie) then
call GetData(Me%Downstream%FileName, &
Me%ObjEnterData , flag, &
SearchType = FromFile, &
keyword = 'FILENAME', &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR07'
if (flag==0)then
write(*,*)'Time Serie File Name not given'
stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR08'
endif
call GetData(Me%Downstream%DataColumn, &
Me%ObjEnterData , flag, &
SearchType = FromFile, &
keyword = 'DATA_COLUMN', &
ClientModule = 'DrainageNetwork', &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR09'
if (flag==0)then
write(*,*)'Data Column not given'
stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR10'
endif
!Starts Time Serie
call StartTimeSerieInput(Me%Downstream%ObjTimeSerie, &
Me%Downstream%FileName, &
Me%ObjTime, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR11'
end if if2
elseif (Me%Downstream%Boundary == Flow_vs_WaterLevel)then if1
!Me%Downstream%Evolution = Flow_vs_WaterLevelFile
stop 'ModuleDrainageNetwork - ConstructDownstreamBoundary - ERR12'
endif if1
end subroutine ConstructDownstreamBoundary
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine ConstructNetwork
!Local------------------------------------------------------------------
integer :: flag, STAT_CALL
call ConstructEnterData (Me%Files%ObjEnterDataNetwork, Me%Files%Network, STAT = STAT_CALL)
if (STAT_CALL /= SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNetwork - ERR01'
!Checks for the COORD_TIP
call GetData(Me%CoordType, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'COORDINATE_TYPE', &
ClientModule = 'DrainageNetwork', &
SearchType = FromFile, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNetwork - ERR02'
if (flag == 0 .or. (Me%CoordType /= 1 .and. Me%CoordType /= 2)) then
write(*,*)'The Drainage Network does not contain a valid specification for the coordinate system.'
write(*,*)'Please set the keyword COORDINATE_TYPE to a valid option (file Drainage Network.dnt)'
write(*,*)'Allowed options are:'
write(*,*)'COORDINATE_TYPE : 1 ! Geographic Coordinates'
write(*,*)'COORDINATE_TYPE : 2 ! Projected Coordinates'
call SetError (FATAL_, INTERNAL_, "Invalid Coordinates")
endif
!Rewinds buffer for subsequent readings
call RewindBuffer(Me%Files%ObjEnterDataNetwork, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNetwork - ERR03'
call ConstructNodeList
call ConstructReachList
call ConnectNetwork
!if nodes were changed for DTM consistency give the user feedback
if (Me%ChangedNodes) call WriteNewDrainageNetwork()
if (Me%NumericalScheme == ImplicitScheme) then
call OrderNodes
call ReconnectNetwork
call WriteOrderedNodes
end if
!Checks consistency and finds outlet Node / Reach Position
call CountOutlets ()
end subroutine ConstructNetwork
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine ConstructNodeList
!Arguments--------------------------------------------------------------
!Local------------------------------------------------------------------
integer :: ClientNumber
logical :: BlockFound
integer :: FirstLine, LastLine
integer :: STAT_CALL, NodePos
!-----------------------------------------------------------------------
call CountTotalNodes
nullify (Me%Nodes)
allocate (Me%Nodes (1:Me%TotalNodes))
NodePos = 0
do1: do
call ExtractBlockFromBuffer(Me%Files%ObjEnterDataNetwork, ClientNumber, &
BeginNode, EndNode, BlockFound, &
FirstLine, LastLine, STAT_CALL)
if1: if (STAT_CALL .EQ. SUCCESS_) then
if2: if (BlockFound) then
NodePos = NodePos + 1
call ConstructNode (NodePos)
else if2
if (NodePos /= Me%TotalNodes) stop 'ModuleDrainageNetwork - ConstructNodeList - ERR01'
call Block_Unlock(Me%Files%ObjEnterDataNetwork, ClientNumber, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) &
stop 'ModuleDrainageNetwork - ConstructNodeList - ERR02'
exit do1 !No more blocks
end if if2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then if1
stop 'ModuleDrainageNetwork - ConstructNodeList - ERR02.'
end if if1
end do do1
if (Me%CheckNodes) call CheckNodesConsistency
end subroutine ConstructNodeList
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine CountTotalNodes
!This subroutine counts the total number of nodes and checks the
!existence of valid and repeated NodeIDs
!Local------------------------------------------------------------------
integer :: ClientNumber
logical :: BlockFound
integer :: FirstLine, LastLine
integer :: STAT_CALL
integer :: NodeID, OldNodeID
!integer :: MaxNodeID, MinNodeID
integer :: flag
Me%TotalNodes = 0
!MinNodeID = - null_int
!MaxNodeID = null_int
OldNodeID = null_int
do1: do
call ExtractBlockFromBuffer(Me%Files%ObjEnterDataNetwork, ClientNumber, &
BeginNode, EndNode, BlockFound, &
FirstLine, LastLine, STAT_CALL)
if1: if (STAT_CALL .EQ. SUCCESS_) then
if2: if (BlockFound) then
!Gets ID
call GetData(NodeID, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'ID', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - CountTotalNodes - ERR01'
if (flag /= 1) then
write (*,*)'Invalid Node ID [ID]'
stop 'ModuleDrainageNetwork - CountTotalNodes - ERR02'
endif
Me%TotalNodes = Me%TotalNodes + 1
!if (NodeID .LT. MinNodeID ) MinNodeID = NodeID
!if (NodeID .GT. MaxNodeID ) MaxNodeID = NodeID
if (NodeID .EQ. OldNodeID ) then
write (*,*) 'Repeated Node ID = ', NodeID
stop 'ModuleDrainageNetwork - CountTotalNodes - ERR03'
else
OldNodeID = NodeID
end if
else if2
!if (MinNodeID.NE. 1) then
! write (*,*) 'Inconsistency in Node IDs - Missing NodeID = 1'
! stop 'ModuleDrainageNetwork - CountTotalNodes - ERR04'
!else if (MaxNodeID.NE. Me%TotalNodes) then
! write (*,*) 'Inconsistency in Node IDs - Missing NodeID =', Me%TotalNodes
! stop 'ModuleDrainageNetwork - CountTotalNodes - ERR05'
!end if
call Block_Unlock(Me%Files%ObjEnterDataNetwork, ClientNumber, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - CountTotalNodes - ERR01'
call RewindBuffer(Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - CountTotalNodes - ERR02'
exit do1 !No more blocks
end if if2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then if1
stop 'ModuleDrainageNetwork - CountTotalNodes - ERR03.'
end if if1
end do do1
end subroutine CountTotalNodes
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine ConstructNode (NodePos)
!Arguments--------------------------------------------------------------
integer, intent(IN) :: NodePos
!External---------------------------------------------------------------
type (T_Node), pointer :: NewNode
integer :: STAT_CALL
integer :: flag, NStations
real, dimension (2) :: AuxCoord
logical :: ComputeElevation
!Local------------------------------------------------------------------
nullify (NewNode)
NewNode => Me%Nodes (NodePos)
call GetData(NewNode%ID, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'ID', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR01'
if (flag /= 1) then
write (*,*)'Invalid Node ID [ID]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR02'
endif
call GetData(NewNode%StationName, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'ASSOCIATEDSTATION_NAME', &
default = null_str, &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR01a'
if (NewNode%StationName /= null_str) Me%WriteMaxStationValues = .TRUE.
!Gets Location
if (NewNode%X.EQ.null_real.AND. NewNode%Y.EQ.null_real) then
call GetData(AuxCoord, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'COORDINATES', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR03'
if (flag .EQ. 2) then
NewNode%X = AuxCoord(1)
NewNode%Y = AuxCoord(2)
else
write(*,*) 'Invalid Node Coordenates [COORDINATES]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR04'
end if
else
write (*,*) 'Repeated Node = ', NewNode%ID
stop 'ModuleDrainageNetwork - ConstructNode - ERR05'
end if
if (Me%HasGrid) then
!Gets associated Grid Point I
call GetData(NewNode%GridI, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'GRID_I', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
default = null_int, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR06'
!Gets associated Grid Point J
call GetData(NewNode%GridJ, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'GRID_J', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
default = null_int, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR07'
if(NewNode%GridI .ne. null_int .AND. NewNode%GridJ .ne. null_int) then
NewNode%HasGrid = .TRUE.
endif
!I Left Bank
call GetData(NewNode%LeftGridI, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'LEFT_GRID_I', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
default = null_int, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) &
stop 'ModuleDrainageNetwork - ConstructNode - ERR60b'
!J Left Bank
call GetData(NewNode%LeftGridJ, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'LEFT_GRID_J', &
ClientModule = 'DrainageNetwork', &
default = null_int, &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) &
stop 'ModuleDrainageNetwork - ConstructNode - ERR60c'
!I Right Bank
call GetData(NewNode%RightGridI, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'RIGHT_GRID_I', &
ClientModule = 'DrainageNetwork', &
default = null_int, &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_ ) &
stop 'ModuleDrainageNetwork - ConstructNode - ERR60d'
!J Left Bank
call GetData(NewNode%RightGridJ, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'RIGHT_GRID_J', &
ClientModule = 'DrainageNetwork', &
default = null_int, &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) &
stop 'ModuleDrainageNetwork - ConstructNode - ERR60e'
if(NewNode%LeftGridI .ne. null_int .AND. NewNode%LeftGridJ .ne. null_int .AND. &
NewNode%RightGridI .ne. null_int .AND. NewNode%RightGridJ .ne. null_int ) then
NewNode%HasTwoGridPoints = .TRUE.
endif
endif
!Singularity Coef - % available vertical area = 1 - % reduction Av by singularity
call GetData(NewNode%SingCoef, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'SING_COEF', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
default = 1.0, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR08a'
if (NewNode%SingCoef <= AlmostZero) then
write (*,*)'Invalid Singularity Coefficient [SING_COEF]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR22'
endif
!Cross Section Type
call GetData(NewNode%CrossSection%Form, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'CROSS_SECTION_TYPE', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
default = Trapezoidal, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR09'
ifXS: if (NewNode%CrossSection%Form == Trapezoidal .or. &
NewNode%CrossSection%Form == TrapezoidalFlood) then
!Bottom Width
call GetData(NewNode%CrossSection%BottomWidth, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'BOTTOM_WIDTH', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR10'
if (flag /= 1) then
write (*,*)'Invalid Node Bottom Width [BOTTOM_WIDTH]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR10a'
endif
if ( NewNode%CrossSection%BottomWidth == 0.0) NewNode%CrossSection%BottomWidth = AllmostZero
!Top Width
call GetData(NewNode%CrossSection%TopWidth, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'TOP_WIDTH', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
Default = null_real, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR11'
if (flag /= 1 ) then
write (*,*)'Invalid Node Top Width [TOP_WIDTH]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR11a'
endif
!Height
call GetData(NewNode%CrossSection%Height, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'HEIGHT', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR12'
if (flag /= 1) then
write (*,*)'Invalid Node Height [HEIGHT]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR12a'
endif
!if (.not. NewNode%HasGrid) then
! call GetData(NewNode%CrossSection%TerrainLevel, &
! Me%Files%ObjEnterDataNetwork, flag, &
! keyword = 'TERRAIN_LEVEL', &
! ClientModule = 'DrainageNetwork', &
! SearchType = FromBlock, &
! STAT = STAT_CALL)
! if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR08'
! if (flag /= 1) then
! write (*,*)'Invalid Node Terrain Level [TERRAIN_LEVEL]'
! stop 'ModuleDrainageNetwork - ConstructNode - ERR21'
! endif
!endif
!
!Commented logic below. Now the Node has either:
! - a given terrain level if we run without DTM or if the node lies outside the DTM
! - the terrain level from the DTM.
!if DN was imposed over DTM (if associated(Me%ExtVar%Topography))
!meaning that drainage network may have been built from DTM different than currently used (e.g. with depressions removed),
!need to check terrain level and height to be consistent with DTM used
if (associated(Me%ExtVar%Topography) .AND. NewNode%HasGrid) then
NewNode%CrossSection%TerrainLevel = Me%ExtVar%Topography(NewNode%GridI, NewNode%GridJ)
else
call GetData(NewNode%CrossSection%TerrainLevel, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'TERRAIN_LEVEL', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR08'
if (flag /= 1) then
write (*,*)'Invalid Node Terrain Level [TERRAIN_LEVEL]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR21'
endif
endif
!
! if (Me%ExtVar%Topography(NewNode%GridI, NewNode%GridJ) /= NewNode%CrossSection%TerrainLevel) then
!
! heightDif = Me%ExtVar%Topography(NewNode%GridI, NewNode%GridJ) - NewNode%CrossSection%TerrainLevel
!
! NewNode%CrossSection%TerrainLevel = Me%ExtVar%Topography(NewNode%GridI, NewNode%GridJ)
! NewNode%CrossSection%Height = NewNode%CrossSection%Height + heightDif
!
! if (NewNode%CrossSection%Height < 0) then
! write(*,*)'Negative node cross section height after Topography check'
! write(*,*)'in node ', NewNode%ID
! stop 'ModuleDrainageNetwork - ConstructNode - ERR12b'
! endif
!
! Me%ChangedNodes = .true.
! write(AuxString,*) 'Forcing river points from DN, Node changed to fit DTM ', NewNode%ID
! call SetError (WARNING_, INTERNAL_, AuxString , OFF)
!
! endif
!endif
NewNode%CrossSection%Slope = (( NewNode%CrossSection%TopWidth &
- NewNode%CrossSection%BottomWidth ) &
/ 2 ) / NewNode%CrossSection%Height
NewNode%CrossSection%BottomLevel = NewNode%CrossSection%TerrainLevel - NewNode%CrossSection%Height
if (NewNode%CrossSection%Form == TrapezoidalFlood) then
!MiddleWidth
call GetData(NewNode%CrossSection%MiddleWidth, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'MIDDLE_WIDTH', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR13'
if (flag /= 1) then
write (*,*)'Invalid Node Middle Width [MIDDLE_WIDTH]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR13a'
endif
!MiddleHeight
call GetData(NewNode%CrossSection%MiddleHeight, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'MIDDLE_HEIGHT', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR14'
if (flag /= 1) then
write (*,*)'Invalid Node Middle Height [MIDDLE_HEIGHT]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR14a'
endif
if (NewNode%CrossSection%MiddleHeight >= NewNode%CrossSection%Height) then
write (*,*)'Node Middle Height must be <= than Height'
stop 'ModuleDrainageNetwork - ConstructNode - ERR14b'
endif
NewNode%CrossSection%Slope = (( NewNode%CrossSection%MiddleWidth &
- NewNode%CrossSection%BottomWidth ) &
/ 2 ) / NewNode%CrossSection%MiddleHeight
NewNode%CrossSection%SlopeTop = (( NewNode%CrossSection%TopWidth &
- NewNode%CrossSection%MiddleWidth ) &
/ 2 ) &
/ (NewNode%CrossSection%Height - &
NewNode%CrossSection%MiddleHeight)
endif
elseif (NewNode%CrossSection%Form == Tabular) then !ifXS
call GetData(NewNode%CrossSection%NStations, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'N_STATIONS', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR15'
if (flag /= 1 .or. NewNode%CrossSection%NStations <= 3) then
write (*,*)'Minimum mumber of station points for Tabular Cross Section is 3 [N_STATIONS].'
write (*,*)'in node ', NewNode%ID
stop 'ModuleDrainageNetwork - ConstructNode - ERR15a'
endif
NStations = NewNode%CrossSection%NStations
allocate(NewNode%CrossSection%Station (NStations))
allocate(NewNode%CrossSection%Elevation (NStations))
allocate(NewNode%CrossSection%BankSlope (NStations))
NewNode%CrossSection%Station = null_real
NewNode%CrossSection%Elevation = null_real
NewNode%CrossSection%BankSlope = null_real
call GetData(NewNode%CrossSection%Station, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'STATION', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR16'
if (flag /= NStations) then
write(*,*) 'Invalid Node Station data [STATION]'
stop 'ModuleDrainageNetwork - ConstructNode - ERR16a'
end if
call GetData(NewNode%CrossSection%Elevation, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'ELEVATION', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ModuleDrainageNetwork - ConstructNode - ERR17'
if (flag == 0) then
ComputeElevation = .true.
call GetData(NewNode%CrossSection%Elevation, &
Me%Files%ObjEnterDataNetwork, flag, &
keyword = 'LEVEL', &
ClientModule = 'DrainageNetwork', &
SearchType = FromBlock, &
STA