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) | :: | CollectorNum |
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 CalcSolarCollector(CollectorNum)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN January 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the heat gain (or loss), outlet temperature, and solar energy conversion efficiency for a flat-plate
! solar collector when there is a fluid flow. For the no flow condition, the fluid stagnation temperature is
! calculated as the outlet temperature. Glazed and unglazed collectors are both handled.
! METHODOLOGY EMPLOYED:
! Calculation is performed using the methodology described in the ASHRAE standards and references below. Measured
! collector performance coefficients (available from the Solar Rating & Certification Corporation, for example)
! are modified from the test conditions to match the actual optical (incident angle modifier) and thermal (flow rate
! modifier) conditions. Water is assumed to be the heat transfer fluid.
! REFERENCES:
! ASHRAE Standard 93-1986 (RA 91), "Methods of Testing to Determine the Thermal Performance of Solar Collectors".
! ASHRAE Standard 96-1980 (RA 89), "Methods of Testing to Determine the Thermal Performance of Unglazed Flat-Plate
! Liquid-Type Solar Collectors".
! Duffie, J. A., and Beckman, W. A. Solar Engineering of Thermal Processes, Second Edition. Wiley-Interscience:
! New York (1991).
! NOTES:
! This subroutine has been validated against the TRNSYS Type 1 flat-plate solar collector module. Results are
! identical except for slight differences at extreme incident angles (>80 degrees) and extreme surface tilts (<20
! degrees). The differences are due to the fact that Type 1 does not prevent the *component* incident angle
! modifiers from being less than zero. There is an effect on the net incident angle modifier if one or more
! components are less than zero but the net adds up to greater than zero. The EnergyPlus subroutine, on the other
! hand, requires each component incident angle modifier always to be greater than zero.
! USE STATEMENTS:
USE DataGlobals, ONLY: DegToRadians
USE DataHeatBalance, ONLY: CosIncidenceAngle, QRadSWOutIncident, QRadSWOutIncidentBeam, QRadSWOutIncidentSkyDiffuse, &
QRadSWOutIncidentGndDiffuse, TempConvergTol
USE FluidProperties, ONLY: GetSpecificHeatGlycol
USE DataPlant, ONLY: PlantLoop, ccSimPlantEquipTypes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CollectorNum
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SurfNum ! Surface object number for collector
INTEGER :: ParamNum ! Collector parameters object number
REAL(r64) :: Tilt ! Surface tilt angle (degrees)
REAL(r64) :: IncidentAngleModifier ! Net incident angle modifier combining beam, sky, and ground radiation
REAL(r64) :: ThetaBeam ! Incident angle of beam radiation (radians)
REAL(r64) :: ThetaSky ! Equivalent incident angle of sky radiation (radians)
REAL(r64) :: ThetaGnd ! Equivalent incident angle of ground radiation (radians)
REAL(r64) :: InletTemp ! Inlet temperature from plant (C)
REAL(r64) :: OutletTemp ! Outlet temperature or stagnation temperature in the collector (C)
REAL(r64) :: OutletTempPrev ! Outlet temperature saved from previous iteration for convergence check (C)
REAL(r64) :: MassFlowRate ! Mass flow rate through collector (kg/s)
REAL(r64) :: Cp ! Specific heat of collector fluid (J/kg-K)
REAL(r64) :: Area ! Gross area of collector (m2)
REAL(r64) :: mCpATest ! = MassFlowRateTest * Cp / Area (tested area)
REAL(r64) :: mCpA ! = MassFlowRate * Cp / Area
REAL(r64) :: TestTypeMod ! Modifier for test correlation type: INLET, AVERAGE, or OUTLET
REAL(r64) :: FlowMod ! Modifier for flow rate different from test flow rate
REAL(r64) :: FRULpTest ! FR * ULoss "prime" for test conditions = (eff1 + eff2 * deltaT)
REAL(r64) :: FpULTest ! F prime * ULoss for test conditions = collector efficiency factor * overall loss coefficient
REAL(r64) :: FRTAN ! FR * tau * alpha at normal incidence = Y-intercept of collector efficiency
REAL(r64) :: FRUL ! FR * ULoss = 1st order coefficient of collector efficiency
REAL(r64) :: FRULT ! FR * ULoss / T = 2nd order coefficent of collector efficiency
REAL(r64) :: Q ! Heat gain or loss to collector fluid (W)
REAL(r64) :: Efficiency ! Thermal efficiency of solar energy conversion
REAL(r64) :: A, B, C ! Coefficients for solving the quadratic equation
REAL(r64) :: qEquation ! test for negative value in quadratic equation
INTEGER :: Iteration ! Counter of iterations until convergence
! FLOW:
SurfNum = Collector(CollectorNum)%Surface
ParamNum = Collector(CollectorNum)%Parameters
! Calculate incident angle modifier
IF (QRadSWOutIncident(SurfNum) > 0.0d0) THEN
ThetaBeam = ACOS(CosIncidenceAngle(SurfNum))
! Calculate equivalent incident angles for sky and ground radiation according to Brandemuehl and Beckman (1980)
Tilt = Surface(SurfNum)%Tilt
ThetaSky = (59.68d0 - 0.1388d0 * Tilt + 0.001497d0 * Tilt**2) * DegToRadians
ThetaGnd = (90.0d0 - 0.5788d0 * Tilt + 0.002693d0 * Tilt**2) * DegToRadians
IncidentAngleModifier = (QRadSWOutIncidentBeam(SurfNum) * IAM(ParamNum, ThetaBeam) &
+ QRadSWOutIncidentSkyDiffuse(SurfNum) * IAM(ParamNum, ThetaSky) &
+ QRadSWOutIncidentGndDiffuse(SurfNum) * IAM(ParamNum, ThetaGnd)) &
/ QRadSWOutIncident(SurfNum)
ELSE
IncidentAngleModifier = 0.0d0
END IF
InletTemp = Collector(CollectorNum)%InletTemp
MassFlowRate = Collector(CollectorNum)%MassFlowRate
Cp = GetSpecificHeatGlycol(PlantLoop(Collector(CollectorNum)%WLoopNum)%FluidName, &
InletTemp, &
PlantLoop(Collector(CollectorNum)%WLoopNum)%FluidIndex, &
'CalcSolarCollector')
Area = Surface(SurfNum)%Area
mCpA = MassFlowRate * Cp / Area
! CR 7920, changed next line to use tested area, not current surface area
! mCpATest = Parameters(ParamNum)%TestMassFlowRate * Cp / Area
mCpATest = Parameters(ParamNum)%TestMassFlowRate * Cp / Parameters(Collector(CollectorNum)%Parameters)%Area
Iteration = 1
OutletTemp = 0.0d0
OutletTempPrev = 999.9d0 ! Set to a ridiculous number so that DO loop runs at least once
Q = 0.0d0
DO WHILE (ABS(OutletTemp - OutletTempPrev) > TempConvergTol) ! Check for temperature convergence
OutletTempPrev = OutletTemp ! Save previous outlet temperature
! Modify coefficients depending on test correlation type
SELECT CASE (Parameters(ParamNum)%TestType)
CASE (INLET)
FRULpTest = Parameters(ParamNum)%eff1 + Parameters(ParamNum)%eff2 * (InletTemp - Surface(SurfNum)%OutDryBulbTemp)
TestTypeMod = 1.0d0
CASE (AVERAGE)
FRULpTest = Parameters(ParamNum)%eff1 + Parameters(ParamNum)%eff2 * &
((InletTemp + OutletTemp)*0.5d0 - Surface(SurfNum)%OutDryBulbTemp)
TestTypeMod = 1.0d0/(1.0d0 - FRULpTest/(2.0d0 * mCpATest) )
CASE (OUTLET)
FRULpTest = Parameters(ParamNum)%eff1 + Parameters(ParamNum)%eff2 * &
(OutletTemp - Surface(SurfNum)%OutDryBulbTemp)
TestTypeMod = 1.0d0/(1.0d0 - FRULpTest/mCpATest )
END SELECT
FRTAN = Parameters(ParamNum)%eff0 * TestTypeMod
FRUL = Parameters(ParamNum)%eff1 * TestTypeMod
FRULT = Parameters(ParamNum)%eff2 * TestTypeMod
FRULpTest = FRULpTest * TestTypeMod
IF (MassFlowRate > 0.0d0) THEN ! Calculate efficiency and heat transfer with flow
IF ((1.0d0 + FRULpTest / mCpATest) > 0.0d0) THEN
FpULTest = -mCpATest * LOG(1.0d0 + FRULpTest / mCpATest)
ELSE
FpULTest = FRULpTest ! Avoid LOG( <0 )
END IF
IF ((-FpULTest / mCpA) < 700.0D0) THEN
FlowMod = mCpA * (1.0d0 - EXP(-FpULTest / mCpA))
ELSE ! avoid EXP(too large #)
FlowMod = FlowMod
ENDIF
IF ((-FpULTest / mCpATest) < 700.0D0) THEN
FlowMod = FlowMod / (mCpATest * (1.0d0 - EXP(-FpULTest / mCpATest)))
ELSE
FlowMod = FlowMod
ENDIF
! Calculate fluid heat gain (or loss)
! Heat loss is possible if there is no incident radiation and fluid is still flowing.
Q = (FRTAN * IncidentAngleModifier * QRadSWOutIncident(SurfNum) + FRULpTest * &
(InletTemp - Surface(SurfNum)%OutDryBulbTemp) ) &
* Area * FlowMod
OutletTemp = InletTemp + Q / (MassFlowRate * Cp)
! CR 7877 bound unreasonable result
IF (OutletTemp < -100) THEN
OutletTemp = -100.0d0
Q = MassFlowRate * Cp * (OutletTemp - InletTemp)
ENDIF
IF (OutletTemp > 200) THEN
OutletTemp = 200.0d0
Q = MassFlowRate * Cp * (OutletTemp - InletTemp)
ENDIF
IF (QRadSWOutIncident(SurfNum) > 0.0d0) THEN ! Calculate thermal efficiency
! NOTE: Efficiency can be > 1 if Q > QRadSWOutIncident because of favorable delta T, i.e. warm outdoor temperature
Efficiency = Q / (QRadSWOutIncident(SurfNum) * Area) ! Q has units of W; QRadSWOutIncident has units of W/m2
ELSE
Efficiency = 0.0d0
END IF
ELSE ! Calculate stagnation temperature of fluid in collector (no flow)
Q = 0.0d0
Efficiency = 0.0d0
! Calculate temperature of stagnant fluid in collector
A = -FRULT
B = -FRUL + 2.0d0 * FRULT * Surface(SurfNum)%OutDryBulbTemp
C = -FRULT * Surface(SurfNum)%OutDryBulbTemp**2 + FRUL * Surface(SurfNum)%OutDryBulbTemp &
- FRTAN * IncidentAngleModifier * QRadSWOutIncident(SurfNum)
qEquation=(B**2 - 4.0d0 * A * C)
IF (qEquation < 0.0d0) THEN
IF (Collector(CollectorNum)%ErrIndex == 0) THEN
CALL ShowSevereMessage('CalcSolarCollector: '//trim(ccSimPlantEquipTypes(Collector(CollectorNum)%TypeNum))// &
'="'//trim(Collector(CollectorNum)%Name)//'", possible bad input coefficients.')
CALL ShowContinueError('...coefficients cause negative quadratic equation part in '// &
'calculating temperature of stagnant fluid.')
CALL ShowContinueError('...examine input coefficients for accuracy. Calculation will be treated as linear.')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('CalcSolarCollector: '// &
trim(ccSimPlantEquipTypes(Collector(CollectorNum)%TypeNum))//'="'//trim(Collector(CollectorNum)%Name)// &
'", coefficient error continues.', &
Collector(CollectorNum)%ErrIndex,ReportMinOf=qEquation,ReportMaxOf=qEquation)
ENDIF
IF (FRULT == 0.0d0 .or. qEquation < 0.0d0) THEN ! Linear, 1st order solution
OutletTemp = Surface(SurfNum)%OutDryBulbTemp - FRTAN * IncidentAngleModifier * QRadSWOutIncident(SurfNum) / FRUL
ELSE ! Quadratic, 2nd order solution
OutletTemp = (-B + qEquation**0.5d0) / (2.0d0 * A)
END IF
END IF
IF (Parameters(ParamNum)%TestType == INLET) EXIT ! Inlet temperature test correlations do not need to iterate
IF (Iteration > 100) THEN
IF (Collector(CollectorNum)%IterErrIndex == 0) THEN
CALL ShowWarningMessage('CalcSolarCollector: '//trim(ccSimPlantEquipTypes(Collector(CollectorNum)%TypeNum))// &
'="'//TRIM(Collector(CollectorNum)%Name)// &
'": Solution did not converge.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('CalcSolarCollector: '// &
trim(ccSimPlantEquipTypes(Collector(CollectorNum)%TypeNum))//'="'//trim(Collector(CollectorNum)%Name)// &
'", solution not converge error continues.',Collector(CollectorNum)%IterErrIndex)
EXIT
ELSE
Iteration = Iteration + 1
END IF
END DO ! Check for temperature convergence
Collector(CollectorNum)%IncidentAngleModifier = IncidentAngleModifier
Collector(CollectorNum)%Power = Q
Collector(CollectorNum)%HeatGain = MAX(Q, 0.0d0)
Collector(CollectorNum)%HeatLoss = MIN(Q, 0.0d0)
Collector(CollectorNum)%OutletTemp = OutletTemp
Collector(CollectorNum)%Efficiency = Efficiency
RETURN
END SUBROUTINE CalcSolarCollector