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) | :: | WaterThermalTankNum |
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 SizeTankForSupplySide(WaterThermalTankNum)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN February 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing water heater tank volume and heater
! at a later point in the simulation when more of the plant is ready.
! METHODOLOGY EMPLOYED:
! depending on the sizing design mode...
!
! REFERENCES:
! BA benchmark report for residential design mode
! USE STATEMENTS:
USE DataSizing, ONLY: AutoSize
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE OutputReportPredefined
USE SolarCollectors, ONLY: Collector, NumOfCollectors
USE DataSurfaces, ONLY: Surface
USE DataGlobals, ONLY: Pi
USE DataInterfaces, ONLY: ShowFatalError
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: WaterThermalTankNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
Real(r64), PARAMETER :: GalTocubicMeters = 0.0037854D0
Real(r64), PARAMETER :: kBtuPerHrToWatts = 293.1D0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: Tstart ! initial tank temp for sizing.
REAL(r64) :: Tfinish ! final target temp for sizing
INTEGER :: CollectorNum
Logical :: SizeVolume = .FALSE.
LOGICAL :: SizeMaxCapacity = .FALSE.
REAL(r64) :: rho
REAL(r64) :: Cp
INTEGER :: DummyWaterIndex = 1
REAL(r64) :: tmpTankVolume ! local temporary for tank volume m3
REAL(r64) :: tmpMaxCapacity ! local temporary for heating capacity W
! local inits
Tstart = 14.44d0
TFinish = 57.22d0
SizeVolume = .FALSE.
SizeMaxCapacity = .FALSE.
tmpTankVolume = WaterThermalTank(WaterThermalTankNum)%Volume
tmpMaxCapacity = WaterThermalTank(WaterThermalTankNum)%MaxCapacity
If (tmpTankVolume == Autosize) SizeVolume = .TRUE.
If (tmpMaxCapacity == Autosize) SizeMaxCapacity = .TRUE.
SELECT CASE (WaterThermalTank(WaterThermalTankNum)%Sizing%DesignMode)
CASE (SizePeakDraw)
If (SizeVolume) tmpTankVolume = &
WaterThermalTank(WaterThermalTankNum)%Sizing%TankDrawTime & ! hours
* WaterThermalTank(WaterThermalTankNum)%UseDesignVolFlowRate & ! m3/s
* SecInHour ! (3600 s/1 hour)
IF (SizeVolume .AND. PlantSizesOkayToFinalize) THEN
WaterThermalTank(WaterThermalTankNum)%Volume = tmpTankVolume
CALL ReportSizingOutput(WaterThermalTank(WaterThermalTankNum)%Type, &
WaterThermalTank(WaterThermalTankNum)%Name, &
'Tank Volume [m3]', WaterThermalTank(WaterThermalTankNum)%Volume )
ENDIF
If (SizeMaxCapacity) THEN
IF (WaterThermalTank(WaterThermalTankNum)%Sizing%RecoveryTime > 0.0d0) THEN
IF (WaterThermalTank(WaterThermalTankNum)%SourceSidePlantLoopNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(WaterThermalTank(WaterThermalTankNum)%SourceSidePlantLoopNum)%FluidName, &
((Tfinish + Tstart)/2.0D0), &
PlantLoop(WaterThermalTank(WaterThermalTankNum)%SourceSidePlantLoopNum)%FluidIndex, &
'SizeTankForSupplySide')
Cp = GetSpecificHeatGlycol(PlantLoop(WaterThermalTank(WaterThermalTankNum)%SourceSidePlantLoopNum)%FluidName, &
((Tfinish + Tstart)/2.0D0), &
PlantLoop(WaterThermalTank(WaterThermalTankNum)%SourceSidePlantLoopNum)%FluidIndex, &
'SizeTankForSupplySide')
ELSE
rho = GetDensityGlycol('WATER', ((Tfinish + Tstart)/2.0D0), DummyWaterIndex, 'SizeTankForSupplySide')
Cp = GetSpecificHeatGlycol('WATER', ((Tfinish + Tstart)/2.0D0), DummyWaterIndex, 'SizeTankForSupplySide')
ENDIF
tmpMaxCapacity = ( WaterThermalTank(WaterThermalTankNum)%Volume & ! m3
* rho & ! kg/m3
* Cp & ! J/Kg/K
* (Tfinish - Tstart)) & ! K
/ (WaterThermalTank(WaterThermalTankNum)%Sizing%RecoveryTime * SecInHour) ! seconds
ELSE
CALL ShowFatalError('SizeTankForSupplySide: Tank="'//TRIM(WaterThermalTank(WaterThermalTankNum)%Name)// &
'", requested sizing for max capacity but entered Recovery Time is zero.')
ENDIF
ENDIF
IF (SizeMaxCapacity .AND. PlantSizesOkayToFinalize) THEN
WaterThermalTank(WaterThermalTankNum)%MaxCapacity = tmpMaxCapacity
CALL ReportSizingOutput(WaterThermalTank(WaterThermalTankNum)%Type, &
WaterThermalTank(WaterThermalTankNum)%Name, &
'Maximum Heater Capacity [W]', WaterThermalTank(WaterThermalTankNum)%MaxCapacity )
ENDIF
CASE (SizePerSolarColArea)
WaterThermalTank(WaterThermalTankNum)%sizing%TotalSolarCollectorArea = 0.0D0
DO CollectorNum = 1, NumOfCollectors
WaterThermalTank(WaterThermalTankNum)%sizing%TotalSolarCollectorArea = &
WaterThermalTank(WaterThermalTankNum)%sizing%TotalSolarCollectorArea &
+ Surface( Collector(CollectorNum)%Surface )%Area !
ENDDO
IF (SizeVolume) tmpTankVolume = &
WaterThermalTank(WaterThermalTankNum)%sizing%TotalSolarCollectorArea &
* WaterThermalTank(WaterThermalTankNum)%sizing%TankCapacityPerCollectorArea
IF (SizeMaxCapacity) tmpMaxCapacity = 0.0D0
IF (SizeVolume .AND. PlantSizesOkayToFinalize) THEN
WaterThermalTank(WaterThermalTankNum)%Volume = tmpTankVolume
CALL ReportSizingOutput(WaterThermalTank(WaterThermalTankNum)%Type, &
WaterThermalTank(WaterThermalTankNum)%Name, &
'Tank Volume [m3]', WaterThermalTank(WaterThermalTankNum)%Volume )
ENDIF
IF (SizeMaxCapacity .AND. PlantSizesOkayToFinalize) THEN
WaterThermalTank(WaterThermalTankNum)%MaxCapacity = tmpMaxCapacity
CALL ReportSizingOutput(WaterThermalTank(WaterThermalTankNum)%Type, &
WaterThermalTank(WaterThermalTankNum)%Name, &
'Maximum Heater Capacity [W]', WaterThermalTank(WaterThermalTankNum)%MaxCapacity )
ENDIF
END SELECT
IF ((SizeVolume) .AND. (WaterThermalTank(WaterThermalTankNum)%TypeNum == StratifiedWaterHeater)&
.AND. PlantSizesOkayToFinalize ) THEN ! might set height
IF ((WaterThermalTank(WaterThermalTankNum)%Height == Autosize) .AND. &
(WaterThermalTank(WaterThermalTankNum)%Volume /= autosize )) THEN
WaterThermalTank(WaterThermalTankNum)%Height = ( ( 4.0D0 * WaterThermalTank(WaterThermalTankNum)%Volume &
* (WaterThermalTank(WaterThermalTankNum)%sizing%HeightAspectRatio**2) ) &
/ Pi)** 0.33333333333333D0
CALL ReportSizingOutput(WaterThermalTank(WaterThermalTankNum)%Type, WaterThermalTank(WaterThermalTankNum)%Name, &
'Tank Height [m]', WaterThermalTank(WaterThermalTankNum)%Height )
ENDIF
ENDIF
RETURN
END SUBROUTINE SizeTankForSupplySide