Skip to content
Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
6404 lines (4517 sloc) 294 KB
!------------------------------------------------------------------------------
! IST/MARETEC, Water Modelling Group, Mohid modelling system
!------------------------------------------------------------------------------
!
! TITLE : Mohid Model
! PROJECT : Mohid Base 1
! MODULE : CEQUALW2
! URL : http://www.mohid.com
! AFFILIATION : IST/MARETEC, Marine Modelling Group
! DATE : May 2003
! REVISION : Pedro Pina, Luis Fernandes - v4.0
! DESCRIPTION : U.S. Army Corps of Engineers zero-dimensional model for primary production
!
!------------------------------------------------------------------------------
!
!This program is free software; you can redistribute it and/or
!modify it under the terms of the GNU General Public License
!version 2, as published by the Free Software Foundation.
!
!This program is distributed in the hope that it will be useful,
!but WITHOUT ANY WARRANTY; without even the implied warranty of
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!GNU General Public License for more details.
!
!You should have received a copy of the GNU General Public License
!along with this program; if not, write to the Free Software
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!------------------------------------------------------------------------------
Module ModuleCEQUALW2
use ModuleGlobalData
use ModuleFunctions, only: OxygenSaturationCEQUALW2
use ModuleEnterData
implicit none
private
!subroutines---------------------------------------------------------------
!Constructor
public :: StartCEQUALW2
private :: AllocateInstance
private :: ReadWaterColumnData
private :: ReadBenthicData
private :: ReadBenthicGlobalVariables
private :: ReadSODData
private :: ReadDetritusParameters
private :: ReadAmmoniaParameters
private :: ReadPhosphorusParameters
private :: ReadDsilicaParameters
private :: ReadICarbonParameters
private :: PropertyIndexNumber
private :: BenthicPropertyIndexNumber
private :: RateIndexNumber
private :: ReadGlobalVariables
private :: ConstructAlgaeClasses
private :: AddAlgae
private :: ReadAlgaeParameters
private :: ConstructEpiphytonClasses
private :: AddEpiphyton
private :: ReadEpiphytonParameters
private :: ReadOMParameters
private :: ReadSilicaParameters
private :: ReadOxygenParameters
private :: ReadNitrogenParameters
private :: ConstructPropertyList
private :: ConstructBenthicPropertyList
!Selector
public :: GetDTCEQUALW2
public :: GetCEQUALW2Options
public :: GetCEQUALW2Size
public :: GetCEQUALW2PropIndex
public :: GetCEQUALW2PropertyList
public :: GetCEQUALW2RateFlux
public :: UnGetCEQUALW2RateFlux
public :: UngetCEQUALW2
!Modifier
! Water Column Processes
public :: CEQUALW2
private :: TemperatureRateMultipliers
private :: ComputeKineticRates
private :: ComputePhosphorus
private :: ComputeAmmonia
private :: ComputeNitrate
private :: ComputeDissolvedSilica
private :: ComputeParticulateSilica
private :: ComputeRefDOM
private :: ComputeLabDOM
private :: ComputeLabPOM
private :: ComputeRefPOM
private :: ComputeAlgae
private :: ComputeBOD
private :: ComputeDissolvedOxygen
private :: ComputeICarbon
private :: ComputeDetritus
private :: ComputeEpiphyton
private :: ComputepH_CO2
! Benthic Processes
public :: CEQUALW2Benthic
private :: ComputeBenthicKineticRates
private :: ComputeBenthicPhosphorus
private :: ComputeBenthicAmmonia
private :: ComputeBenthicDissolvedSilica
private :: ComputeBenthicDissolvedOxygen
private :: ComputeBenthicICarbon
private :: ComputeBenthicDetritus
! Auxiliar Functions
private :: Rising
private :: Falling
!Destructor
public :: KillCEQUALW2
private :: DeallocateInstance
!Management
private :: Ready
private :: LocateObjCEQUALW2
!Interfaces
private :: UngetCEQUALW2_1D_Int
interface UngetCEQUALW2
module procedure UngetCEQUALW2_1D_Int
end interface UngetCEQUALW2
!Types---------------------------------------------------------------------
private :: T_ID
type T_ID
character(len=StringLength) :: Name
integer :: IDNumber
end type T_ID
private :: T_Size
type T_Size
integer :: PropLB = null_int
integer :: PropUB = null_int
integer :: ArrayLB = null_int
integer :: ArrayUB = null_int
end type T_Size
private :: T_RateIndex
type T_RateIndex
integer :: ANLim
integer :: APLim
integer :: ASLim
integer :: ALightLim
integer :: AOverallLim
integer :: AGR
integer :: AMR
integer :: AER
integer :: ARR
integer :: ENLim
integer :: EPLim
integer :: ESLim
integer :: ELightLim
integer :: EOverallLim
integer :: NH4D
integer :: NO3D
integer :: LDOMD
integer :: RDOMD
integer :: LPOMD
integer :: RPOMD
integer :: LRDOMD
integer :: LRPOMD
integer :: CBODD
integer :: PO4ER
integer :: PO4EG
integer :: PO4AR
integer :: PO4AG
integer :: PO4OM
integer :: PO4BOD
integer :: NH4ER
integer :: NH4EG
integer :: NH4AR
integer :: NH4AG
integer :: NH4OM
integer :: NH4BOD
integer :: NO3AG
integer :: NO3EG
integer :: DSIAG
integer :: DSIEG
integer :: DSID
integer :: PSIAM
integer :: PSID
integer :: LDOMAP
integer :: LDOMEP
integer :: LPOMAP
integer :: DOAP
integer :: DOEP
integer :: DOAR
integer :: DOER
integer :: DOOM
integer :: DONIT
integer :: ICarbonAP
integer :: ICarbonEP
integer :: ICarbonBOD
end type T_RateIndex
private :: T_Rate
type T_Rate
integer :: LB = null_int
integer :: UB = null_int
integer, pointer, dimension(: ) :: Match
real, pointer, dimension (:,:) :: Value
logical :: compute =.false.
type(T_RateIndex ) :: MohidIndex
type(T_RateIndex ) :: CequalIndex
end type T_Rate
private :: T_PropIndex
type T_PropIndex
integer :: ICarbon = null_int
integer :: pomref = null_int !Refractory Particulate Organic Matter
integer :: pomlab = null_int !Labile POM
integer :: domlab = null_int !Labile Dissolved OM
integer :: domref = null_int !Refractory DOM
integer :: Ammonia = null_int
integer :: Nitrate = null_int
integer :: Phosphorus = null_int
integer :: Oxygen = null_int
integer :: BOD = null_int !Biochemical Oxygen Demand
integer :: sipart = null_int !Particulate Silica
integer :: sidiss = null_int !Dissolved Silica
integer :: pH = null_int
integer :: CO2 = null_int
integer :: CO3 = null_int
integer :: HCO3 = null_int
integer :: Detritus = null_int
end type T_PropIndex
private :: T_Compute
type T_Compute
logical :: Algae = OFF
logical :: Epiphyton = OFF
logical :: Nitrogen = OFF
logical :: Phosphorus = OFF
logical :: OrganicMatter = OFF
logical :: ICarbon = OFF
logical :: BOD = OFF
logical :: Oxygen = ON
logical :: Silica = OFF
logical :: Detritus = OFF
end type T_Compute
private :: T_BenthicCompute
type T_BenthicCompute
logical :: Detritus = OFF
logical :: Ammonia = OFF
logical :: Phosphorus = OFF
logical :: Dsilica = OFF
logical :: Oxygen = OFF
logical :: ICarbon = OFF
end type T_BenthicCompute
private :: T_SOD
type T_SOD
logical :: UseSOD
real, pointer, dimension(: ) :: Rate
real :: T1
real :: T2
real :: K1
real :: K2
real :: PO4R
real :: NH4R
real :: SiR
real :: CO2R
real :: O2Sink
real :: TRM
logical :: DefaultO2
end type T_SOD
private :: T_External
type T_External
real, pointer, dimension(: ) :: Salinity
real, pointer, dimension(: ) :: Temperature
real, pointer, dimension(: ) :: Oxygen
real, pointer, dimension(: ) :: Alkalinity
real, pointer, dimension(: ) :: ShortWaveRadiation
real, pointer, dimension(: ) :: LightExtCoefField
real, pointer, dimension(: ) :: Thickness
real, pointer, dimension(: ) :: CellArea
real, pointer, dimension(:,:) :: Mass
end type T_External
private :: T_Algae
type T_Algae
type(T_ID) :: ID
integer :: PropIndex
! Algal Maximum Biological Rates [day^-1]
real :: AG !Growth
real :: AR !Respiration
real :: AE !Excretion
real :: AM !Mortality
!Algal saturating light intensity at maximum phtosynthetic rate [W m^-2]
real :: ASAT
!Algal half-saturation coefficients for oxygen consumption [mgO2/l]
real :: AOK1
real :: AOK2
real :: AOK3
real :: AOK4
!Algal half-saturation coefficients [g m^-3]
real :: AHSP !for Phosphurus
real :: AHSN !for Nitrate + Ammonium
real :: AHSSI !for Silica
!Algal Temperature Rate Coefficients
real :: AT1 !Lower temperature for algal growth (ºC)
real :: AT2 !Lower temperature for maximum algal growth (ºC)
real :: AT3 !Upper temperature for maximum algal growth
real :: AT4 !Upper temperature for algal growth
real :: AK1 !Fraction of algal growth rate at AT1
real :: AK2 !Fraction of maximum algal growth rate at AT2
real :: AK3 !Fraction of maximum algal growth rate at AT3
real :: AK4 !Fraction of algal growth rate at AT4
!Algal Stoichiometry
real :: AP !Algal stoichiometric coefficient for phosphorus
real :: AN !Algal stoichiometric coefficient for nitrogen
real :: AC !Algal stoichiometric coefficient for carbon
real :: ASI !Algal stoichiometric coefficient for silica
real :: APOM !Algal stoichiometric coefficient for POM
real :: O2AR
real :: O2AG
!Algal Ammonia Preference
integer :: ANEQN !Equation for preference factor (either 1 or 2)
real :: ANPR !half-saturation copreference constant
!Algal Temperature Rate Multipliers [1]
real :: ATRM !Algae Temperature Rate Multiplier
real :: ATRMR !ATMR for rising limb of curve
real :: ATRMF !ATMR for falling limb of curve
!Algal light extintion [m^-1]
real :: EXA
!Algal Growth Limitations
real,pointer, dimension(:) :: NLim !Nitrogen
real,pointer, dimension(:) :: PLim !Phosphorus
real,pointer, dimension(:) :: SLim !Silica
real,pointer, dimension(:) :: LightLim
real,pointer, dimension(:) :: OverallLim
!Algal Biological Rates [day^-1]
real :: AGR !Growth
real :: ARR !Respiration
real :: AER !Excretion
real :: AMR !Mortality
!Algal Source/sink Term
real :: ASS
!Collection of algae
type(T_Algae), pointer :: Next
end type T_Algae
private :: T_Epiphyton
type T_Epiphyton
type(T_ID) :: ID
integer :: PropIndex
! Epiphyte Maximum Biological Rates [day^-1]
real :: EG !Growth
real :: ER !Respiration
real :: EE !Excretion
real :: EM !Mortality
!Epiphyte half-saturation coefficients [g m^-3]
real :: EHSP !Half-saturation coefficient for phosphorus
real :: EHSN !for nitrates
real :: EHSSI !for silica
!Epiphyte saturating light intensity at maximum phtosynthetic rate [W m^-2]
real :: ESAT
!Epiphyte Amonia preference
real :: ENPR !half-saturation coefficient [gm^-3]
integer :: ENEQN !Equation for preference factor (1 or 2)
! Epiphyte Temperature Rate Coefficients
real :: ET1
real :: ET2
real :: ET3
real :: ET4
real :: EK1
real :: EK2
real :: EK3
real :: EK4
!Epiphyte Stoichiometry
real :: EP !Epiphyte stoichiom. coef. for phosphorus
real :: EN !Epiphyte stoichiom. coef. for nitrogen
real :: EC !Epiphyte stoichiom. coef. for carbon
real :: ESI !Epiphyte stoichiom. coef. for silica
real :: EPOM !Epiphyte stoichiom. coef. for POM
real :: O2ER
real :: O2EG
!Epiphyte Temperature Rate Multipliers
real :: ETRM !Temperature Rate Multiplier
real :: ETRMR !TRM for rising limb of curve
real :: ETRMF !TRM for falling lim of curve
!Epiphyte Growth Limitations
real,pointer, dimension(:) :: NLim !Nitrogen
real,pointer, dimension(:) :: PLim !Phosphorus
real,pointer, dimension(:) :: SLim !Silica
real,pointer, dimension(:) :: LightLim
real,pointer, dimension(:) :: OverallLim
!Epiphyte Biological Rates [s^-1]
real :: EGR !Growth
real :: ERR !Respiration
real :: EER !Excretion
real :: EMR !Mortality
!Epiphyte Source/sink Term [g m^-3 s^-1]
real :: ESS
!Collection of epiphyton
type(T_Epiphyton), pointer :: Next
end type T_Epiphyton
private :: T_CEQUALW2
type T_CEQUALW2
private
integer :: InstanceID
integer, dimension(:), pointer :: PropertyList
type(T_Size ) :: Size
type(T_PropIndex ) :: PropIndex
type(T_Rate ) :: Rate
type(T_Compute ) :: Compute
type(T_BenthicCompute) :: BenthicCompute
type(T_SOD ) :: SOD
type(T_External ) :: ExternalVar
type(T_Algae ),pointer :: FirstAlgae
type(T_Epiphyton ),pointer :: FirstEpiphyton
real :: DTDay = null_real
real :: DTSecond = null_real
real, dimension(:), pointer :: SinksSources
!Extinction Coefficients
!real :: EXH2O = null_real !Extinction for pure water, m-1
!real :: EXSS = null_real !Extinction due to inorganic suspended solids, m-1
!real :: EXOM = null_real !Extinction due to organic suspended solids, m-1
!Logical :: EXC = .false. !Read extinction coefficients, ON or OFF
!Logical :: EXIC = .false. !Interpolate extinction coefficients, ON or OFF
!Dissolved Organic Matter
real :: LDOMDK = null_real !LDOM decay rate [day^-1]
real :: RDOMDK = null_real !RDOM decay rate [day^-1]
real :: LRDDK = null_real !Labile to refractory DOM dekay rate [day^-1]
!Particulate Organic Matter
real :: LPOMDK = null_real !LPOM decay rate [day^-1]
real :: RPOMDK = null_real !RPOM decay rate [day^-1]
real :: LRPDK = null_real
!Organic Matter Stoichiometry
real :: ORGP = null_real !Stoichiometric coef. for phosphorus
real :: ORGN = null_real !Stoichiometric coef. for nitrogen
real :: ORGC = null_real !Stoichiometric coef. for carbon
real :: ORGSI = null_real !Stoichiometric coef. for silica
!Organic Matter Temperature Rate Multipliers
real :: OMT1 = null_real
real :: OMT2 = null_real
real :: OMK1 = null_real
real :: OMK2 = null_real
!Detritus Temperature Rate Multipliers
real :: DETTRM = null_real
real :: DETT1 = null_real
real :: DETT2 = null_real
real :: DETK1 = null_real
real :: DETK2 = null_real
real :: SDK = null_real
!Carbonaceous Biochemical Oxygen Demand
real :: KBOD = null_real !CBOD Decay Rate [day^-1]
real :: TBOD = null_real !BOD Temperature Rate Multiplier
real :: RBOD = null_real
!CBOD Stoichiometry
real :: BODP = null_real !Phosphorus/CBOD stochiometric ratio
real :: BODN = null_real !Nitrogen/CBOD stochiometric ratio
real :: BODC = null_real !Carbon/CBOD stochiometric ratio
!Ammonium
real :: NH4DK = null_real !Ammonium Decay Rate [day^-1]
!Ammonium Temperature Rate Multipliers
real :: NH4T1 = null_real !Minimum Temperature (T1)
real :: NH4T2 = null_real !Optimal Temperature (T2)
real :: NH4K1 = null_real !Multiplier factor for T1
real :: NH4K2 = null_real !Multiplier factor for T2
!Nitrate
real :: NO3DK = null_real !Nitrate Decay Rate [day^-1]
!Nitrate Temperature Rate Multipliers
real :: NO3T1 = null_real !Minimum temperature (T1)
real :: NO3T2 = null_real !Optimal temperature (T2)
real :: NO3K1 = null_real !Multiplier factor for T1
real :: NO3K2 = null_real !Multiplier factor for T2
!Silica
real :: PSIDK = null_real
!Oxygen Stoichiometry 1
real :: O2NH4 = null_real
real :: O2OM = null_real
!Oxygen Limit
real :: O2LIM = null_real
integer :: O2Method = 1
!Oxygen Kinetic Flux
!real :: DOAE = null_real
!More Temperature Rate Multipliers
real :: NH4TRM = null_real
real :: NO3TRM = null_real
real :: OMTRM = null_real
!Auxiliar variables and arrays
real :: DO1 = null_real
real :: DO2 = null_real
real :: DO3 = null_real
real :: O2K1 = null_real
real :: O2K2 = null_real
!Decay Rates
real :: NH4D = null_real
real :: NO3D = null_real
real :: LDOMD = null_real
real :: RDOMD = null_real
real :: LPOMD = null_real
real :: RPOMD = null_real
real :: LRDOMD = null_real
real :: LRPOMD = null_real
real :: CBODD = null_real
!real :: CBODDK = null_real
real :: DETD = null_real
real :: SODD = null_real
real :: SODDO2 = null_real
!Instance of Module_EnterData
integer :: ObjEnterData = 0
character(StringLength) :: Model
type(T_CEQUALW2), pointer :: Next
end type T_CEQUALW2
!Global Module Variables
type (T_CEQUALW2), pointer :: FirstObjCEQUALW2
type (T_CEQUALW2), pointer :: Me
!--------------------------------------------------------------------------
contains
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CONSTRUCTOR CO
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
subroutine StartCEQUALW2(CEQUALW2_ID, ArrayLB, ArrayUB, FileName, Model, STAT)
!Arguments-------------------------------------------------------------
integer :: CEQUALW2_ID
integer, optional, intent(IN ) :: ArrayLB, ArrayUB
character(len=*) :: FileName
character(StringLength),intent(IN ) :: Model
integer, optional, intent(OUT) :: STAT
!External--------------------------------------------------------------
integer :: ready_
!Local-----------------------------------------------------------------
integer :: STAT_
!----------------------------------------------------------------------
STAT_ = UNKNOWN_
!Assures nullification of the global variable
if (.not. ModuleIsRegistered(mCEQUALW2_)) then
nullify (FirstObjCEQUALW2)
call RegisterModule (mCEQUALW2_)
endif
call Ready(CEQUALW2_ID, ready_)
cd0 : if (ready_ .EQ. OFF_ERR_) then
call AllocateInstance
Me%Size%ArrayLB = ArrayLB
Me%Size%ArrayUB = ArrayUB
Me%Model = Model
select case (Model)
case (CEQUALW2Model)
call ReadWaterColumnData (FileName)
case (BenthicCEQUALW2Model)
call ReadBenthicData (FileName)
case default
write(*,*)
write(*,*) 'Defined sinks and sources model was not recognised.'
stop 'StartCEQUALW2 - ModuleCeQualW2 - ERR01'
end select
!Returns ID
CEQUALW2_ID = Me%InstanceID
STAT_ = SUCCESS_
else
stop 'StartCEQUALW2 - ModuleCEQUALW2 - ERR00'
end if cd0
if (present(STAT))STAT = STAT_
end subroutine StartCEQUALW2
!--------------------------------------------------------------------------
subroutine AllocateInstance
!Local-----------------------------------------------------------------
type (T_CEQUALW2), pointer :: NewObjCEQUALW2
type (T_CEQUALW2), pointer :: PreviousObjCEQUALW2
!Allocates new instance
allocate (NewObjCEQUALW2)
nullify (NewObjCEQUALW2%Next)
nullify (NewObjCEQUALW2%FirstAlgae)
nullify (NewObjCEQUALW2%FirstEpiphyton)
!Insert New Instance into list and makes Current point to it
if (.not. associated(FirstObjCEQUALW2)) then
FirstObjCEQUALW2 => NewObjCEQUALW2
Me => NewObjCEQUALW2
else
PreviousObjCEQUALW2 => FirstObjCEQUALW2
Me => FirstObjCEQUALW2%Next
do while (associated(Me))
PreviousObjCEQUALW2 => Me
Me => Me%Next
enddo
Me => NewObjCEQUALW2
PreviousObjCEQUALW2%Next=> NewObjCEQUALW2
endif
Me%InstanceID = RegisterNewInstance (mCEQUALW2_)
end subroutine AllocateInstance
!--------------------------------------------------------------------------
subroutine PropertyIndexNumber
!Local-----------------------------------------------------------------
type(T_Algae), pointer :: Algae
type(T_Epiphyton), pointer :: Epiphyton
integer :: Index
!Local-----------------------------------------------------------------
Me%Size%PropLB = 1
Me%Size%PropUB = 0
Index = 0
!Algae index number
if (Me%Compute%Algae) then
Algae => Me%FirstAlgae
do while(associated(Algae))
Index = Index + 1
Algae%PropIndex = Index
Me%Size%PropUB = Me%Size%PropUB + 1
Algae => Algae%Next
end do
endif
!Epiphyton index number
if (Me%Compute%Epiphyton) then
Epiphyton => Me%FirstEpiphyton
do while(associated(Epiphyton))
Index = Index + 1
Epiphyton%PropIndex = Index
Me%Size%PropUB = Me%Size%PropUB + 1
Epiphyton => Epiphyton%Next
end do
endif
!Nitrogen index number
if (Me%Compute%Nitrogen) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Ammonia = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Nitrate = Me%Size%PropUB
endif
!Phosphorus index number
if (Me%Compute%Phosphorus) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Phosphorus = Me%Size%PropUB
endif
!OrganicMatter index number
if (Me%Compute%OrganicMatter) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%pomref = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%pomlab = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%domlab = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%domref = Me%Size%PropUB
endif
if (Me%Compute%Silica) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%sipart = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%sidiss = Me%Size%PropUB
endif
if (Me%Compute%ICarbon) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%ICarbon = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%CO2 = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%pH = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%HCO3 = Me%Size%PropUB
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%CO3 = Me%Size%PropUB
endif
!Oxygen index number -> The oxygen is always calculated.
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Oxygen = Me%Size%PropUB
!BOD index number
if (Me%Compute%BOD) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%BOD = Me%Size%PropUB
endif
!Detritus index number
if (Me%Compute%Detritus) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Detritus = Me%Size%PropUB
endif
!----------------------------------------------------------------------
end subroutine PropertyIndexNumber
!--------------------------------------------------------------------------
subroutine RateIndexNumber
!Local-----------------------------------------------------------------
integer :: countrate, i
integer :: STAT_CALL
integer, dimension(100) :: LocalMatch
countrate = 0
if (CheckPropertyName('ANLIM', number = Me%rate%MohidIndex%ANLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ANLim
Me%Rate%CeQualIndex%ANLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR1'
endif
if (CheckPropertyName('APLIM', number = Me%rate%MohidIndex%APLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%APLim
Me%Rate%CeQualIndex%APLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR2'
endif
if (CheckPropertyName('ASLIM', number = Me%rate%MohidIndex%ASLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ASLim
Me%Rate%CeQualIndex%ASLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR3'
endif
if (CheckPropertyName('ALIGHTLIM', number = Me%rate%MohidIndex%ALightLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ALightLim
Me%Rate%CeQualIndex%ALightLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR4'
endif
if (CheckPropertyName('AOVERALLLIM', number = Me%rate%MohidIndex%AOverallLim)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%AOverallLim
Me%Rate%CeQualIndex%AOverallLim= countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR6'
endif
if (CheckPropertyName('AGR', number = Me%rate%MohidIndex%AGR)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%AGR
Me%Rate%CeQualIndex%AGR = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR6.1'
endif
if (CheckPropertyName('AMR', number = Me%rate%MohidIndex%AMR)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%AMR
Me%Rate%CeQualIndex%AMR = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR6.2'
endif
if (CheckPropertyName('AER', number = Me%rate%MohidIndex%AER)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%AER
Me%Rate%CeQualIndex%AER = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR6.3'
endif
if (CheckPropertyName('ARR', number = Me%rate%MohidIndex%ARR)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ARR
Me%Rate%CeQualIndex%ARR = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR6.4'
endif
if (CheckPropertyName( 'ENLIM', number = Me%rate%MohidIndex%ENLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ENLim
Me%Rate%CeQualIndex%ENLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR7'
endif
if (CheckPropertyName( 'EPLIM', number = Me%rate%MohidIndex%EPLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%EPLim
Me%Rate%CeQualIndex%EPLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR8'
endif
if (CheckPropertyName( 'ESLIM', number = Me%rate%MohidIndex%ESLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ESLim
Me%Rate%CeQualIndex%ESLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR9'
endif
if (CheckPropertyName( 'ELIGHTLIM', number = Me%rate%MohidIndex%ELightLim )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ELightLim
Me%Rate%CeQualIndex%ELightLim = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR10'
endif
if (CheckPropertyName( 'EOVERALLLIM', number = Me%rate%MohidIndex%EOverallLim)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%EOverallLim
Me%Rate%CeQualIndex%EOverallLim= countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR12'
endif
if (CheckPropertyName('NH4D', number = Me%rate%MohidIndex%NH4D )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4D
Me%Rate%CeQualIndex%NH4D = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR13'
endif
if (CheckPropertyName('NO3D', number = Me%rate%MohidIndex%NO3D )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NO3D
Me%Rate%CeQualIndex%NO3D = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR14'
endif
if (CheckPropertyName('LDOMD', number = Me%rate%MohidIndex%LDOMD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LDOMD
Me%Rate%CeQualIndex%LDOMD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR15'
endif
if (CheckPropertyName('RDOMD', number = Me%rate%MohidIndex%RDOMD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%RDOMD
Me%Rate%CeQualIndex%RDOMD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR16'
endif
if (CheckPropertyName('LPOMD', number = Me%rate%MohidIndex%LPOMD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LPOMD
Me%Rate%CeQualIndex%LPOMD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR17'
endif
if (CheckPropertyName('RPOMD', number = Me%rate%MohidIndex%RPOMD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%RPOMD
Me%Rate%CeQualIndex%RPOMD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR18'
endif
if (CheckPropertyName('LRDOMD', number = Me%rate%MohidIndex%LRDOMD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LRDOMD
Me%Rate%CeQualIndex%LRDOMD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR19'
endif
if (CheckPropertyName('LRPOMD', number = Me%rate%MohidIndex%LRPOMD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LRPOMD
Me%Rate%CeQualIndex%LRPOMD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR20'
endif
if (CheckPropertyName('CBODD', number = Me%rate%MohidIndex%CBODD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%CBODD
Me%Rate%CeQualIndex%CBODD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR21'
endif
if (CheckPropertyName('PO4ER', number = Me%rate%MohidIndex%PO4ER )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PO4ER
Me%Rate%CeQualIndex%PO4ER = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR22'
endif
if (CheckPropertyName('PO4EG', number = Me%rate%MohidIndex%PO4EG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PO4EG
Me%Rate%CeQualIndex%PO4EG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR23'
endif
if (CheckPropertyName('PO4AR', number = Me%rate%MohidIndex%PO4AR )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PO4AR
Me%Rate%CeQualIndex%PO4AR = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR24'
endif
if (CheckPropertyName('PO4AG', number = Me%rate%MohidIndex%PO4AG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PO4AG
Me%Rate%CeQualIndex%PO4AG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR25'
endif
if (CheckPropertyName('PO4OM', number = Me%rate%MohidIndex%PO4OM )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PO4OM
Me%Rate%CeQualIndex%PO4OM = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR26'
endif
if (CheckPropertyName('PO4BOD', number = Me%rate%MohidIndex%PO4BOD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PO4BOD
Me%Rate%CeQualIndex%PO4BOD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR27'
endif
if (CheckPropertyName('NH4ER', number = Me%rate%MohidIndex%NH4ER )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4ER
Me%Rate%CeQualIndex%NH4ER = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR28'
endif
if (CheckPropertyName('NH4EG', number = Me%rate%MohidIndex%NH4EG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4EG
Me%Rate%CeQualIndex%NH4EG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR29'
endif
if (CheckPropertyName('NH4AR', number = Me%rate%MohidIndex%NH4AR )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4AR
Me%Rate%CeQualIndex%NH4AR = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR30'
endif
if (CheckPropertyName('NH4AG', number = Me%rate%MohidIndex%NH4AG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4AG
Me%Rate%CeQualIndex%NH4AG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR31'
endif
if (CheckPropertyName('NH4OM', number = Me%rate%MohidIndex%NH4OM )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4OM
Me%Rate%CeQualIndex%NH4OM = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR32'
endif
if (CheckPropertyName('NH4BOD', number = Me%rate%MohidIndex%NH4BOD )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NH4BOD
Me%Rate%CeQualIndex%NH4BOD = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR33'
endif
if (CheckPropertyName('NO3AG', number = Me%rate%MohidIndex%NO3AG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NO3AG
Me%Rate%CeQualIndex%NO3AG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR34'
endif
if (CheckPropertyName('NO3EG', number = Me%rate%MohidIndex%NO3EG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%NO3EG
Me%Rate%CeQualIndex%NO3EG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR35'
endif
if (CheckPropertyName('DSIAG', number = Me%rate%MohidIndex%DSIAG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DSIAG
Me%Rate%CeQualIndex%DSIAG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR36'
endif
if (CheckPropertyName('DSIEG', number = Me%rate%MohidIndex%DSIEG )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DSIEG
Me%Rate%CeQualIndex%DSIEG = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR37'
endif
if (CheckPropertyName('DSID ', number = Me%rate%MohidIndex%DSID )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DSID
Me%Rate%CeQualIndex%DSID = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR38'
endif
if (CheckPropertyName('PSIAM', number = Me%rate%MohidIndex%PSIAM )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PSIAM
Me%Rate%CeQualIndex%PSIAM = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR39'
endif
if (CheckPropertyName('PSID ', number = Me%rate%MohidIndex%PSID )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%PSID
Me%Rate%CeQualIndex%PSID = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR40'
endif
if (CheckPropertyName('LDOMAP', number = Me%rate%MohidIndex%LDOMAP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LDOMAP
Me%Rate%CeQualIndex%LDOMAP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR41'
endif
if (CheckPropertyName('LDOMEP', number = Me%rate%MohidIndex%LDOMEP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LDOMEP
Me%Rate%CeQualIndex%LDOMEP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR42'
endif
if (CheckPropertyName('LPOMAP', number = Me%rate%MohidIndex%LPOMAP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%LPOMAP
Me%Rate%CeQualIndex%LPOMAP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR43'
endif
if (CheckPropertyName('DOAP', number = Me%rate%MohidIndex%DOAP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DOAP
Me%Rate%CeQualIndex%DOAP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR44'
endif
if (CheckPropertyName('DOEP', number = Me%rate%MohidIndex%DOEP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DOEP
Me%Rate%CeQualIndex%DOEP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR45'
endif
if (CheckPropertyName('DOAR', number = Me%rate%MohidIndex%DOAR )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DOAR
Me%Rate%CeQualIndex%DOAR = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR46'
endif
if (CheckPropertyName('DOER', number = Me%rate%MohidIndex%DOER )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DOER
Me%Rate%CeQualIndex%DOER = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR47'
endif
if (CheckPropertyName('DOOM', number = Me%rate%MohidIndex%DOOM )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DOOM
Me%Rate%CeQualIndex%DOOM = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR48'
endif
if (CheckPropertyName('DONIT', number = Me%rate%MohidIndex%DONIT )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%DONIT
Me%Rate%CeQualIndex%DONIT = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR49'
endif
if (CheckPropertyName('ICARBONAP', number = Me%rate%MohidIndex%ICarbonAP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ICarbonAP
Me%Rate%CeQualIndex%ICarbonAP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR50'
endif
if (CheckPropertyName('ICARBONEP', number = Me%rate%MohidIndex%ICarbonEP )) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ICarbonEP
Me%Rate%CeQualIndex%ICarbonEP = countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR51'
endif
if (CheckPropertyName('ICARBONBOD', number = Me%rate%MohidIndex%ICarbonBOD)) then
countrate = countrate +1
LocalMatch(countrate) = Me%Rate%MohidIndex%ICarbonBOD
Me%Rate%CeQualIndex%ICarbonBOD= countrate
else
stop 'RateIndexNumber - ModuleCEQUALW2 - ERR52'
endif
Me%Rate%LB =1
Me%Rate%UB = countrate
allocate(Me%Rate%Value(Me%Rate%LB:Me%Rate%UB,Me%Size%ArrayLB:Me%Size%ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "PropertyIndexNumber - ModuleCEQUALW2 - ERR53"
allocate (ME%Rate%Match(countrate))
do i=1,countrate
ME%Rate%Match(i) = LocalMatch(i)
enddo
if (countrate.ne.0) then
Me%Rate%Compute=.true.
endif
end subroutine RateIndexNumber
!--------------------------------------------------------------------------
subroutine ReadBenthicData(FileName)
!Arguments-------------------------------------------------------------
character(len=*) :: FileName
!External--------------------------------------------------------------
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
call ConstructEnterData(Me%ObjEnterData, FileName, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ReadBenthicData - ModuleCEQUALW2 - ERR01'
call ReadBenthicGlobalVariables
call ReadSODData
call ReadOMParameters
call ReadOxygenParameters
call ReadDetritusParameters
call ReadAmmoniaParameters
call ReadPhosphorusParameters
call ReadDsilicaParameters
call ReadICarbonParameters
call BenthicPropertyIndexNumber
!call RateIndexNumber
call ConstructBenthicPropertyList
call KillEnterData(Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ReadBenthicData - ModuleCEQUALW2 - ERR03'
end subroutine ReadBenthicData
!--------------------------------------------------------------------------
subroutine ReadBenthicGlobalVariables
!External--------------------------------------------------------------
integer :: FromFile
integer :: STAT_CALL
!Local-----------------------------------------------------------------
integer :: flag
!--------------------------------------------------------------------------
call GetExtractType(FromFile = FromFile)
if (Me%DTSecond .LE. 0.0) then
!DTSecond, time step, in seconds, between two CEQUALW2 calls
call GetData(Me%DTSecond, &
Me%ObjEnterData, flag, &
SearchType = FromFile, &
keyword ='DTSECONDS', &
Default = 60.0 * 60.0, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_)stop 'ReadBenthicGlobalVariables - ModuleCEQUALW2 - ERR01'
if (flag .EQ. 0) then
write(*,*)
write(*,*) 'Keyword DTSECONDS not found in CEQUALW2 data file.'
write(*,*) 'ReadBenthicGlobalVariables - ModuleCEQUALW2 - WRN01'
write(*,*) 'Assumed ', Me%DTSecond, 'seconds (', Me%DTSecond / 3600.0, 'hour).'
write(*,*)
end if
end if
!For compatibility with the rest of the program
Me%DTDay = Me%DTSecond / 24.0 / 60.0 / 60.0
end subroutine ReadBenthicGlobalVariables
! -------------------------------------------------------------------------
subroutine ReadSODData
!External--------------------------------------------------------------
integer :: FromBlock, ClientNumber
logical :: BlockFound
integer :: STAT_CALL
!Local-----------------------------------------------------------------
integer :: flag
!--------------------------------------------------------------------------
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_SOD>', '<end_SOD>', BlockFound, &
STAT = STAT_CALL)
if(STAT_CALL .EQ. SUCCESS_)then
if (BlockFound) then
Me%SOD%UseSOD = .true.
call GetExtractType(FromBlock = FromBlock)
!Temp 1 for temperature rate multiplier
call GetData( Me%SOD%T1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'SODT1', &
default = 4. , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR01"
!Temp 2 for temperature rate multiplier
call GetData( Me%SOD%T2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'SODT2', &
default = 35. , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR02"
!K1 for temperature rate multiplier
call GetData( Me%SOD%K1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'SODK1', &
default = 0.1 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR03"
!K1 for temperature rate multiplier
call GetData( Me%SOD%K2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'SODK2', &
default = 0.99 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR04"
!Release of PO4 by SOD rate
call GetData( Me%SOD%PO4R, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'PO4R', &
default = 0.001, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR05"
!Release of NH4 by SOD rate
call GetData( Me%SOD%NH4R, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'NH4R', &
default = 0.001, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR06"
!Release of Silica by SOD rate
call GetData( Me%SOD%SiR, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'SiR', &
default = 0.1 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR07"
!Release of CO2 by SOD rate
call GetData( Me%SOD%CO2R, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'CO2R', &
default = 0.1 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR08"
!Sink of O2 by SOD rate
call GetData( Me%SOD%O2Sink, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2Consumption', &
default = 1. , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR09"
!In CEQUAL SOD uptakes O2 even above O2 min if this is turned off
!SOD will inly use O2 below O2 min
call GetData( Me%SOD%DefaultO2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'DefaultO2', &
default = .true. , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR10"
else
Me%SOD%UseSOD = .false.
endif
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSODData - ModuleCEQUALW2 - ERR011"
endif
end subroutine ReadSODData
! -------------------------------------------------------------------------
subroutine ReadDetritusParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_det>', '<end_det>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%Compute%Detritus = .True.
Me%BenthicCompute%Detritus = .True.
call GetExtractType(FromBlock = FromBlock)
!SDK Sediment decay rate, [day^-1]
call GetData(Me%SDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'DET_DECAY', &
default = 0.1 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR01"
call GetData(Me%DETT1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'DET_T1', &
default = 4. , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR02"
call GetData(Me%DETT2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'DET_T2', &
default = 30. , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR03"
call GetData(Me%DETK1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'DET_K1', &
default = 0.1 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR04"
call GetData(Me%DETK2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'DET_K2', &
default = 0.99 , &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR05"
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR006"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadDetritusParameters - ModuleCEQUALW2 - ERR007"
end if cd1
end do do1
end subroutine ReadDetritusParameters
! -------------------------------------------------------------------------
subroutine ReadAmmoniaParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_ammonia>', '<end_ammonia>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%BenthicCompute%Ammonia = .true.
call GetExtractType(FromBlock = FromBlock)
!ORGN - Stoichiometric equivalent between organic matter and nitrogen
call GetData(Me%ORGN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_N', &
default = 0.0800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAmmoniaParameters - ModuleCEQUALW2 - ERR01"
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAmmoniaParameters - ModuleCEQUALW2 - ERR002"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadAmmoniaParameters - ModuleCEQUALW2 - ERR007"
end if cd1
end do do1
end subroutine ReadAmmoniaParameters
!--------------------------------------------------------------------------
subroutine ReadPhosphorusParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_phos>', '<end_phos>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%BenthicCompute%Phosphorus = .True.
Me%Compute%Phosphorus = .True.
call GetExtractType(FromBlock = FromBlock)
select case (Me%Model)
case (BenthicCEQUALW2Model)
!ORGN - Stoichiometric equivalent between organic matter and phosphorus
call GetData(Me%ORGP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_P', &
default = 0.0050, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadPhosphorusParameters - ModuleCEQUALW2 - ERR01"
end select
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadPhosphorusParameters - ModuleCEQUALW2 - ERR002"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadPhosphorusParameters - ModuleCEQUALW2 - ERR007"
end if cd1
end do do1
end subroutine ReadPhosphorusParameters
!--------------------------------------------------------------------------
subroutine ReadDsilicaParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_dsi>', '<end_dsi>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%BenthicCompute%DSilica=.true.
call GetExtractType(FromBlock = FromBlock)
!ORGN - Stoichiometric equivalent between organic matter and phosphorus
call GetData(Me%ORGSI, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_SI', &
default = 0.1800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDsilicaParameters - ModuleCEQUALW2 - ERR01"
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadDsilicaParameters - ModuleCEQUALW2 - ERR002"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadDsilicaParameters - ModuleCEQUALW2 - ERR007"
end if cd1
end do do1
end subroutine ReadDsilicaParameters
!--------------------------------------------------------------------------
subroutine ReadICarbonParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_ic>', '<end_ic>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%BenthicCompute%ICarbon =.true.
Me%Compute%ICarbon =.true.
call GetExtractType(FromBlock = FromBlock)
select case (Me%Model)
case (BenthicCEQUALW2Model)
!ORGN - Stoichiometric equivalent between organic matter and phosphorus
call GetData(Me%ORGC, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_C', &
default = 0.4500, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadICarbonParameters - ModuleCEQUALW2 - ERR01"
end select
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadICarbonParameters - ModuleCEQUALW2 - ERR002"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadICarbonParameters - ModuleCEQUALW2 - ERR007"
end if cd1
end do do1
end subroutine ReadICarbonParameters
!--------------------------------------------------------------------------
subroutine BenthicPropertyIndexNumber
Me%Size%PropLB = 1
Me%Size%PropUB = 0
if (Me%BenthicCompute%Detritus) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Detritus = Me%Size%PropUB
endif
if (Me%BenthicCompute%Ammonia) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Ammonia = Me%Size%PropUB
endif
!Phosphorus index number
if (Me%BenthicCompute%Phosphorus) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Phosphorus = Me%Size%PropUB
endif
if (Me%BenthicCompute%DSilica) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%sidiss = Me%Size%PropUB
endif
if (Me%BenthicCompute%ICarbon) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%ICarbon = Me%Size%PropUB
endif
if (Me%BenthicCompute%Oxygen) then
Me%Size%PropUB = Me%Size%PropUB + 1
Me%PropIndex%Oxygen = Me%Size%PropUB
endif
!----------------------------------------------------------------------
end subroutine BenthicPropertyIndexNumber
!--------------------------------------------------------------------------
subroutine ConstructBenthicPropertyList
! -------------------------------------------------------------------------
allocate(Me%PropertyList(Me%Size%PropLB: Me%Size%PropUB))
if (Me%BenthicCompute%Detritus) then
Me%PropertyList(Me%PropIndex%Detritus) = Detritus_
endif
if (Me%BenthicCompute%Ammonia) then
Me%PropertyList(Me%PropIndex%Ammonia) = Ammonia_
endif
!Phosphorus
if (Me%BenthicCompute%Phosphorus) then
Me%PropertyList(Me%PropIndex%Phosphorus) = Inorganic_Phosphorus_
endif
if (Me%BenthicCompute%DSilica) then
Me%PropertyList(Me%PropIndex%sidiss) = DSilica_
endif
if (Me%BenthicCompute%ICarbon) then
Me%PropertyList(Me%PropIndex%ICarbon) = ICarbon_
endif
if (Me%BenthicCompute%Oxygen) then
Me%PropertyList(Me%PropIndex%Oxygen) = Oxygen_
endif
!----------------------------------------------------------------------
end subroutine ConstructBenthicPropertyList
subroutine ReadWaterColumnData(FileName)
!Arguments-------------------------------------------------------------
character(len=*) :: FileName
!External--------------------------------------------------------------
integer :: STAT_CALL
!Begin-----------------------------------------------------------------
call ConstructEnterData(Me%ObjEnterData, FileName, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ReadWaterColumnData - ModuleCEQUALW2 - ERR01'
call ReadGlobalVariables
call ConstructAlgaeClasses
call ConstructEpiphytonClasses
call ReadOMParameters
call ReadNitrogenParameters
call ReadPhosphorusParameters
call ReadICarbonParameters
call ReadBODParameters
call ReadDetritusParameters
call ReadOxygenParameters
call ReadSilicaParameters
call PropertyIndexNumber
call RateIndexNumber
call ConstructPropertyList
call KillEnterData(Me%ObjEnterData, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ReadWaterColumnData - ModuleCEQUALW2 - ERR03'
end subroutine ReadWaterColumnData
!--------------------------------------------------------------------------
subroutine ReadGlobalVariables
!External--------------------------------------------------------------
integer :: FromFile
integer :: STAT_CALL
!Local-----------------------------------------------------------------
integer :: flag
!--------------------------------------------------------------------------
call GetExtractType(FromFile = FromFile)
if (Me%DTSecond .LE. 0.0) then
!DTSecond, time step, in seconds, between two CEQUALW2 calls
call GetData(Me%DTSecond, &
Me%ObjEnterData, flag, &
SearchType = FromFile, &
keyword ='DTSECONDS', &
Default = 60.0 * 60.0, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_)stop 'ReadGlobalVariables - ModuleCEQUALW2 - ERR01'
if (flag .EQ. 0) then
write(*,*)
write(*,*) 'Keyword DTSECONDS not found in CEQUALW2 data file.'
write(*,*) 'ReadGlobalVariables - ModuleCEQUALW2 - WRN01'
write(*,*) 'Assumed ', Me%DTSecond, 'seconds (', Me%DTSecond / 3600.0, 'hour).'
write(*,*)
end if
end if
!For compatibility with the rest of the program
Me%DTDay = Me%DTSecond / 24.0 / 60.0 / 60.0
call GetData(Me%Compute%ICarbon, &
Me%ObjEnterData, flag, &
SearchType = FromFile, &
keyword ='COMPUTE_ICARBON', &
Default = OFF, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_)stop 'ReadGlobalVariables - ModuleCEQUALW2 - ERR04'
end subroutine ReadGlobalVariables
!----------------------------------------------------------------------
subroutine ConstructAlgaeClasses
!Local-----------------------------------------------------------------
type (T_Algae), pointer :: NewAlgae
integer :: ClientNumber, STAT_CALL
logical :: BlockFound
!Begin-----------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, &
ClientNumber = ClientNumber, &
block_begin = '<begin_algae>', &
block_end = '<end_algae>', &
BlockFound = BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%Compute%Algae = .true.
call AddAlgae (NewAlgae)
call ReadAlgaeParameters (NewAlgae)
nullify(NewAlgae)
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ConstructAlgaeClasses - ModuleCEQUALW2 - ERR01'
exit do1
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
write(*,*)
write(*,*) 'Error calling ExtractBlockFromBuffer. '
stop 'ConstructAlgaeClasses - ModuleCEQUALW2 - ERR02'
else cd1
stop 'ConstructAlgaeClasses - ModuleCEQUALW2 - ERR03'
end if cd1
end do do1
end subroutine ConstructAlgaeClasses
!--------------------------------------------------------------------------
subroutine AddAlgae (ObjAlgae)
!Arguments-------------------------------------------------------------
type (T_Algae), pointer :: ObjAlgae
!Local-----------------------------------------------------------------
type (T_Algae), pointer :: PreviousAlgae
type (T_Algae), pointer :: NewAlgae
!Allocates new Algae
allocate (NewAlgae)
nullify (NewAlgae%Next)
!Insert new Algae into list and makes current algae point to it
if (.not. associated(Me%FirstAlgae)) then
Me%FirstAlgae => NewAlgae
ObjAlgae => NewAlgae
else
PreviousAlgae => Me%FirstAlgae
ObjAlgae => Me%FirstAlgae%Next
do while (associated(ObjAlgae))
PreviousAlgae => ObjAlgae
ObjAlgae => ObjAlgae%Next
enddo
ObjAlgae => NewAlgae
PreviousAlgae%Next => NewAlgae
endif
end subroutine AddAlgae
!--------------------------------------------------------------------------
subroutine ReadAlgaeParameters(NewAlgae)
!Arguments--------------------------------------------------------------
type (T_Algae), pointer :: NewAlgae
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
integer :: flag
integer :: ArrayLB, ArrayUB
!----------------------------------------------------------------------
ArrayLB = Me%Size%ArrayLB
ArrayUB = Me%Size%ArrayUB
call GetExtractType(FromBlock = FromBlock)
call GetData(NewAlgae%ID%Name, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword ='NAME', &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL .ne. SUCCESS_) stop 'ReadAlgaeParameters - ModuleCEQUALW2 - ERR01'
if (flag==0) then
write (*,*)'Property without name'
stop 'ReadAlgaeParameters - ModuleCEQUALW2 - ERR02'
endif
if (.not. CheckPropertyName (NewAlgae%ID%Name, NewAlgae%ID%IDnumber))then
write (*,*)'The following property isnt recognized by the model :'
write (*,*)trim(NewAlgae%ID%Name)
stop 'ReadAlgaeParameters - ModuleCEQUALW2- ERR03'
endif
!AG - Algal maximum growth rate [day^-1]
call GetData(NewAlgae%AG, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_GROWTH', &
default = 2.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL .ne. SUCCESS_) stop 'ReadAlgaeParameters - ModuleCEQUALW2 - ERR04'
!AR - Algal maximum respiration rate [day^-1]
call GetData(NewAlgae%AR, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_RESPIRATION', &
default = 0.0400, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL .ne. SUCCESS_) stop 'ReadAlgaeParameters - ModuleCEQUALW2 - ERR05'
!AE - Algal maximum excretion rate [day^-1]
call GetData(NewAlgae%AE, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_EXCRETION', &
default = 0.0400, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR06"
!AM - Algal maximum mortality rate [day^-1]
call GetData(NewAlgae%AM, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_MORTALITY', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR07"
!AHSP - Algal half-saturation for phosphorus limited growth [g m^-3]
call GetData(NewAlgae%AHSP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_HALFSAT_P', &
default = 0.0030, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR08"
!Algal half-saturation coefficients for oxygen consumption [mgO2/l]
call GetData(NewAlgae%AOK1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_OK1', &
default = 13.0, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR035"
call GetData(NewAlgae%AOK2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_OK2', &
default = 11.0, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR037"
call GetData(NewAlgae%AOK3, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_OK3', &
default = 2.5, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR038"
call GetData(NewAlgae%AOK4, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_OK4', &
default = 7.0, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR039"
!AHSN - Algal half-saturation for nitrogen limited growth [g m^-3]
call GetData(NewAlgae%AHSN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_HALFSAT_N', &
default = 0.0140, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR09"
!AHSSI - Algal half-saturation for silica limited growth [g m^-3]
call GetData(NewAlgae%AHSSI, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_HALFSAT_SI', &
default = 0.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR010"
!ASAT - Algal light saturation intensity at maximum phtosynthetic rate [W m^-2]
call GetData(NewAlgae%ASAT, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_LIGHT_SAT', &
default = 75.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR011"
!Algal temperature rate multipliers
!AT1 - Lower temperature for algal growth (ºC)
call GetData(NewAlgae%AT1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_T1', &
default = 5.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR012"
!AT2 - Lower temperature for maximum algal growth (ºC)
call GetData(NewAlgae%AT2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_T2', &
default = 25.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR013"
!AT3 - Upper temperature for maximum algal growth (ºC)
call GetData(NewAlgae%AT3, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_T3', &
default = 35.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR014"
!AT4 - Upper temperature for algal growth (ºC)
call GetData(NewAlgae%AT4, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_T4', &
default = 40.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR015"
!AK1 - Fraction of algal growth rate at AT1
call GetData(NewAlgae%AK1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_K1', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR016"
!AK2 - Fraction of maximum algal growth rate at AT2
call GetData(NewAlgae%AK2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_K2', &
default = 0.9900, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR017"
!AK3 - Fraction of maximum algal growth rate at AT3
call GetData(NewAlgae%AK3, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_K3', &
default = 0.9900, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR018"
!AK4 - Fraction of algal growth rate at AT4
call GetData(NewAlgae%AK4, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_K4', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR019"
!AP - Stoichiometric equivalent between algal biomass and phosphorus
call GetData(NewAlgae%AP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_STOICHIOMETRY_P', &
default = 0.0050, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR020"
!AN - toichiometric equivalent between algal biomass and nitrogen
call GetData(NewAlgae%AN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_STOICHIOMETRY_N', &
default = 0.0800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR021"
!AC - Stoichiometric equivalent between algal biomass and carbon
call GetData(NewAlgae%AC, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_STOICHIOMETRY_C', &
default = 0.4500, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR022"
!ASI - Stoichiometric equivalent between algal biomass and silica
call GetData(NewAlgae%ASI, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_STOICHIOMETRY_Si', &
default = 0.1800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR023"
!APOM - Fraction of algal biomass that is not converted to POM when algae die
call GetData(NewAlgae%APOM, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_POM', &
default = 0.8000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR025"
!ANEQN - Equation number for algal ammonium preference (either 1 or 2)
call GetData(NewAlgae%ANEQN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_NEQUATIONNUMBER', &
default = 2, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR026"
if ((NewAlgae%ANEQN.NE.1).and.(NewAlgae%ANEQN.NE.2)) then
write (*,*) "Possible values for equation number: 1 or 2!"
stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR026A"
end if
!ANPR - Algal half saturation preference constant for ammonium
call GetData(NewAlgae%ANPR, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_AMMONIUM_PREF', &
default = 0.0010, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR027"
!O2AR - Oxygen stoichiometry for algal respiration
call GetData(NewAlgae%O2AR, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_A_RESPIRATION', &
default = 1.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR028"
!02AG - Oxygen stoichiometry for algal primary prodution
call GetData(NewAlgae%O2AG, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_A_GROWTH', &
default = 1.4000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR029"
!EXA - Algal light extinction [m^-1]
call GetData(NewAlgae%EXA, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'A_LIGHT_EXTINTION', &
default = 0.2, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR030"
allocate(NewAlgae%NLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR031"
allocate(NewAlgae%PLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR032"
allocate(NewAlgae%SLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR033"
allocate(NewAlgae%LightLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR034"
allocate(NewAlgae%OverallLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadAlgaeParameters - ModuleCEQUALW2 - ERR036"
end subroutine ReadAlgaeParameters
!----------------------------------------------------------------------------
subroutine ConstructEpiphytonClasses
!Local-----------------------------------------------------------------
type (T_Epiphyton), pointer :: NewEpiphyton
integer :: ClientNumber, STAT_CALL
logical :: BlockFound
!Begin-----------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, &
ClientNumber = ClientNumber, &
block_begin = '<begin_epiphyton>', &
block_end = '<end_epiphyton>', &
BlockFound = BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%Compute%Epiphyton=.true.
call AddEpiphyton (NewEpiphyton)
call ReadEpiphytonParameters (NewEpiphyton)
nullify(NewEpiphyton)
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if (STAT_CALL .NE. SUCCESS_) stop 'ConstructEpiphytonClasses - ModuleCEQUALW2 - ERR01'
exit do1
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
write(*,*)
write(*,*) 'Error calling ExtractBlockFromBuffer. '
stop 'ConstructEpiphytonClasses - ModuleCEQUALW2 - ERR02'
else cd1
stop 'ConstructEpiphytonClasses - ModuleCEQUALW2 - ERR03'
end if cd1
end do do1
end subroutine ConstructEpiphytonClasses
!----------------------------------------------------------------------------
subroutine AddEpiphyton (ObjEpiphyton)
!Arguments-------------------------------------------------------------
type (T_Epiphyton), pointer :: ObjEpiphyton
!Local-----------------------------------------------------------------
type (T_Epiphyton), pointer :: PreviousEpiphyton
type (T_Epiphyton), pointer :: NewEpiphyton
!Allocates new Epiphyton
allocate (NewEpiphyton)
nullify (NewEpiphyton%Next)
!Insert new Epiphyton into list and makes current algae point to it
if (.not. associated(Me%FirstEpiphyton)) then
Me%FirstEpiphyton => NewEpiphyton
ObjEpiphyton => NewEpiphyton
else
PreviousEpiphyton => Me%FirstEpiphyton
ObjEpiphyton => Me%FirstEpiphyton%Next
do while (associated(ObjEpiphyton))
PreviousEpiphyton => ObjEpiphyton
ObjEpiphyton => ObjEpiphyton%Next
enddo
ObjEpiphyton => NewEpiphyton
PreviousEpiphyton%Next => NewEpiphyton
endif
end subroutine AddEpiphyton
!--------------------------------------------------------------------------
subroutine ReadEpiphytonParameters (NewEpiphyton)
!Arguments--------------------------------------------------------------
type (T_Epiphyton), pointer :: NewEpiphyton
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
integer :: flag
integer :: ArrayLB, ArrayUB
!----------------------------------------------------------------------
ArrayLB = Me%Size%ArrayLB
ArrayUB = Me%Size%ArrayUB
call GetExtractType(FromBlock = FromBlock)
call GetData(NewEpiphyton%ID%Name, &
Me%ObjEnterData, flag, &
FromBlock, &
keyword ='NAME', &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if (STAT_CALL.ne.SUCCESS_) stop 'ReadEpiphytonParameters - ModuleCEQUALW2 - ERR01'
if (flag==0) then
write (*,*)'Property without name'
stop 'ReadEpiphytonParameters - ModuleCEQUALW2 - ERR02'
endif
if (.not. CheckPropertyName (NewEpiphyton%ID%Name,NewEpiphyton%ID%IDNumber)) then
write (*,*)'The following property isnt recognized by the model :'
write (*,*)trim(NewEpiphyton%ID%Name)
stop 'ReadEpiphytonParameters - ModuleCEQUALW2 - ERR03'
endif
!Default data from W2Con.npt
!EG - Maximum epiphyton growth rate [day^-1]
call GetData(NewEpiphyton%EG, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_GROWTH', &
default = 2.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR04"
!ER - Maximum epiphyton respiration rate [day^-1]
call GetData(NewEpiphyton%ER, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_RESPIRATION', &
default = 0.0400, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR05"
!EE - Maximum epiphyton excretion rate [day^-1]
call GetData(NewEpiphyton%EE, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_EXCRETION', &
default = 0.0400, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR06"
!EM - Maximum epiphyton mortality rate [day^-1]
call GetData(NewEpiphyton%EM, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_MORTALITY', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR07"
!EHSP - Epiphyton half-saturation for phosphorus limited growth [g m^-3]
call GetData(NewEpiphyton%EHSP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_HALFSAT_P', &
default = 0.0030, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR08"
!EHSN - Epiphyton half-saturation for nitrogen limited growth [g m^-3]
call GetData(NewEpiphyton%EHSN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_HALFSAT_N', &
default = 0.0140, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR09"
!EHSSI - Epiphyton half-saturation for silica limited growth [g m^-3]
call GetData(NewEpiphyton%EHSSI, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_HALFSAT_SI', &
default = 0.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR010"
!ESAT - Light saturation intensity at maximum photosynthetic rate [W m^-2]
call GetData(NewEpiphyton%ESAT, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_LIGHT_SAT', &
default = 75.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR011"
!ENEQN - Ammonia preference factor equation for epiphyton (either 1 or 2)
call GetData(NewEpiphyton%ENEQN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_NEQUATIONNUMBER', &
default = 2, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR013"
if ((NewEpiphyton%ENEQN.NE.1).and.(NewEpiphyton%ENEQN.NE.2)) then
write (*,*) "Possible values for equation number: 1 or 2!"
stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR012A"
end if
!ENPR - N preference half-saturation constant (only used if EPEQN = 2) [mg/l]
call GetData(NewEpiphyton%ENPR, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_AMMONIUM_PREF', &
default = 0.0010, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR014"
!ET1 - Lower temperature for epiphyton growth [ºC]
call GetData(NewEpiphyton%ET1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_T1', &
default = 5.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR015"
!ET2 - Lower temperature for maximum epiphyton growth [ºC]
call GetData(NewEpiphyton%ET2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_T2', &
default = 25.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR016"
!ET3 - Upper temperature for maximum epiphyton growth [ºC]
call GetData(NewEpiphyton%ET3, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_T3', &
default = 35.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR017"
!ET4 - Upper temperature for epiphyton growth [ºC]
call GetData(NewEpiphyton%ET4, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_T4', &
default = 40.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR018"
!EK1 - Fraction of epiphyton growth rate at ET1
call GetData(NewEpiphyton%EK1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_K1', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR019"
!EK2 - Fraction of maximum epiphyton growth rate at ET2
call GetData(NewEpiphyton%EK2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_K2', &
default = 0.9900, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR020"
!EK3 - Fraction of maximum epiphyton growth rate at ET3
call GetData(NewEpiphyton%EK3, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_K3', &
default = 0.9900, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR021"
!EK4 - Fraction of epiphyton growth rate at ET4
call GetData(NewEpiphyton%EK4, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_K4', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR022"
!EP - Stoichiometric equivalent between epiphyton biomass and phosphorus
call GetData(NewEpiphyton%EP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_STOICHIOMETRY_P', &
default = 0.0050, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR023"
!EN - Stoichiometric equivalent between epiphyton biomass and nitrogen
call GetData(NewEpiphyton%EN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_STOICHIOMETRY_N', &
default = 0.0800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR024"
!EC - Stoichiometric equivalent between epiphyton biomass and carbon
call GetData(NewEpiphyton%EC, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_STOICHIOMETRY_C', &
default = 0.4500, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR025"
!ESI - Stoichiometric equivalent between epiphyton biomass and silica
call GetData(NewEpiphyton%ESI, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_STOICHIOMETRY_SI', &
default = 0.1800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR026"
!Fraction of epiphyton biomass that is not converted to POM when epiphyton die
call GetData(NewEpiphyton%EPOM, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'E_POM', &
default = 0.8000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR028"
!O2ER - Oxygen stoichiometry for epiphyton respiration
call GetData(NewEpiphyton%O2ER, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_E_RESPIRATION', &
default = 1.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR029"
!O2EG - Oxygen stoichiometry for epiphyton primary prodution
call GetData(NewEpiphyton%O2EG, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_E_GROWTH', &
default = 1.4000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR030"
allocate(NewEpiphyton%NLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR031"
allocate(NewEpiphyton%PLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR032"
allocate(NewEpiphyton%SLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR033"
allocate(NewEpiphyton%LightLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR034"
allocate(NewEpiphyton%OverallLim(ArrayLB:ArrayUB), STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadEpiphytonParameters - ModuleCEQUALW2 - ERR036"
end subroutine ReadEpiphytonParameters
!----------------------------------------------------------------------------
subroutine ReadOMParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
integer :: FromBlock
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_om>', '<end_om>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_) then
cd2 : if (BlockFound) then
Me%Compute%OrganicMatter=.true.
call GetExtractType(FromBlock = FromBlock)
!DOM Parameters---------------------------------------------
!LDOMDK - Labile DOM decay rate [day^-1]
call GetData(Me%LDOMDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'LDOM_DECAY', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR01"
!RDOMDK - Refractory DOM decay rate [day^-1]
call GetData(Me%RDOMDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'RDOM_DECAY', &
default = 0.0010, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR02"
!LRDDK - Labile to refractory DOM decay rate [day^-1]
call GetData(Me%LRDDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'LRDOM_DECAY', &
default = 0.0100, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR03"
!LPOMDK - Labile POM decay rate [day^-1]
call GetData(Me%LPOMDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'LPOM_DECAY', &
default = 0.0800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR04"
!RPOMDK - Refractory POM decay rate [day^-1]
call GetData(Me%RPOMDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'RPOM_DECAY', &
default = 0.0010, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR05"
!LRPDK - Labile to refractory POM decay rate [day^-1]
call GetData(Me%LRPDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'LRPOM_DECAY', &
default = 0.0100, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR06"
!ORGP - Stoichiometric equivalent between organic matter and phosphorus
call GetData(Me%ORGP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_P', &
default = 0.0050, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR07"
!ORGN - Stoichiometric equivalent between organic matter and nitrogen
call GetData(Me%ORGN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_N', &
default = 0.0800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR08"
!ORGC - Stoichiometric equivalent between organic matter and carbon
call GetData(Me%ORGC, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_C', &
default = 0.4500, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR09"
!ORGSI - Stoichiometric equivalent between organic matter and silica
call GetData(Me%ORGSI, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_STOICHIOMETRY_SI', &
default = 0.1800, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR010"
!OMT1 - Lower temperature for organic matter decay [ºC]
call GetData(Me%OMT1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_T1', &
default = 4.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR011"
!OMT2 - Upper temperature for organic matter decay [ºC]
call GetData(Me%OMT2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_T2', &
default = 25.0000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR012"
!OMK1 - Fraction of organic matter decay rate at OMT1
call GetData(Me%OMK1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_K1', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR013"
!OMK2 - Fraction of organic matter decay rate at OMT2
call GetData(Me%OMK2, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'OM_K2', &
default = 0.9900, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR014"
!O2OM - Oxygen stoichiometry for organic matter decay
call GetData(Me%O2OM, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_OM', &
default = 1.4000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR015"
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOMParameters - ModuleCEQUALW2 - ERR016"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadOMParameters - ModuleCEQUALW2 - ERR017"
end if cd1
end do do1
end subroutine ReadOMParameters
!----------------------------------------------------------------------------
subroutine ReadBODParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_BOD>', '<end_BOD>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%Compute%BOD=.true.
call GetExtractType(FromBlock = FromBlock)
!KBOD - 5-day decay rate at 20ºC [day^-1]
call GetData(Me%KBOD, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'BOD_DECAY', &
default = 0.25, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR01"
!TBOD - Temperature coefficient
call GetData(Me%TBOD, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'BOD_T_COEF', &
default = 1.0147, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR02"
!RBOD - Ratio of CBOD5 to ultimate CBOD
call GetData(Me%RBOD, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'BOD_RATIO', &
default = 1.8500, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR03"
!BODP - P stoichiometry for CBOD decay
call GetData(Me%BODP, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'BOD_STOICHIOMETRY_P', &
default = 0.0040, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR04"
!BODN - N stoichiometry for CBOD decay
call GetData(Me%BODN, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'BOD_STOICHIOMETRY_N', &
default = 0.0600, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR05"
!BODC - C stoichiometry for CBOD decay
call GetData(Me%BODC, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'BOD_STOICHIOMETRY_C', &
default = 0.3200, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR06"
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadBODParameters - ModuleCEQUALW2 - ERR07"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadBODParameters - ModuleCEQUALW2 - ERR08"
end if cd1
end do do1
end subroutine ReadBODParameters
!----------------------------------------------------------------------------
subroutine ReadSilicaParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
character(len=StringLength), parameter :: block_begin = '<beginsilica>'
character(len=StringLength), parameter :: block_end = '<endsilica>'
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_silica>', '<end_silica>', BlockFound, &
STAT = STAT_CALL)
cd1 : if (STAT_CALL .EQ. SUCCESS_)then
cd2 : if (BlockFound) then
Me%Compute%Silica=.true.
call GetExtractType(FromBlock = FromBlock)
!Particulate biogenic silica decay rate [day^-1]
call GetData(Me%PSIDK, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'PARTSI_DECAY', &
default = 0.3000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSilicaParameters - ModuleCEQUALW2 - ERR03"
else cd2
call Block_Unlock(Me%ObjEnterData, ClientNumber, STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadSilicaParameters - ModuleCEQUALW2 - ERR05"
exit do1 !No more blocks
end if cd2
else if (STAT_CALL .EQ. BLOCK_END_ERR_) then cd1
stop "ReadSilicaParameters - ModuleCEQUALW2 - ERR06"
end if cd1
end do do1
end subroutine ReadSilicaParameters
!----------------------------------------------------------------------------
subroutine ReadOxygenParameters
!External--------------------------------------------------------------
integer :: STAT_CALL
integer :: FromBlock
!Local-----------------------------------------------------------------
logical :: BlockFound
integer :: ClientNumber
integer :: flag
!----------------------------------------------------------------------
do1 : do
call ExtractBlockFromBuffer(Me%ObjEnterData, ClientNumber, &
'<begin_oxygen>', '<end_oxygen>', BlockFound, &
STAT = STAT_CALL)
cd1 : if(STAT_CALL .EQ. SUCCESS_) then
cd2 : if (BlockFound) then
call GetExtractType(FromBlock = FromBlock)
Me%BenthicCompute%Oxygen =.True.
!O2LIM - Dissolved oxygen concentration at which anaerobic processes begin [g m^-3]
call GetData(Me%O2LIM, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2LIM', &
default = 0.1000, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOxygenParameters - ModuleCEQUALW2 - ERR01"
call GetData(Me%O2Method, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_METHOD', &
default = 1, &
ClientModule = MohidModules(mCEQUALW2_)%Name, &
STAT = STAT_CALL)
if(STAT_CALL .ne. SUCCESS_) stop "ReadOxygenParameters - ModuleCEQUALW2 - ERR02"
!Oxygen rate multiplier for oxygen consuming processes
call GetData(Me%O2K1, &
Me%ObjEnterData, flag, &
SearchType = FromBlock, &
keyword = 'O2_K1', &
default = 2.5, &
ClientModule