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) | :: | UTSCNum |
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 CalcActiveTranspiredCollector(UTSCnum)
! SUBROUTINE INFORMATION:
! AUTHOR B.T. Griffith
! DATE WRITTEN November 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment , ONLY: SkyTemp, OutHumRat, SunIsUp, OutBaroPress, IsRain
USE Psychrometrics , ONLY: PsyRhoAirFnPbTdbW, PsyCpAirFnWTdb, PsyHFnTdbW
USE DataSurfaces , ONLY: Surface
USE DataHeatBalSurface, ONLY: TH
USE DataHVACGlobals , ONLY: TimeStepSys
USE ConvectionCoefficients, ONLY: InitExteriorConvectionCoeff
USE General, ONLY: RoundSigDigits
USE DataHeatBalance !, ONLY: QRadSWOutIncident, Construct, Material
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: UTSCNum
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: g = 9.81d0 ! gravity constant (m/s**2)
REAL(r64), PARAMETER :: nu = 15.66d-6 ! kinematic viscosity (m**2/s) for air at 300 K
! (Mills 1999 Heat Transfer)
REAL(r64), PARAMETER :: k = 0.0267d0 ! thermal conductivity (W/m K) for air at 300 K
! (Mills 1999 Heat Transfer)
REAL(r64), PARAMETER :: Pr = 0.71d0 ! Prandtl number for air
REAL(r64), PARAMETER :: Sigma = 5.6697d-08 ! Stefan-Boltzmann constant
! REAL(r64), PARAMETER :: KelvinConv = KelvinConv ! Conversion from Celsius to Kelvin
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
! following arrays are used to temporarily hold results from multiple underlying surfaces
REAL(r64), ALLOCATABLE, DIMENSION(:) :: HSkyARR !
REAL(r64), ALLOCATABLE, DIMENSION(:) :: HGroundARR
REAL(r64), ALLOCATABLE, DIMENSION(:) :: HAirARR !
REAL(r64), ALLOCATABLE, DIMENSION(:) :: HPlenARR
REAL(r64), ALLOCATABLE, DIMENSION(:) :: LocalWindArr
! REAL(r64), ALLOCATABLE, DIMENSION(:) :: IscARR
! REAL(r64), ALLOCATABLE, DIMENSION(:) :: TsoARR
! working variables
!unused INTEGER :: InletNode !
REAL(r64) :: RhoAir ! density of air
REAL(r64) :: CpAir ! specific heat of air
REAL(r64) :: holeArea ! area of perforations, includes corrugation of surface
REAL(r64) :: Tamb ! outdoor drybulb
REAL(r64) :: A ! projected area of collector, from sum of underlying surfaces
REAL(r64) :: Vholes ! mean velocity of air as it passes through collector holes
REAL(r64) :: Vsuction ! mean velocity of air as is approaches the collector
REAL(r64) :: Vplen ! mean velocity of air inside plenum
REAL(r64) :: HcPlen ! surface convection heat transfer coefficient for plenum surfaces
REAL(r64) :: D ! hole diameter
REAL(r64) :: ReD ! Reynolds number for holes
REAL(r64) :: P ! pitch, distance betweeen holes
REAL(r64) :: Por ! porosity, area fraction of collector that is open because of holes
REAL(r64) :: Mdot ! mass flow rate of suction air
REAL(r64) :: QdotSource ! energy flux for source/sink inside collector surface (for hybrid PV UTSC)
INTEGER :: thisSurf ! do loop counter
INTEGER :: numSurfs ! number of underlying HT surfaces associated with UTSC
INTEGER :: Roughness ! parameters for surface roughness, defined in DataHeatBalance
REAL(r64) :: SolAbs ! solar absorptivity of collector
REAL(r64) :: AbsExt ! thermal emmittance of collector
REAL(r64) :: TempExt ! collector temperature
INTEGER :: SurfPtr ! index of surface in main surface structure
REAL(r64) :: HMovInsul ! dummy for call to InitExteriorConvectionCoeff
REAL(r64) :: HExt ! dummy for call to InitExteriorConvectionCoeff
INTEGER :: ConstrNum ! index of construction in main construction structure
REAL(r64) :: AbsThermSurf ! thermal emmittance of underlying wall.
REAL(r64) :: TsoK ! underlying surface temperature in Kelvin
REAL(r64) :: TscollK ! collector temperature in Kelvin (lagged)
REAL(r64) :: AreaSum ! sum of contributing surfaces for area-weighted averages.
REAL(r64) :: Vwind ! localized, and area-weighted average for wind speed
REAL(r64) :: HrSky ! radiation coeff for sky, area-weighted average
REAL(r64) :: HrGround ! radiation coeff for ground, area-weighted average
REAL(r64) :: HrAtm ! radiation coeff for air (bulk atmosphere), area-weighted average
REAL(r64) :: Isc ! Incoming combined solar radiation, area-weighted average
REAL(r64) :: HrPlen ! radiation coeff for plenum surfaces, area-weighted average
REAL(r64) :: Tso ! temperature of underlying surface, area-weighted average
REAL(r64) :: HcWind ! convection coeff for high speed wind situations
REAL(r64) :: NuD ! nusselt number for Reynolds based on hole
REAL(r64) :: U ! overall heat exchanger coefficient
REAL(r64) :: HXeff ! effectiveness for heat exchanger
REAL(r64) :: t ! collector thickness
REAL(r64) :: ReS ! Reynolds number based on suction velocity and pitch
REAL(r64) :: ReW ! Reynolds number based on Wind and pitch
REAL(r64) :: ReB ! Reynolds number based on hole velocity and pitch
REAL(r64) :: ReH ! Reynolds number based on hole velocity and diameter
REAL(r64) :: Tscoll ! temperature of collector
REAL(r64) :: TaHX ! leaving air temperature from heat exchanger (entering plenum)
REAL(r64) :: Taplen ! Air temperature in plen and outlet node.
REAL(r64) :: SensHeatingRate ! Rate at which the system is heating outdoor air
! INTEGER, SAVE :: VsucErrCount=0 ! warning message counter
! CHARACTER(len=MaxNameLength) :: VsucErrString ! warning message counter string
REAL(r64) :: AlessHoles ! Area for Kutscher's relation
!Active UTSC calculation
! first do common things for both correlations
IF (.NOT. IsRain) Then
Tamb = SUM(Surface(UTSC(UTSCNum)%SurfPtrs)%OutDryBulbTemp * Surface(UTSC(UTSCNum)%SurfPtrs)%Area) &
/ SUM(Surface(UTSC(UTSCNum)%SurfPtrs)%Area)
ELSE ! when raining we use wet bulb not drybulb
Tamb = SUM(Surface(UTSC(UTSCNum)%SurfPtrs)%OutWetBulbTemp * Surface(UTSC(UTSCNum)%SurfPtrs)%Area) &
/ SUM(Surface(UTSC(UTSCNum)%SurfPtrs)%Area)
ENDIF
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,Tamb, OutHumRat)
CpAir = PsyCpAirFnWTdb(OutHumRat,Tamb)
holeArea = UTSC(UTSCNum)%ActualArea*UTSC(UTSCNum)%Porosity
A = UTSC(UTSCNum)%ProjArea
Vholes = UTSC(UTSCNum)%InletMDot/RhoAir/holeArea
Vplen = UTSC(UTSCNum)%InletMDot/RhoAir/UTSC(UTSCNum)%PlenCrossArea
Vsuction = UTSC(UTSCNum)%InletMDot/RhoAir/A
IF ((Vsuction < 0.001d0) .or. (Vsuction > 0.08d0)) THEN ! warn that collector is not sized well
IF (UTSC(UTSCNum)%VsucErrIndex == 0) THEN
Call ShowWarningMessage('Solar Collector:Unglazed Transpired="'//Trim(UTSC(UTSCNum)%Name)// &
'", Suction velocity is outside of range for a good design')
Call ShowContinueErrorTimeStamp('Suction velocity ='//Trim(RoundSigDigits(Vsuction,4)) )
If (Vsuction < 0.003d0) THEN
CALL ShowContinueError('Velocity is low -- suggest decreasing area of transpired collector')
ENDIF
If (Vsuction > 0.08d0) THEN
CALL ShowContinueError('Velocity is high -- suggest increasing area of transpired collector')
ENDIF
CALL ShowContinueError('Occasional suction velocity messages are not unexpected when simulating actual conditions')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('Solar Collector:Unglazed Transpired="'//Trim(UTSC(UTSCNum)%Name)// &
'", Suction velocity is outside of range',UTSC(UTSCNum)%VsucErrIndex, &
ReportMinOf=VSuction,ReportMinUnits='[m/s]',ReportMaxOf=VSuction,ReportMaxUnits='[m/s]')
ENDIF
HcPlen = 5.62d0 + 3.92d0*Vplen
D = UTSC(UTSCNum)%holeDia
ReD = Vholes * D / nu
P = UTSC(UTSCNum)%pitch
Por = UTSC(UTSCNum)%Porosity
Mdot = UTSC(UTSCNum)%InletMdot
QdotSource = UTSC(UTSCNum)%QdotSource ! for hybrid PV transpired collectors
!loop through underlying surfaces and collect needed data
! now collect average values for things associated with the underlying surface(s)
NumSurfs = UTSC(UTSCNum)%numSurfs
ALLOCATE(HSkyARR(NumSurfs))
HSkyARR = 0.0d0
ALLOCATE(HGroundARR(NumSurfs))
HGroundARR = 0.0d0
ALLOCATE(HAirARR(NumSurfs))
HAirARR = 0.0d0
ALLOCATE(LocalWindArr(NumSurfs))
LocalWindArr = 0.0d0
! ALLOCATE(IscARR(NumSurfs))
! IscARR = 0.0
Allocate(HPlenARR(NumSurfs))
HPlenARR = 0.0d0
! ALLOCATE(TsoARR(NumSurfs))
! TsoARR = 0.0
Roughness = UTSC(UTSCNum)%CollRoughness
SolAbs = UTSC(UTSCNum)%SolAbsorp
AbsExt = UTSC(UTSCNum)%LWEmitt
TempExt = UTSC(UTSCNum)%TcollLast
Do thisSurf =1, NumSurfs
SurfPtr = UTSC(UTSCNum)%SurfPtrs(thisSurf)
! Initializations for this surface
HMovInsul = 0.0d0
HExt = 0.0d0
LocalWindArr(thisSurf) = Surface(SurfPtr)%WindSpeed
CALL InitExteriorConvectionCoeff( SurfPtr,HMovInsul,Roughness,AbsExt,TempExt, &
HExt,HSkyARR(thisSurf),HGroundARR(thisSurf),HAirARR(thisSurf) )
ConstrNum = Surface(SurfPtr)%Construction
AbsThermSurf = Material(Construct(ConstrNum)%LayerPoint(1))%AbsorpThermal
TsoK = TH(SurfPtr,1,1) + KelvinConv
TscollK = UTSC(UTSCNum)%TcollLast + KelvinConv
HPlenARR(thisSurf) = Sigma*AbsExt*AbsThermSurf*(TscollK**4 - TsoK**4)/(TscollK - TsoK)
ENDDO
AreaSum = SUM(Surface(UTSC(UTSCNum)%SurfPtrs)%Area)
! now figure area-weighted averages from underlying surfaces.
Vwind = Sum(LocalWindArr*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
DEALLOCATE(LocalWindArr)
HrSky = Sum(HSkyARR*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
DEALLOCATE(HSkyARR)
HrGround = Sum(HGroundARR*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
DEALLOCATE(HGroundARR)
HrAtm = Sum(HAirARR*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
DEALLOCATE(HAirARR)
HrPlen = Sum(HPlenARR*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
DEALLOCATE(HPlenARR)
Isc = SUM(QRadSWOutIncident(UTSC(UTSCNum)%SurfPtrs)*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
Tso = SUM(TH((UTSC(UTSCNum)%SurfPtrs),1,1)*Surface(UTSC(UTSCNum)%SurfPtrs)%Area) /AreaSum
IF (Vwind > 5.0d0) THEN
Hcwind = 5.62d0 +3.9d0*(Vwind - 5.0d0) !McAdams forced convection correlation
ELSE
Hcwind = 0.0d0
ENDIF
If (IsRain) Hcwind = 1000.0d0
HXeff = 0.0d0 ! init
SELECT CASE (UTSC(UTSCnum)%Correlation)
CASE(Correlation_Kutscher1994) ! Kutscher1994
AlessHoles = A - holeArea
NuD = 2.75d0*( (((P/D)**(-1.2d0))*(ReD**0.43d0)) + (0.011d0 * Por * ReD*((Vwind/Vsuction)**0.48d0) ))
U = k * NuD/ D
HXeff = 1.0d0 - exp(-1.d0*((U * AlessHoles)/ (mdot * CpAir)) )
CASE(Correlation_VanDeckerHollandsBrunger2001) ! VanDeckerHollandsBrunger2001
t = UTSC(UTSCNum)%CollectThick
ReS = Vsuction * P / nu
ReW = Vwind * P / nu
ReB = Vholes * P / nu
ReH = (Vsuction * D)/(nu * Por)
IF (ReD > 0.0d0) THEN
If (ReW > 0.0d0) THEN
HXeff = (1.d0 - (1.d0 + ReS * MAX(1.733d0 * ReW**(-0.5d0), 0.02136d0) )**(-1.0d0) ) &
* (1.d0 - (1.d0 + 0.2273d0 * (ReB**0.5d0))**(- 1.0d0) ) &
* EXP( -0.01895d0*(P/D) - (20.62d0/ReH) * (t/D) )
ELSE
HXeff = (1.d0 - (1.d0 + ReS * 0.02136d0 )**(-1.0d0) ) &
* (1.d0 - (1.d0 + 0.2273d0 * ReB**0.5d0)**(- 1.0d0) ) &
* EXP( -0.01895d0*(P/D) - (20.62d0/ReH) * (t/D) )
ENDIF
ELSE
HXeff = 0.0d0
ENDIF
END SELECT
!now calculate collector temperature
Tscoll = (Isc*SolAbs + HrAtm*Tamb + HrSky*SkyTemp + HrGround*Tamb + HrPlen*Tso + Hcwind*Tamb &
+ (Mdot*CpAir / A ) * Tamb - (Mdot*CpAir / A )*(1.d0 - HXeff)*Tamb + QdotSource) &
/(HrAtm + HrSky + HrGround + Hrplen + Hcwind + (Mdot*CpAir / A )*HXeff)
! Heat exchanger leaving temperature
TaHX = HXeff*Tscoll + (1.d0-HXeff)*Tamb
!now calculate plenum air temperature
Taplen = (Mdot*CpAir*TaHX + HcPlen*A*Tso) / (Mdot*CpAir + HcPlen*A)
! calculate Sensible Heating Rate
If (Taplen > Tamb) Then
SensHeatingRate = Mdot*CpAir*(Taplen - Tamb)
ELSE
SensHeatingRate = 0.0d0
endif
!now fill results into derived types
UTSC(UTSCNum)%Isc = Isc
UTSC(UTSCNum)%HXeff = HXeff
UTSC(UTSCNum)%Tplen = Taplen
UTSC(UTSCNum)%Tcoll = Tscoll
UTSC(UTSCNum)%HrPlen = HrPlen
UTSC(UTSCNum)%HcPlen = HcPlen
UTSC(UTSCNum)%TairHX = TaHX
UTSC(UTSCNum)%InletMdot = Mdot
UTSC(UTSCNum)%InletTempDB = Tamb
UTSC(UTSCNum)%Vsuction = Vsuction
UTSC(UTSCNum)%PlenumVelocity = Vplen
UTSC(UTSCNum)%SupOutTemp = Taplen
UTSC(UTSCNum)%SupOutHumRat = OutHumRat !stays the same with sensible heating
UTSC(UTSCNum)%SupOutEnth = PsyHFnTdbW(UTSC(UTSCNum)%SupOutTemp, &
UTSC(UTSCNum)%SupOutHumRat)
UTSC(UTSCNum)%SupOutMassFlow = Mdot
UTSC(UTSCNum)%SensHeatingRate = SensHeatingRate
UTSC(UTSCNum)%SensHeatingEnergy = SensHeatingRate * TimeStepSys * SecInHour
UTSC(UTSCNum)%PassiveACH = 0.0d0
UTSC(UTSCNum)%PassiveMdotVent = 0.0d0
UTSC(UTSCNum)%PassiveMdotWind = 0.0d0
UTSC(UTSCNum)%PassiveMdotTherm = 0.0d0
IF (Isc > 10.0d0) THEN
UTSC(UTSCNum)%UTSCEfficiency = SensHeatingRate / (Isc * A)
IF (TaHX > Tamb) THen
UTSC(UTSCNum)%UTSCCollEff = Mdot*CpAir*(TaHX - Tamb) / (Isc * A)
ELSE
UTSC(UTSCNum)%UTSCCollEff = 0.0d0
ENDIF
ELSE
UTSC(UTSCNum)%UTSCEfficiency = 0.0d0
UTSC(UTSCNum)%UTSCCollEff = 0.0d0
ENDIF
RETURN
END SUBROUTINE CalcActiveTranspiredCollector