SUBROUTINE GetWaterManagerInput
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN August 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList ,&
SameString, GetObjectDefMaxArgs, VerifyName
USE DataSurfaces, ONLY: Surface , TotSurfaces
USE DataHeatBalance, ONLY: Zone
Use DataGlobals , ONLY: NumOfZones
Use DataInterfaces, ONLY: ShowSevereError, SetupOutputVariable
USE ScheduleManager, ONLY: GetScheduleIndex, CheckScheduleValueMinMax, GetScheduleMinValue, GetScheduleMaxValue, &
CheckScheduleValue
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Item ! Item to be "gotten"
INTEGER :: NumAlphas = 0 ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers = 0 ! Number of Numbers for each GetObjectItem call
INTEGER :: IOStatus = 0 ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL, SAVE :: MyOneTimeFlag = .true.
INTEGER :: MaxNumAlphas = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: MaxNumNumbers = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: TotalArgs = 0 !argument for call to GetObjectDefMaxArgs
LOGICAL :: IsNotOK = .false.
LOGICAL :: IsBlank = .false.
INTEGER :: alphaOffset = 0 !
INTEGER :: surfNum = 0
CHARACTER(len=MaxNameLength) :: objNameMsg = ' '
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cAlphaFieldNames
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cNumericFieldNames
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericFieldBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaFieldBlanks
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: cAlphaArgs
REAL(r64),ALLOCATABLE, DIMENSION(:) :: rNumericArgs
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
REAL(r64) :: tmpMax = 0.0d0
REAL(r64) :: tmpMin = 0.0d0
REAL(r64) :: tmpNumerator = 0.0d0
REAL(r64) :: tmpArea = 0.0d0
REAL(r64) :: tmpDenominator = 0.0d0
INTEGER :: thisSurf = 0
INTEGER :: NumIrrigation
INTEGER :: Dummy
If( (MyOneTimeFlag).AND. (.NOT.( WaterSystemGetInputCalled)) ) THEN !big block for entire subroutine
cCurrentModuleObject = 'WaterUse:Storage'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
MaxNumNumbers=NumNumbers
MaxNumAlphas=NumAlphas
cCurrentModuleObject = 'WaterUse:RainCollector'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
MaxNumNumbers=MAX(MaxNumNumbers,NumNumbers)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'WaterUse:Well'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
MaxNumNumbers=MAX(MaxNumNumbers,NumNumbers)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'Site:Precipitation'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
MaxNumNumbers=MAX(MaxNumNumbers,NumNumbers)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'RoofIrrigation'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
MaxNumNumbers=MAX(MaxNumNumbers,NumNumbers)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
ALLOCATE(cAlphaFieldNames(MaxNumAlphas))
cAlphaFieldNames=' '
ALLOCATE(cAlphaArgs(MaxNumAlphas))
cAlphaArgs=' '
ALLOCATE(lAlphaFieldBlanks(MaxNumAlphas))
lAlphaFieldBlanks=.false.
ALLOCATE(cNumericFieldNames(MaxNumNumbers))
cNumericFieldNames=' '
ALLOCATE(rNumericArgs(MaxNumNumbers))
rNumericArgs=0.0d0
ALLOCATE(lNumericFieldBlanks(MaxNumNumbers))
lNumericFieldBlanks=.false.
MyOneTimeFlag = .false.
cCurrentModuleObject = 'WaterUse:Storage'
NumWaterStorageTanks=GetNumObjectsFound(cCurrentModuleObject)
IF (NumWaterStorageTanks > 0) THen
AnyWaterSystemsInModel=.true.
IF (.NOT.(Allocated(WaterStorage))) Allocate(WaterStorage(NumWaterStorageTanks))
DO Item=1,NumWaterStorageTanks
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
AnyWaterSystemsInModel=.true.
WaterStorage(Item)%Name = cAlphaArgs(1)
Call VerifyName( cAlphaArgs(1), WaterStorage%Name, Item -1, IsNotOK,IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
objNameMsg = trim(TRIM(cCurrentModuleObject)//' = '//trim(cAlphaArgs(1)))
WaterStorage(Item)%QualitySubCategoryName = cAlphaArgs(2)
! If (SameString(cAlphaArgs(2), 'Mains')) Then
! WaterStorage(Item)%QualitySubCategory = MainsWater
! ELSEIF (SameString(cAlphaArgs(2), 'RAINWATER')) Then
! WaterStorage(Item)%QualitySubCategory = RainWater
!
! ELSEIF (SameString(cAlphaArgs(2), 'GREYWATER')) Then
! WaterStorage(Item)%QualitySubCategory = GreyWater
!
! ELSEIF (SameString(cAlphaArgs(2), 'WELLWATER')) Then
! WaterStorage(Item)%QualitySubCategory = WellWater
!
! ELSEIF (SameString(cAlphaArgs(2), 'BLACKWATER')) Then
! WaterStorage(Item)%QualitySubCategory = BlackWater
! ELSE
! CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
! CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
! ErrorsFound = .true.
! ENDIF
WaterStorage(Item)%MaxCapacity = rNumericArgs(1)
IF (WaterStorage(Item)%MaxCapacity == 0.0d0 ) Then !default
WaterStorage(Item)%MaxCapacity = BigNumber
endif
WaterStorage(Item)%InitialVolume = rNumericArgs(2)
WaterStorage(Item)%MaxInFlowRate = rNumericArgs(3)
IF (WaterStorage(Item)%MaxInFlowRate == 0.0d0 ) Then !default
WaterStorage(Item)%MaxInFlowRate = BigNumber
endif
WaterStorage(Item)%MaxOutFlowRate = rNumericArgs(4)
IF (WaterStorage(Item)%MaxOutFlowRate == 0.0d0 ) Then !default
WaterStorage(Item)%MaxOutFlowRate = BigNumber
endif
WaterStorage(Item)%OverflowTankName = cAlphaArgs(3) ! setup later
If (SameString(cAlphaArgs(4), 'None')) Then
WaterStorage(Item)%ControlSupplyType = NoControlLevel
elseif (SameString(cAlphaArgs(4), 'Mains')) Then
WaterStorage(Item)%ControlSupplyType = MainsFloatValve
elseif (SameString(cAlphaArgs(4), 'GroundwaterWell')) Then
WaterStorage(Item)%ControlSupplyType = WellFloatValve
elseif (SameString(cAlphaArgs(4), 'OtherTank')) THEN
WaterStorage(Item)%ControlSupplyType = OtherTankFloatValve
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .true.
endif
WaterStorage(Item)%ValveOnCapacity = rNumericArgs(5)
WaterStorage(Item)%ValveOffCapacity = rNumericArgs(6)
IF (WaterStorage(Item)%ControlSupplyType /= NoControlLevel) THEN
IF (WaterStorage(Item)%ValveOffCapacity < WaterStorage(Item)%ValveOnCapacity) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(5))//' and/or '// TRIM(cNumericFieldNames(6)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError( TRIM(cNumericFieldNames(6)) //' must be greater than '//TRIM(cNumericFieldNames(5)) )
CALL ShowContinueError('Check value for '//TRIM(cNumericFieldNames(5))//' = ' &
//TRIM(RoundSIgDigits(WaterStorage(Item)%ValveOnCapacity, 5)) )
CALL ShowContinueError('which must be lower than '//TRIM(cNumericFieldNames(6))//' = ' &
//TRIM(RoundSIgDigits(WaterStorage(Item)%ValveOffCapacity, 5)) )
ErrorsFound = .true.
ENDIF
ENDIF
WaterStorage(Item)%BackupMainsCapacity = rNumericArgs(7)
If (WaterStorage(Item)%BackupMainsCapacity > 0.0d0) Then !add backup to well and other thank supply
If (WaterStorage(Item)%ControlSupplyType == WellFloatValve) Then
WaterStorage(Item)%ControlSupplyType = WellFloatMainsBackup
endif
If (WaterStorage(Item)%ControlSupplyType == OtherTankFloatValve) Then
WaterStorage(Item)%ControlSupplyType = TankMainsBackup
endif
endif
WaterStorage(Item)%SupplyTankName = cAlphaArgs(5) !set up later
If (SameString(cAlphaArgs(6), 'ScheduledTemperature')) Then
WaterStorage(item)%ThermalMode = ScheduledTankTemp
ELSEIF (SameString(cAlphaArgs(6), 'ThermalModel')) Then
WaterStorage(item)%ThermalMode = TankZoneThermalCoupled
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ENDIF
If (WaterStorage(Item)%ThermalMode == ScheduledTankTemp) Then
WaterStorage(item)%TempSchedID = GetScheduleIndex(cAlphaArgs(7))
If (WaterStorage(item)%TempSchedID == 0) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
tmpMin = GetScheduleMinValue(WaterStorage(item)%TempSchedID)
IF (tmpMin < 0.0d0) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
Call ShowContinueError('Found storage tank temperature schedule value less than 0.0 in '//trim(objNameMsg))
errorsfound = .true.
ENDIF
tmpMax = GetScheduleMaxValue(WaterStorage(item)%TempSchedID)
If (tmpMax > 100.0d0) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
Call ShowContinueError('found storage tank temperature schedule value greater than 100.0 in '//trim(objNameMsg))
errorsfound = .true.
ENDIF
ENDIF
If (WaterStorage(Item)%ThermalMode == TankZoneThermalCoupled) THEN
If (SameString(cAlphaArgs(8), 'Schedule')) THEN
WaterStorage(item)%AmbientTempIndicator = AmbientTempSchedule
ELSEIF (SameString(cAlphaArgs(8), 'Zone')) THEN
WaterStorage(item)%AmbientTempIndicator = AmbientTempZone
ELSEIF (SameString(cAlphaArgs(8), 'Outdoors')) THEN
WaterStorage(item)%AmbientTempIndicator = AmbientTempExterior
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(cAlphaArgs(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
WaterStorage(item)%AmbientTempSchedule = GetScheduleIndex(cAlphaArgs(9))
If ((WaterStorage(item)%AmbientTempSchedule == 0) .AND. &
(WaterStorage(item)%AmbientTempIndicator == AmbientTempSchedule)) then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
endif
WaterStorage(Item)%ZoneID = FindItemInList(cAlphaArgs(10), Zone%Name, NumOfZones)
If ((WaterStorage(Item)%ZoneID == 0) .AND. (WaterStorage(item)%AmbientTempIndicator == AmbientTempZone)) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(cAlphaArgs(10)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .true.
ENDIF
WaterStorage(Item)%SurfArea = rNumericArgs(8)
WaterStorage(Item)%UValue = rNumericArgs(9)
WaterStorage(Item)%SurfMaterialName = cAlphaArgs(11)
! todo verify material collect and store useful data from it.
ENDIF
ENDDO
ENDIF ! num water storage tanks > 0
cCurrentModuleObject = 'WaterUse:RainCollector'
NumRainCollectors = GetNumObjectsFound(cCurrentModuleObject)
If (NumRainCollectors > 0) then
IF (.NOT.(Allocated(RainCollector))) Allocate(RainCollector(NumRainCollectors))
! allow exensible reference to surfaces.
AnyWaterSystemsInModel=.true.
DO Item=1,NumRainCollectors
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
RainCollector(Item)%Name = cAlphaArgs(1)
Call VerifyName( cAlphaArgs(1), RainCollector%Name, Item -1, IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Named ')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
ObjNameMsg = TRIM(cCurrentModuleObject)//' Named '//trim(cAlphaArgs(1))
RainCollector(Item)%StorageTankName = cAlphaArgs(2)
RainCollector(Item)%StorageTankID = FindItemInList(cAlphaArgs(2), WaterStorage%Name, NumWaterStorageTanks)
IF (RainCollector(Item)%StorageTankID == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
IF (SameString(cAlphaArgs(3), 'Constant')) THEN
RainCollector(Item)%LossFactorMode = ConstantRainLossFactor
ELSEIF (SameString(cAlphaArgs(3), 'Scheduled')) THEN
RainCollector(Item)%LossFactorMode = ScheduledRainLossFactor
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
RainCollector(Item)%LossFactor = rNumericArgs(1)
If (RainCollector(Item)%LossFactor > 1.0d0) then
CALL ShowWarningError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
Call ShowContinueError('found rain water collection loss factor greater than 1.0, simulation continues')
endif
If (RainCollector(Item)%LossFactor < 0.0d0) then
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
Call ShowContinueError('found rain water collection loss factor less than 0.0')
errorsfound = .true.
endif
If (RainCollector(Item)%LossFactorMode == ScheduledRainLossFactor) THEN
RainCollector(Item)%LossFactorSchedID = GetScheduleIndex(cAlphaArgs(4))
If (RainCollector(Item)%LossFactorSchedID == 0) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
IF (GetScheduleMinValue(RainCollector(Item)%LossFactorSchedID) < 0.0d0) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
Call ShowContinueError('found rain water collection loss factor schedule value less than 0.0 in '//trim(objNameMsg))
errorsfound = .true.
ENDIF
If (GetScheduleMaxValue(RainCollector(Item)%LossFactorSchedID) > 1.0d0) Then
CALL showWarningError('Potentially invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
Call ShowContinueError('found rain water collection loss factor schedule value greater than 1.0, '// &
'simulation continues' )
! allowing it to continue
ENDIF
ENDIF
RainCollector(Item)%MaxCollectRate = rNumericArgs(1)
If (RainCollector(Item)%MaxCollectRate == 0.0d0) RainCollector(Item)%MaxCollectRate = 100000000000.0d0
!number of surfaces is extensible and = NumAlphas - alphaOffset
alphaOffset = 4 !update this if more alphas inserted ahead of extensible surface listing
RainCollector(Item)%NumCollectSurfs = NumAlphas - alphaOffset
Allocate(RainCollector(Item)%SurfName(RainCollector(Item)%NumCollectSurfs))
Allocate(RainCollector(Item)%SurfID(RainCollector(Item)%NumCollectSurfs))
Do surfNum=1, RainCollector(Item)%NumCollectSurfs
RainCollector(Item)%SurfName(surfNum) = cAlphaArgs(surfNum + alphaOffset)
RainCollector(Item)%SurfID(surfNum) = FindItemInList(cAlphaArgs(surfNum + alphaOffset), Surface%Name, TotSurfaces)
IF ( RainCollector(Item)%SurfID(surfNum) == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(surfNum+alphaOffset))//'='//TRIM(cAlphaArgs(surfNum+alphaOffset)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
ENDDO
! now setup horizontal surface area
tmpArea = 0.0d0
tmpNumerator = 0.0d0
tmpDenominator = 0.0d0
Do surfNum=1, RainCollector(Item)%NumCollectSurfs
thisSurf = RainCollector(Item)%SurfID(surfNum)
tmpArea = tmpArea + Surface(thisSurf)%GrossArea * Surface(thisSurf)%CosTilt
tmpNumerator = tmpNumerator + Surface(thisSurf)%Centroid%z * Surface(thisSurf)%GrossArea
tmpDenominator = tmpDenominator + Surface(thisSurf)%GrossArea
ENDDO
RainCollector(Item)%HorizArea = tmpArea
!now setup vertical hieght above ground for height dependent outdoor temps
RainCollector(Item)%MeanHeight = tmpNumerator / tmpDenominator
! now set up tank supply connection
Call InternalSetupTankSupplyComponent(RainCollector(Item)%Name, TRIM(cCurrentModuleObject), &
RainCollector(Item)%StorageTankName, &
errorsFound, RainCollector(Item)%StorageTankID, RainCollector(Item)%StorageTankSupplyARRID)
ENDDO
ENDIF ! (NumRainCollectors > 0)
cCurrentModuleObject = 'WaterUse:Well'
NumGroundWaterWells=GetNumObjectsFound(cCurrentModuleObject)
If (NumGroundWaterWells > 0) Then
AnyWaterSystemsInModel=.true.
Allocate(GroundwaterWell(NumGroundWaterWells))
DO Item=1,NumGroundWaterWells
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
GroundwaterWell(Item)%Name = cAlphaArgs(1)
Call VerifyName( cAlphaArgs(1), GroundwaterWell%Name, Item -1, IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
objNameMsg = TRIM(cCurrentModuleObject)//' Named '//TRIM(cAlphaArgs(1))
GroundwaterWell(Item)%StorageTankName = cAlphaArgs(2)
Call InternalSetupTankSupplyComponent(GroundwaterWell(Item)%Name, TRIM(cCurrentModuleObject), &
GroundwaterWell(Item)%StorageTankName, &
errorsFound, GroundwaterWell(Item)%StorageTankID, GroundwaterWell(Item)%StorageTankSupplyARRID)
If (allocated(WaterStorage)) WaterStorage(GroundwaterWell(Item)%StorageTankID)%GroundWellID = Item
GroundwaterWell(Item)%PumpDepth = rNumericArgs(1)
GroundwaterWell(Item)%PumpNomVolFlowRate = rNumericArgs(2)
GroundwaterWell(Item)%PumpNomHead = rNumericArgs(3)
GroundwaterWell(Item)%PumpNomPowerUse = rNumericArgs(4)
GroundwaterWell(Item)%PumpEfficiency = rNumericArgs(5)
GroundwaterWell(Item)%WellRecoveryRate = rNumericArgs(6)
GroundwaterWell(Item)%NomWellStorageVol = rNumericArgs(7)
If (SameString(cAlphaArgs(3), 'Constant')) THEN
GroundwaterWell(Item)%GroundwaterTableMode = ConstantWaterTable
ELSEIF (SameString(cAlphaArgs(3), 'Scheduled') ) THEN
GroundwaterWell(Item)%GroundwaterTableMode = ScheduledWaterTable
ELseIF (lAlphaFieldBlanks(3) ) then
GroundwaterWell(Item)%GroundwaterTableMode = 0
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
ENDIF
! N8, \field water table depth
GroundwaterWell(Item)%WaterTableDepth = rNumericArgs(8)
! A4; \field water table depth schedule
GroundwaterWell(Item)%WaterTableDepthSchedID = GetScheduleIndex(cAlphaArgs(4))
If ((GroundwaterWell(Item)%GroundwaterTableMode == ScheduledWaterTable) .AND. &
( GroundwaterWell(Item)%WaterTableDepthSchedID == 0) ) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
errorsfound = .true.
endif
ENDDO
ENDIF !(NumGroundWaterWells > 0)
! do some water tank setup
cCurrentModuleObject = 'WaterUse:Storage'
IF (NumWaterStorageTanks > 0) THen
DO Item=1,NumWaterStorageTanks
! check that all storage tanks with ground well controls actually had wells pointing to them
If(( WaterStorage(Item)%ControlSupplyType == WellFloatValve) &
.or. (WaterStorage(Item)%ControlSupplyType == WellFloatMainsBackup)) THEN
If (WaterStorage(Item)%GroundWellID == 0) Then
Call ShowSevereError(TRIM(cCurrentModuleObject)//'= "'//trim(WaterStorage(Item)%Name) &
//'" does not have a WaterUse:Well (groundwater well) that names it.')
errorsFound = .true.
ENDIF
ENDIF
! setup tanks whose level is controlled by supply from another tank
If(( WaterStorage(Item)%ControlSupplyType == OtherTankFloatValve) &
.or. (WaterStorage(Item)%ControlSupplyType == TankMainsBackup)) THEN
WaterStorage(Item)%SupplyTankID = &
FindItemInList(WaterStorage(Item)%SupplyTankName, WaterStorage%Name, NumWaterStorageTanks)
If (WaterStorage(Item)%SupplyTankID == 0) Then
Call ShowSevereError('Other tank called '//trim(WaterStorage(Item)%SupplyTankName) & ! TODO rename point
//' not found for '//TRIM(cCurrentModuleObject)//' Named '//trim(WaterStorage(Item)%Name) )
errorsFound = .true.
ENDIF
CALL InternalSetupTankDemandComponent(WaterStorage(Item)%Name, TRIM(cCurrentModuleObject), &
WaterStorage(Item)%SupplyTankName, ErrorsFound, WaterStorage(Item)%SupplyTankID, &
WaterStorage(Item)%SupplyTankDemandARRID)
!call to setup tank supply as well
Call InternalSetupTankSupplyComponent(WaterStorage(Item)%SupplyTankName, TRIM(cCurrentModuleObject), &
WaterStorage(Item)%Name, &
errorsFound, dummy, dummy)
ENDIF
! setup overflow inputs
WaterStorage(Item)%OverflowTankID = &
FindItemInList(WaterStorage(Item)%OverflowTankName, WaterStorage%Name, NumWaterStorageTanks)
If (WaterStorage(Item)%OverflowTankID == 0) Then
! if blank, then okay it is discarded. but if not blank then error
IF (WaterStorage(Item)%OverflowTankName == ' ') THEN
WaterStorage(Item)%OverflowMode = OverflowDiscarded
ELSE
Call ShowSevereError('Overflow tank name of '//trim(WaterStorage(Item)%OverflowTankName)// &
' not found for '//TRIM(cCurrentModuleObject)//' Named '//trim(WaterStorage(Item)%Name) )
errorsfound = .true.
ENDIF
ELSE
WaterStorage(Item)%OverflowMode = OverflowToTank
ENDIf
If (WaterStorage(Item)%OverflowMode == OverflowToTank) Then
Call InternalSetupTankSupplyComponent(WaterStorage(Item)%Name, TRIM(cCurrentModuleObject), &
WaterStorage(Item)%OverflowTankName, &
errorsFound, WaterStorage(Item)%OverflowTankID, WaterStorage(Item)%OverflowTankSupplyARRID)
ENDIF
ENDDO
ENDIF
cCurrentModuleObject = 'Site:Precipitation'
NumSiteRainFall=GetNumObjectsFound(cCurrentModuleObject)
IF (NumsiteRainFall > 1) THEN ! throw error
Call ShowSevereError('Only one '//TRIM(cCurrentModuleObject)//' object is allowed')
errorsfound = .true.
ENDIF
If (NumSiteRainFall == 1) then
AnyWaterSystemsInModel=.true.
CALL GetObjectItem(cCurrentModuleObject,1,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus)
If (SameString(cAlphaArgs(1), 'ScheduleAndDesignLevel') ) then
RainFall%ModeID = RainSchedDesign
ELSE
Call ShowSevereError('Precipitation Model Type of '//TRIM(cCurrentModuleObject)//' is incorrect.')
Call ShowContinueError('Only available option is ScheduleAndDesignLevel.')
errorsFound = .true.
ENDIF
RainFall%RainSchedID = GetScheduleIndex(cAlphaArgs(2))
If ((RainFall%RainSchedID == 0) .AND. (RainFall%ModeID == RainSchedDesign)) then
Call ShowSevereError('Schedule not found for '//TRIM(cCurrentModuleObject)//' object')
errorsFound = .true.
ElseIf ((RainFall%RainSchedID == 0) .AND. (RainFall%ModeID == RainSchedDesign)) then
If (.not. CheckScheduleValueMinMax(RainFall%RainSchedID,'>=',0.0d0) ) then
CALL ShowSevereError('Schedule='//trim(cAlphaArgs(2))//' for '//TRIM(cCurrentModuleObject)//' object has values < 0.')
errorsFound = .true.
ENDIF
ENDIF
RainFall%DesignAnnualRain = rNumericArgs(1)
RainFall%NomAnnualRain = rNumericArgs(2)
ENDIF
cCurrentModuleObject = 'RoofIrrigation'
NumIrrigation = GetNumObjectsFound(cCurrentModuleObject)
IF (NumIrrigation > 1) THEN
Call ShowSevereError('Only one '//TRIM(cCurrentModuleObject)//' object is allowed')
errorsFound = .true.
Endif
IF (NumIrrigation == 1) THEN
AnyIrrigationInModel = .true.
CALL GetObjectItem(cCurrentModuleObject,1,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus)
IF (SameString(cAlphaArgs(1), 'Schedule') ) THEN
Irrigation%ModeID = IrrSchedDesign
ELSEIF ( SameString(cAlphaArgs(1), 'SmartSchedule')) THEN
Irrigation%ModeID = IrrSmartSched
ELSE
CALL ShowSevereError('Type of '//TRIM(cCurrentModuleObject)//' is incorrect. Options are '// &
'Schedule or SmartSchedule')
errorsFound = .true.
ENDIF
Irrigation%IrrSchedID = GetScheduleIndex(cAlphaArgs(2))
IF ((Irrigation%IrrSchedID == 0) .AND. ((Irrigation%ModeID == IrrSchedDesign) .OR. Irrigation%ModeID == IrrSmartSched) )then
CALL ShowSevereError ('Schedule not found for '//TRIM(cCurrentModuleObject)//' object')
errorsFound = .true.
ELSEIF ((Irrigation%IrrSchedID == 0) .AND. (Irrigation%ModeID == IrrSchedDesign)) THEN
IF (.not. CheckScheduleValueMinMax(Irrigation%IrrSchedID,'>=',0.0d0) ) THEN
CALL ShowSevereError('Schedule='//TRIM(cAlphaArgs(2))//' for '//TRIM(cCurrentModuleObject)//' object has values < 0.')
errorsFound = .true.
ENDIF
ENDIF
! If we later add a designannualirrigation and a nominalannualirrigation variable (for scaling) those
! would be assigned here... as with the Rainfall...
Irrigation%IrrigationThreshold=0.4d0
IF (Irrigation%ModeID == IrrSmartSched .and. NumNumbers > 0) THEN
IF (rNumericArgs(1) > 100.d0 .or. rNumericArgs(1) < 0.0d0) THEN
CALL ShowSevereError('Irrigation threshold for '//TRIM(cCurrentModuleObject)//' object has values > 100 or < 0.')
errorsFound = .true.
ELSE
Irrigation%IrrigationThreshold=rNumericArgs(1)/100.d0
endif
ENDIF
ENDIF ! NumIrrigation ==1
AnyWaterSystemsInModel=.true.
WaterSystemGetInputCalled = .true.
MyOneTimeFlag = .false.
DEALLOCATE(cAlphaFieldNames)
DEALLOCATE(cAlphaArgs)
DEALLOCATE(lAlphaFieldBlanks)
DEALLOCATE(cNumericFieldNames)
DEALLOCATE(rNumericArgs)
DEALLOCATE(lNumericFieldBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for water manager objects')
ENDIF
! <SetupOutputVariables here...>, CurrentModuleObject='WaterUse:Storage'
DO Item=1,NumWaterStorageTanks
! this next one is a measure of the state of water in the tank, not a flux of m3 that needs to be summed
CALL SetupOutputVariable('Water System Storage Tank Volume [m3]', &
WaterStorage(item)%ThisTimeStepVolume,'System','Average',WaterStorage(item)%Name)
CALL SetupOutputVariable('Water System Storage Tank Net Volume Flow Rate [m3/s]', &
WaterStorage(item)%NetVdot,'System','Average',WaterStorage(item)%Name)
CALL SetupOutputVariable('Water System Storage Tank Inlet Volume Flow Rate [m3/s]', &
WaterStorage(item)%VdotToTank,'System','Average',WaterStorage(item)%Name)
CALL SetupOutputVariable('Water System Storage Tank Outlet Volume Flow Rate [m3/s]', &
WaterStorage(item)%VdotFromTank,'System','Average',WaterStorage(item)%Name)
CALL SetupOutputVariable('Water System Storage Tank Mains Water Volume [m3]', &
WaterStorage(item)%MainsDrawVol,'System','Sum',WaterStorage(item)%Name, &
ResourceTypeKey='MainsWater', &
EndUseKey='WaterSystem', &
EndUseSubKey=WaterStorage(item)%QualitySubCategoryName, &
GroupKey='System')
CALL SetupOutputVariable('Water System Storage Tank Mains Water Volume Flow Rate [m3/s]', &
WaterStorage(item)%MainsDrawVdot,'System','Average',WaterStorage(item)%Name)
CALL SetupOutputVariable('Water System Storage Tank Water Temperature [C]', &
WaterStorage(item)%Twater,'System','Average',WaterStorage(item)%Name)
CALL SetupOutputVariable('Water System Storage Tank Overflow Volume Flow Rate [m3/s]', &
WaterStorage(item)%VdotOverflow,'System','Average',WaterStorage(item)%Name)
If (WaterStorage(item)%OverflowMode == OverflowDiscarded) Then
CALL SetupOutputVariable('Water System Storage Tank Overflow Water Volume [m3]', &
WaterStorage(item)%VolOverflow,'System','Sum',WaterStorage(item)%Name)
! ResourceTypeKey='Water', &
! EndUseKey='WaterSystems', &
! EndUseSubkey=WaterStorage(item)%QualitySubCategoryName ,&
! GroupKey='System')
ELSE
CALL SetupOutputVariable('Water System Storage Tank Overflow Water Volume [m3]', &
WaterStorage(item)%VolOverflow,'System','Sum',WaterStorage(item)%Name)
ENDIF
CALL SetupOutputVariable('Water System Storage Tank Overflow Temperature [C]', &
WaterStorage(item)%TwaterOverflow,'System','Average',WaterStorage(item)%Name)
ENDDO
If (NumSiteRainFall ==1) Then ! CurrentModuleObject='Site:Precipitation'
CALL SetupOutputVariable('Site Precipitation Rate [m/s]', &
RainFall%CurrentRate,'System','Average','Site:Precipitation')
CALL SetupOutputVariable('Site Precipitation Depth [m]', &
RainFall%CurrentAmount,'System','Sum','Site:Precipitation')
endif
If (NumIrrigation ==1) Then ! CurrentModuleObject='RoofIrrigation'
CALL SetupOutputVariable('Water System Roof Irrigation Scheduled Depth [m]', &
Irrigation%ScheduledAmount,'System','Sum','RoofIrrigation')
CALL SetupOutputVariable('Water System Roof Irrigation Actual Depth [m]', &
Irrigation%ActualAmount,'System','Sum','RoofIrrigation')
endif
DO Item =1, NumRainCollectors ! CurrentModuleObject='WaterUse:RainCollector'
CALL SetupOutputVariable('Water System Rainwater Collector Volume Flow Rate [m3/s]', &
RainCollector(item)%VdotAvail,'System','Average',RainCollector(item)%Name)
CALL SetupOutputVariable('Water System Rainwater Collector Volume [m3]', &
RainCollector(item)%VolCollected, 'System', 'Sum', RainCollector(item)%Name , &
ResourceTypeKey='OnSiteWater', EndUseKey='Rainwater', GroupKey='System')
ENDDO
Do Item =1, NumGroundWaterWells ! CurrentModuleObject='WaterUse:Well'
CALL SetupOutputVariable('Water System Groundwater Well Requested Volume Flow Rate [m3/s]', &
GroundwaterWell(item)%VdotRequest,'System','Average',GroundwaterWell(item)%Name)
CALL SetupOutputVariable('Water System Groundwater Well Volume Flow Rate [m3/s]', &
GroundwaterWell(item)%VdotDelivered,'System','Average',GroundwaterWell(item)%Name)
CALL SetupOutputVariable('Water System Groundwater Well Volume [m3]', &
GroundwaterWell(item)%VolDelivered,'System','Sum',GroundwaterWell(item)%Name, &
ResourceTypeKey='OnSiteWater', EndUseKey='Wellwater', GroupKey='System')
CALL SetupOutputVariable('Water System Groundwater Well Pump Electric Power [W]', &
GroundwaterWell(item)%PumpPower,'System','Average',GroundwaterWell(item)%Name)
CALL SetupOutputVariable('Water System Groundwater Well Pump Electric Energy [J]', &
GroundwaterWell(item)%PumpEnergy,'System','Sum',GroundwaterWell(item)%Name, &
ResourceTypeKey='Electricity', EndUseKey='WaterSystems', GroupKey='System')
ENDDO
ENDIF ! my one time flag block
RETURN
END SUBROUTINE GetWaterManagerInput