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 | |||
real(kind=r64), | intent(in) | :: | IncidAngle |
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 CalcTransAbsorProduct(ColleNum,IncidAngle)
! SUBROUTINE INFORMATION:
! AUTHOR Bereket A Nigusse
! DATE WRITTEN February 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates transmittance-absorptance product and the fraction of total solar radiation
! absorbed by each cover of a multicover ICS solar collector.
! METHODOLOGY EMPLOYED:
! Uses a ray tracing method.
! REFERENCES:
! Duffie, J. A., and Beckman, W. A. Solar Engineering of Thermal Processes, Second Edition.
! Wiley-Interscience: New York (1991).
!
USE DataGlobals, ONLY: DegToRadians
USE DataHeatBalance, ONLY: QRadSWOutIncident, QRadSWOutIncidentBeam, QRadSWOutIncidentSkyDiffuse, &
QRadSWOutIncidentGndDiffuse
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ColleNum ! Collector object number
REAL(r64), INTENT(IN) :: IncidAngle ! Angle of incidence (radians)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ParamNum ! Collector parameters object number
INTEGER :: SurfNum ! Surface object number for collector
INTEGER :: Num ! covers counter
REAL(r64) :: TuaAlphaBeam ! trans-abs product of beam radiation
REAL(r64) :: TuaAlpha ! weighted trans-abs product of system
REAL(r64) :: TransSys ! cover system solar transmittance
REAL(r64) :: ReflSys ! cover system solar reflectance
REAL(r64) :: AbsCover1 ! Inner cover solar absorbtance
REAL(r64) :: AbsCover2 ! Outer cover solar absorbtance
REAL(r64) :: CoversAbsBeam(2) ! Inner and Outer Cover absorptance
! FLOW:
! set
TransSys = 1.0d0
ReflSys = 0.0d0
AbsCover1 = 0.0d0
AbsCover2 = 0.0d0
TuaAlpha = 0.0d0
TuaAlphaBeam = 0.0d0
Collector(ColleNum)%CoverAbs(1) = 0.0d0
Collector(ColleNum)%CoverAbs(2) = 0.0d0
SurfNum = Collector(ColleNum)%Surface
ParamNum = Collector(ColleNum)%Parameters
IF (QRadSWOutIncident(SurfNum) > 0.d0) THEN
! cover system transmittance and reflectance from outer to inner cover
Call CalcTransRefAbsOfCover(ColleNum,IncidAngle,TransSys,ReflSys,AbsCover1,AbsCover2)
TuaAlphaBeam = TransSys * Parameters(ParamNum)%AbsorOfAbsPlate &
/ (1.0d0- (1.0d0 - Parameters(ParamNum)%AbsorOfAbsPlate) &
* Collector(ColleNum)%RefDiffInnerCover)
Collector(ColleNum)%TauAlphaBeam = MAX(0.d0, TuaAlphaBeam)
CoversAbsBeam(1) = AbsCover1
CoversAbsBeam(2) = AbsCover2
! calc total solar radiation weighted transmittance-absorptance product
TuaAlpha = (QRadSWOutIncidentBeam(SurfNum) * Collector(ColleNum)%TauAlphaBeam &
+ QRadSWOutIncidentSkyDiffuse(SurfNum) * Collector(ColleNum)%TauAlphaSkyDiffuse &
+ QRadSWOutIncidentGndDiffuse(SurfNum) * Collector(ColleNum)%TauAlphaGndDiffuse) &
/ QRadSWOutIncident(SurfNum)
IF ( Parameters(ParamNum)%NumOfCovers == 1) THEN
! calc total solar radiation weighted cover absorptance
Collector(ColleNum)%CoverAbs(1) = &
(QRadSWOutIncidentBeam(SurfNum) * CoversAbsBeam(1) &
+ QRadSWOutIncidentSkyDiffuse(SurfNum) * Collector(ColleNum)%CoversAbsSkyDiffuse(1) &
+ QRadSWOutIncidentGndDiffuse(SurfNum) * Collector(ColleNum)%CoversAbsGndDiffuse(1)) &
/ QRadSWOutIncident(SurfNum)
ELSEIF ( Parameters(ParamNum)%NumOfCovers == 2) THEN
! Num = 1 represents outer cover and Num = 2 represents inner cover
DO Num = 1, Parameters(ParamNum)%NumOfCovers
Collector(ColleNum)%CoverAbs(Num) = &
(QRadSWOutIncidentBeam(SurfNum) * CoversAbsBeam(Num) &
+ QRadSWOutIncidentSkyDiffuse(SurfNum) * Collector(ColleNum)%CoversAbsSkyDiffuse(Num) &
+ QRadSWOutIncidentGndDiffuse(SurfNum) * Collector(ColleNum)%CoversAbsGndDiffuse(Num)) &
/ QRadSWOutIncident(SurfNum)
END DO
ENDIF
ELSE
TuaAlpha = 0.0d0
END IF
Collector(ColleNum)%TauAlpha = TuaAlpha
RETURN
END SUBROUTINE CalcTransAbsorProduct