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) | :: | ColleNum |
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 CalcICSSolarCollector(ColleNum)
! SUBROUTINE INFORMATION:
! AUTHOR Bereket Nigusse, FSEC/UCF
! DATE WRITTEN February 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the heat transfered (gain or loss), energy stored, skin heat loss, outlet temperature, solar energy
! conversion efficiency, and transmittance-absorptance product of an ICS solar collector.
! METHODOLOGY EMPLOYED:
! The governing equations for the absorber and collector water heat balance equations are solved simultaneously.
! The two coupled first ODE are solved analytically.
!
! The transmittance-absorptance product of the collector cover-absorber system is calcuated using ray tracing
! method according to Duffie and Beckman(1991).
!
! REFERENCES:
! Duffie, J. A., and Beckman, W. A. Solar Engineering of Thermal Processes, 2nd. Edition. Wiley-Interscience:
! New York (1991).
!
! NOTES:
!
! USE STATEMENTS:
USE DataGlobals, ONLY: DegToRadians, TimeStepZone, TimeStep, SecInHour, WarmupFlag, HourOfDay
USE DataHVACGlobals, ONLY: SysTimeElapsed, TimeStepSys
USE DataHeatBalance, ONLY: CosIncidenceAngle, QRadSWOutIncident
USE FluidProperties, ONLY: GetSpecificHeatGlycol, GetDensityGlycol
USE DataPlant, ONLY: PlantLoop
USE DataLoopNode, ONLY: Node
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ColleNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! REAL(r64) :: TimeElapsed ! Fraction of the current hour that has elapsed (h)
INTEGER :: SurfNum ! Surface object number for collector
INTEGER :: ParamNum ! Collector parameters object number
REAL(r64) :: ThetaBeam ! Incident angle of beam radiation (radians)
REAL(r64) :: InletTemp ! Inlet temperature from plant (C)
REAL(r64) :: OutletTemp ! collector Outlet temperature (C)
REAL(r64) :: MassFlowRate ! Mass flow rate through collector (kg/s)
REAL(r64) :: TempAbsPlate ! absorber plate average temperature [C]
REAL(r64) :: TempAbsPlateOld ! absorber plate average temperature at previous time step [C]
REAL(r64) :: TempWater ! collector water average temperature [C]
REAL(r64) :: TempWaterOld ! collector water average temperature at previous time step [C]
REAL(r64) :: TempOutdoorAir ! outdoor air temperature [C]
REAL(r64) :: TempOSCM ! Otherside condition model temperature [C]
REAL(r64) :: hConvCoefA2W ! convection coeff between absorber plate and water [W/m2K]
REAL(r64) :: Cpw ! Specific heat of collector fluid (J/kg-K)
REAL(r64) :: Rhow ! density of colloctor fluid (kg/m3)
REAL(r64) :: Area ! Gross area of collector (m2)
REAL(r64) :: aw ! thermal mass of the collector water [J/K]
! REAL(r64) :: bw ! coefficients of the ODE of water heat balance
! REAL(r64) :: cw ! coefficients of the ODE of water heat balance
REAL(r64) :: ap ! thermal mass of the absorber plate [J/K]
! REAL(r64) :: bp ! coefficients of the ODE of abs plate heat balance
! REAL(r64) :: cp ! coefficients of the ODE of abs plate heat balance
REAL(r64) :: SecInTimeStep ! Seconds in one timestep (s)
! REAL(r64) :: Q ! Heat gain or loss to collector fluid (W)
REAL(r64) :: Efficiency ! Thermal efficiency of solar energy conversion
! REAL(r64) :: StoredHeatRate ! collector heat storage rate (-ve, or +ve) [W]
! REAL(r64) :: HeatLossRate ! heat loss through the top, bottom and side of collector
! REAL(r64) :: CollectorHeatRate ! collector net heat gain rate
REAL(r64) :: QHeatRate ! heat gain rate (W)
REAL(r64) :: a1 ! coefficient of ODE for absorber temperature Tp
REAL(r64) :: a2 ! coefficient of ODE for absorber temperature Tw
REAL(r64) :: a3 ! conatant term of ODE for absorber temperature
REAL(r64) :: b1 ! coefficient of ODE for water temperature Tp
REAL(r64) :: b2 ! coefficient of ODE for water temperature Tw
REAL(r64) :: b3 ! conatant term of ODE for water temperature
LOGICAL :: AbsPlateMassFlag ! flag if the absober has thermal mass or not
! FLOW:
Efficiency = 0.d0
QHeatRate = 0.d0
SecInTimeStep = TimeStepSys * SecInHour
SurfNum = Collector(ColleNum)%Surface
ParamNum = Collector(ColleNum)%Parameters
Area = Parameters(ParamNum)%Area
TempWater = Collector(ColleNum)%SavedTempOfWater
TempAbsPlate = Collector(ColleNum)%SavedTempOfAbsPlate
TempOutdoorAir = Surface(SurfNum)%OutDryBulbTemp
IF ( Collector(ColleNum)%OSCM_ON ) THEN
TempOSCM = Collector(ColleNum)%SavedTempCollectorOSCM
ELSE
TempOSCM = TempOutdoorAir
ENDIF
! Calculate transmittance-absorptance product of the system
ThetaBeam = ACOS(CosIncidenceAngle(SurfNum))
Call CalcTransAbsorProduct(ColleNum,ThetaBeam)
InletTemp = Collector(ColleNum)%InletTemp
MassFlowRate = Collector(ColleNum)%MassFlowRate
Cpw = GetSpecificHeatGlycol(PlantLoop(Collector(ColleNum)%WLoopNum)%FluidName, &
InletTemp, &
PlantLoop(Collector(ColleNum)%WLoopNum)%FluidIndex, &
'CalcICSSolarCollector')
Rhow = GetDensityGlycol(PlantLoop(Collector(ColleNum)%WLoopNum)%FluidName, &
InletTemp, &
PlantLoop(Collector(ColleNum)%WLoopNum)%FluidIndex, &
'CalcICSSolarCollector')
! calculate heat transfer coefficients and covers temperature:
CALL CalcHeatTransCoeffAndCoverTemp(ColleNum)
! Calc convection heat transfer coefficient between the absorber plate and water:
hConvCoefA2W = CalcConvCoeffAbsPlateAndWater(TempAbsPlate,TempWater,Collector(ColleNum)%Length, &
Collector(ColleNum)%TiltR2V)
TempWaterOld = TempWater
TempAbsPlateOld = TempAbsPlate
IF ( Parameters(ParamNum)%ThermalMass .GT. 0.0d0) THEN
AbsPlateMassFlag = .TRUE.
ap = Parameters(ParamNum)%ThermalMass * Area
a1 =-Area * (hConvCoefA2W + Collector(ColleNum)%UTopLoss) / ap
a2 = Area * hConvCoefA2W / ap
a3 = Area * (Collector(ColleNum)%TauAlpha * QRadSWOutIncident(SurfNum) &
+ Collector(ColleNum)%UTopLoss * TempOutdoorAir) / ap
ELSE
AbsPlateMassFlag = .FALSE.
a1 =-Area * (hConvCoefA2W + Collector(ColleNum)%UTopLoss)
a2 = Area * hConvCoefA2W
a3 = Area * (Collector(ColleNum)%TauAlpha * QRadSWOutIncident(SurfNum) &
+ Collector(ColleNum)%UTopLoss * TempOutdoorAir)
ENDIF
aw = Parameters(ParamNum)%Volume*Rhow*Cpw
b1 = Area*hConvCoefA2W / aw
b2 =-(Area*(hConvCoefA2W+Collector(ColleNum)%UbLoss + Collector(ColleNum)%UsLoss) + MassFlowRate*Cpw)/aw
b3 = (Area*(Collector(ColleNum)%UbLoss*TempOSCM + Collector(ColleNum)%UsLoss*TempOutdoorAir) &
+ MassFlowRate*Cpw*InletTemp)/aw
Call ICSCollectorAnalyticalSoluton(ColleNum,SecInTimeStep,a1,a2,a3,b1,b2,b3,TempAbsPlateOld, &
TempWaterOld,TempAbsPlate,TempWater,AbsPlateMassFlag)
Collector(ColleNum)%SkinHeatLossRate = Area * &
( Collector(ColleNum)%UTopLoss*(TempOutdoorAir-TempAbsPlate) &
+ Collector(ColleNum)%UsLoss*(TempOutdoorAir-TempWater) &
+ Collector(ColleNum)%UbLoss*(TempOSCM-TempWater) )
Collector(ColleNum)%StoredHeatRate = aw*(TempWater-TempWaterOld)/SecInTimeStep
QHeatRate = MassFlowRate*Cpw*(TempWater-InletTemp)
Collector(ColleNum)%HeatRate = QHeatRate
Collector(ColleNum)%HeatGainRate = MAX(0.0d0, QHeatRate)
Collector(ColleNum)%HeatLossRate = MIN(0.0d0, QHeatRate)
OutletTemp = TempWater
Collector(ColleNum)%OutletTemp = OutletTemp
Collector(ColleNum)%TempOfWater = TempWater
Collector(ColleNum)%TempOfAbsPlate = TempAbsPlate
IF ( QRadSWOutIncident(SurfNum) .GT. 0.0d0 ) THEN
Efficiency = (Collector(ColleNum)%HeatGainRate + Collector(ColleNum)%StoredHeatRate) &
/ (QRadSWOutIncident(SurfNum)*Area)
IF (Efficiency .LT. 0.0d0) Efficiency = 0.0d0
ENDIF
Collector(ColleNum)%Efficiency = Efficiency
RETURN
END SUBROUTINE CalcICSSolarCollector