Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | TankNum |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE CalcWaterStorageTank(TankNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN August 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Collect the calculations used to update the modeled values
! for the storage tanks at each system timestep
!
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: SecInHour, BeginTimeStepFlag
USE DataHVACGlobals, ONLY: TimeStepSys
USE ScheduleManager, ONLY: GetCurrentScheduleValue
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, Intent(IN) :: TankNum ! Index of storage tank
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! see DataWater.f90
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: OrigVdotDemandRequest = 0.0d0
REAL(r64) :: TotVdotDemandAvail = 0.0d0
REAL(r64) :: OrigVolDemandRequest = 0.0d0
REAL(r64) :: TotVolDemandAvail = 0.0d0
REAL(r64) :: OrigVdotSupplyAvail = 0.0d0
REAL(r64) :: TotVdotSupplyAvail = 0.0d0
REAL(r64) :: TotVolSupplyAvail = 0.0d0
! REAL(r64) :: TotVolSupplyAllow = 0.0d0
REAL(r64) :: overflowVdot = 0.0d0
REAL(r64) :: overflowVol = 0.0d0
REAL(r64) :: overflowTwater = 0.0d0
REAL(r64) :: NetVdotAdd = 0.0d0
REAL(r64) :: NetVolAdd = 0.0d0
REAL(r64) :: FillVolRequest = 0.0d0
REAL(r64) :: TotVolAllowed = 0.0d0
REAL(r64) :: AvailVolume = 0.0d0
REAL(r64) :: underflowVdot = 0.0d0
REAL(r64) :: VolumePredict = 0.0d0
REAL(r64) :: OverFillVolume = 0.0d0
If (BeginTimeStepFlag) then
! initializations are done in UpdateWaterManager
endif
overflowVdot = 0.0d0
IF (WaterStorage(TankNum)%NumWaterSupplies > 0) THEN
OrigVdotSupplyAvail = Sum(WaterStorage(TankNum)%VdotAvailSupply)
ELSE
OrigVdotSupplyAvail = 0.0d0
ENDIF
TotVdotSupplyAvail = OrigVdotSupplyAvail ! Init
If (TotVdotSupplyAvail > WaterStorage(TankNum)%MaxInFlowRate) THen
! pipe/filter rate constraints on inlet
overflowVdot = TotVdotSupplyAvail - WaterStorage(TankNum)%MaxInFlowRate
overflowTwater = Sum(WaterStorage(TankNum)%VdotAvailSupply * WaterStorage(TankNum)%TwaterSupply) &
/ Sum(WaterStorage(TankNum)%VdotAvailSupply)
TotVdotSupplyAvail = WaterStorage(TankNum)%MaxInFlowRate
endif
TotVolSupplyAvail = TotVdotSupplyAvail * TimeStepSys * SecInHour
overflowVol = overflowVdot * TimeStepSys * SecInHour
underflowVdot = 0.0d0
IF (WaterStorage(TankNum)%NumWaterDemands > 0) THEN
OrigVdotDemandRequest = Sum(WaterStorage(TankNum)%VdotRequestDemand)
ELSE
OrigVdotDemandRequest = 0.0d0
ENDIF
OrigVolDemandRequest = OrigVdotDemandRequest * TimeStepSys * SecInHour
TotVdotDemandAvail = OrigVdotDemandRequest ! initialize to satisfied then modify if needed
If (TotVdotDemandAvail > WaterStorage(TankNum)%MaxOutFlowRate) THEN
! pipe/filter rate constraints on outlet
underflowVdot = OrigVdotDemandRequest - WaterStorage(TankNum)%MaxOutFlowRate
TotVdotDemandAvail = WaterStorage(TankNum)%MaxOutFlowRate
ENDIF
TotVolDemandAvail = TotVdotDemandAvail* (TimeStepSys * SecInHour)
NetVdotAdd = TotVdotSupplyAvail - TotVdotDemandAvail
NetVolAdd = NetVdotAdd * (TimeStepSys * SecInHour)
VolumePredict = WaterStorage(TankNum)%LastTimeStepVolume + NetVolAdd
! would tank capacity be exceeded?
TotVolAllowed = WaterStorage(TankNum)%MaxCapacity - WaterStorage(TankNum)%LastTimeStepVolume
If (VolumePredict > WaterStorage(TankNum)%MaxCapacity) THEN ! too much
! added overflow to inlet rate limit, new temperature model
OverFillVolume = (VolumePredict - WaterStorage(TankNum)%MaxCapacity)
overflowTwater = (overflowTwater * overflowVol + OverFillVolume * WaterStorage(TankNum)%Twater) &
/ (overflowVol + OverFillVolume)
overflowVol = overflowVol + OverFillVolume
NetVolAdd = NetVolAdd - OverFillVolume
NetVdotAdd = NetVolAdd / (TimeStepSys * SecInHour)
VolumePredict = WaterStorage(TankNum)%MaxCapacity
endif
!Is tank too low to meet the request?
IF (VolumePredict < 0.0d0) THEN
AvailVolume = WaterStorage(TankNum)%LastTimeStepVolume + TotVolSupplyAvail
AvailVolume = MAX(0.d0, AvailVolume)
TotVolDemandAvail = AvailVolume
TotVdotDemandAvail = AvailVolume / (TimeStepSys * SecInHour)
underflowVdot = OrigVdotDemandRequest - TotVdotDemandAvail
NetVdotAdd = TotVdotSupplyAvail - TotVdotDemandAvail
NetVolAdd = NetVdotAdd * (TimeStepSys * SecInHour)
VolumePredict = 0.0d0
ENDIF
If (TotVdotDemandAvail < OrigVdotDemandRequest) Then ! starvation
! even distribution
IF (OrigVdotDemandRequest > 0.d0) THEN
WaterStorage(TankNum)%VdotAvailDemand = (TotVdotDemandAvail/OrigVdotDemandRequest) &
* WaterStorage(TankNum)%VdotRequestDemand
ELSE
WaterStorage(TankNum)%VdotAvailDemand = 0.d0
ENDIF
ELSE ! requested demand can be served
IF (WaterStorage(TankNum)%NumWaterDemands > 0) THEN
WaterStorage(TankNum)%VdotAvailDemand = WaterStorage(TankNum)%VdotRequestDemand
ENDIF
ENDIF
! is tank lower than float valve on capacity and requesting fill from controlled supplier?
FillVolRequest = 0.0d0
If ((VolumePredict)< WaterStorage(TankNum)%ValveOnCapacity) THen !turn on supply to fill tank
FillVolRequest = WaterStorage(TankNum)%ValveOffCapacity - VolumePredict
! set mains draws for float on (all the way to Float off)
IF (WaterStorage(TankNum)%ControlSupplyType == MainsFloatValve) then
WaterStorage(TankNum)%MainsDrawVdot = FillVolRequest / (TimeStepSys * SecInHour)
NetVolAdd = FillVolRequest
endif
! set demand request in supplying tank if needed
IF ((WaterStorage(TankNum)%ControlSupplyType == OtherTankFloatValve) &
.OR. (WaterStorage(TankNum)%ControlSupplyType == TankMainsBackup)) THEN
WaterStorage(WaterStorage(TankNum)%SupplyTankID)%VdotRequestDemand(WaterStorage(TankNum)%SupplyTankDemandARRID) &
= FillVolRequest / (TimeStepSys * SecInHour)
!
ENDIF
! set demand request in groundwater well if needed
IF ((WaterStorage(TankNum)%ControlSupplyType == WellFloatValve) &
.OR. (WaterStorage(TankNum)%ControlSupplyType == WellFloatMainsBackup)) THEN
GroundwaterWell(WaterStorage(TankNum)%GroundWellID)%VdotRequest = FillVolRequest / (TimeStepSys * SecInHour)
ENDIF
ENDIF
! set mains flow if mains backup active
If ((VolumePredict)< WaterStorage(TankNum)%BackupMainsCapacity) THen !turn on supply
IF ((WaterStorage(TankNum)%ControlSupplyType == WellFloatMainsBackup) &
.OR. (WaterStorage(TankNum)%ControlSupplyType == TankMainsBackup)) THEN
FillVolRequest = WaterStorage(TankNum)%ValveOffCapacity - VolumePredict
WaterStorage(TankNum)%MainsDrawVdot = FillVolRequest / (TimeStepSys * SecInHour)
NetVolAdd = FillVolRequest
ENDIF
ENDIF
WaterStorage(TankNum)%ThisTimeStepVolume = WaterStorage(TankNum)%LastTimeStepVolume + NetVolAdd
WaterStorage(TankNum)%VdotOverflow = overflowVol / (TimeStepSys * SecInHour)
WaterStorage(TankNum)%VolOverflow = overflowVol
WaterStorage(TankNum)%TwaterOverflow = overflowTwater
WaterStorage(TankNum)%NetVdot = NetVolAdd / (TimeStepSys * SecInHour)
WaterStorage(TankNum)%MainsDrawVol = WaterStorage(TankNum)%MainsDrawVdot * (TimeStepSys * SecInHour)
WaterStorage(TankNum)%VdotToTank = TotVdotSupplyAvail
WaterStorage(TankNum)%VdotFromTank = TotVdotDemandAvail
Select Case (WaterStorage(TankNum)%ThermalMode)
Case(ScheduledTankTemp)
WaterStorage(TankNum)%Twater = GetCurrentScheduleValue(WaterStorage(TankNum)%TempSchedID)
WaterStorage(TankNum)%TouterSkin = WaterStorage(TankNum)%Twater
Case(TankZoneThermalCoupled)
CAll ShowFatalError('WaterUse:Storage (Water Storage Tank) zone thermal model incomplete')
End Select
!set supply avail data from overflows in Receiving tank
IF (WaterStorage(TankNum)%OverflowMode == OverflowToTank) THEN
WaterStorage(WaterStorage(TankNum)%OverflowTankID)%VdotAvailSupply(WaterStorage(TankNum)%OverflowTankSupplyARRID) &
= WaterStorage(TankNum)%VdotOverflow
WaterStorage(WaterStorage(TankNum)%OverflowTankID)%TwaterSupply(WaterStorage(TankNum)%OverflowTankSupplyARRID) &
= WaterStorage(TankNum)%TwaterOverflow
ENDIF
RETURN
END SUBROUTINE CalcWaterStorageTank