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 InitSolarCollector(CollectorNum)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN January 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Initializes the solar collector object during the plant simulation.
! METHODOLOGY EMPLOYED:
! Inlet and outlet nodes are initialized. The maximum collector flow rate is requested.
! USE STATEMENTS:
USE DataGlobals, ONLY: SysSizingCalc, InitConvTemp, DegToRadians, TimeStepZone, TimeStep, SecInHour, &
WarmupFlag, HourOfDay
USE DataLoopNode, ONLY: Node
USE DataPlant
USE FluidProperties, ONLY: GetDensityGlycol
USE PlantUtilities, ONLY: InitComponentNodes, SetComponentFlowRate, RegisterPlantCompDesignFlow
USE DataHVACGlobals, ONLY: SysTimeElapsed, TimeStepSys
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CollectorNum
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode
INTEGER :: OutletNode
REAL(r64),PARAMETER :: BigNumber=9999.9d0 !Component desired mass flow rate
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: SetLoopIndexFlag ! get loop number flag
REAL(r64) :: rho
!LOGICAL :: errFlag
! REAL(r64) :: Density ! density of fluid
LOGICAL :: errFlag ! local error flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: SetDiffRadFlag ! get diffuse radiation flag
INTEGER :: SurfNum ! Surface object number for collector
INTEGER :: ParamNum ! Collector parameters object number
REAL(r64) :: Tilt ! Surface tilt angle (degrees)
REAL(r64) :: Theta ! solar radiation incident angle (radians)
REAL(r64) :: TransSys ! cover system solar transmittance
REAL(r64) :: RefSys ! cover system solar reflectance
REAL(r64) :: AbsCover1 ! Inner cover solar absorbtance
REAL(r64) :: AbsCover2 ! Outer cover solar absorbtance
REAL(r64) :: RefSysDiffuse ! cover system solar reflectance
REAL(r64) :: TimeElapsed ! Fraction of the current hour that has elapsed (h)
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(SetLoopIndexFlag(NumOfCollectors))
ALLOCATE(SetDiffRadFlag(NumOfCollectors))
SetLoopIndexFlag = .TRUE.
SetDiffRadFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF(SetLoopIndexFlag(CollectorNum))THEN
IF(ALLOCATED(PlantLoop))THEN
errFlag=.false.
CALL ScanPlantLoopsForObject(Collector(CollectorNum)%Name, &
Collector(CollectorNum)%TypeNum, &
Collector(CollectorNum)%WLoopNum, &
Collector(CollectorNum)%WLoopSideNum, &
Collector(CollectorNum)%WLoopBranchNum, &
Collector(CollectorNum)%WLoopCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitSolarCollector: Program terminated due to previous condition(s).')
ENDIF
SetLoopIndexFlag(CollectorNum) = .FALSE.
ENDIF
ENDIF
! FLOW:
InletNode = Collector(CollectorNum)%InletNode
OutletNode = Collector(CollectorNum)%OutletNode
IF (.NOT. SysSizingCalc .AND. Collector(CollectorNum)%InitSizing) THEN
CALL RegisterPlantCompDesignFlow(InletNode, Collector(CollectorNum)%VolFlowRateMax)
Collector(CollectorNum)%InitSizing = .FALSE.
END IF
IF (BeginEnvrnFlag .AND. Collector(CollectorNum)%Init) THEN
! Clear node initial conditions
IF (Collector(CollectorNum)%VolFlowRateMax >0)THEN !CR7425
rho = GetDensityGlycol(PlantLoop(Collector(CollectorNum)%WLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Collector(CollectorNum)%WLoopNum)%FluidIndex,&
'InitSolarCollector')
Collector(CollectorNum)%MassFlowRateMax = Collector(CollectorNum)%VolFlowRateMax * rho
ELSE !CR7425
Collector(CollectorNum)%MassFlowRateMax = BigNumber !CR7425
ENDIF !CR7425
CALL InitComponentNodes(0.d0, Collector(CollectorNum)%MassFlowRateMax, &
InletNode, &
OutletNode, &
Collector(CollectorNum)%WLoopNum, &
Collector(CollectorNum)%WLoopSideNum, &
Collector(CollectorNum)%WLoopBranchNum, &
Collector(CollectorNum)%WLoopCompNum)
Collector(CollectorNum)%Init = .FALSE.
IF ( Collector(CollectorNum)%InitICS ) THEN
Collector(CollectorNum)%TempOfWater = 20.0d0
Collector(CollectorNum)%SavedTempOfWater = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%SavedTempOfAbsPlate = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%TempOfAbsPlate = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%TempOfInnerCover = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%TempOfOuterCover = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%SavedTempOfInnerCover = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%SavedTempOfOuterCover = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%SavedTempCollectorOSCM = Collector(CollectorNum)%TempOfWater
!Collector(CollectorNum)%SavedTempOfOutdoorAir = Collector(CollectorNum)%TempOfWater
ENDIF
END IF
IF (.NOT. BeginEnvrnFlag) Collector(CollectorNum)%Init = .TRUE.
IF (SetDiffRadFlag(CollectorNum) .and. Collector(CollectorNum)%InitICS) THEN
! calculates the sky and ground reflective diffuse radiation optical properties (only one time)
SurfNum = Collector(CollectorNum)%Surface
ParamNum = Collector(CollectorNum)%Parameters
Tilt = Surface(SurfNum)%Tilt
Collector(CollectorNum)%Tilt = Tilt
Collector(CollectorNum)%TiltR2V = Abs(90.0d0 - Tilt)
Collector(CollectorNum)%CosTilt = cos(Tilt * DegToRadians)
Collector(CollectorNum)%SinTilt = sin(1.8d0 * Tilt * DegToRadians)
! Diffuse refelectance of the cover for solar radiation diffusely reflected back from the absober
! plate to the cover. The diffuse solar radiation reflected back from the absober plate to the
! cover is represented by the 60 degree equivalent incident angle. This diffuse reflectance is
! used to calculate the transmittance - absorptance product (Duffie and Beckman, 1991)
Theta = 60.0d0 * DegToRadians
Call CalcTransRefAbsOfCover(CollectorNum,Theta,TransSys,RefSys,AbsCover1,AbsCover2,.TRUE.,RefSysDiffuse)
Collector(CollectorNum)%RefDiffInnerCover = RefSysDiffuse
! transmittance-absorptance product normal incident:
Theta = 0.0d0
Call CalcTransRefAbsOfCover(CollectorNum,Theta,TransSys,RefSys,AbsCover1,AbsCover2)
Collector(CollectorNum)%TauAlphaNormal = TransSys * Parameters(ParamNum)%AbsorOfAbsPlate &
/ (1.d0-(1.d0-Parameters(ParamNum)%AbsorOfAbsPlate) &
* Collector(CollectorNum)%RefDiffInnerCover)
! transmittance-absorptance product for sky diffuse radiation. Uses equivalent incident angle
! of sky radiation (radians), and is calculated according to Brandemuehl and Beckman (1980):
Theta = (59.68d0 - 0.1388d0 * Tilt + 0.001497d0 * Tilt**2) * DegToRadians
Call CalcTransRefAbsOfCover(CollectorNum,Theta,TransSys,RefSys,AbsCover1,AbsCover2)
Collector(CollectorNum)%TauAlphaSkyDiffuse = TransSys * Parameters(ParamNum)%AbsorOfAbsPlate &
/ (1.d0-(1.d0-Parameters(ParamNum)%AbsorOfAbsPlate) &
* Collector(CollectorNum)%RefDiffInnerCover)
Collector(CollectorNum)%CoversAbsSkyDiffuse(1) = AbsCover1
Collector(CollectorNum)%CoversAbsSkyDiffuse(2) = AbsCover2
! transmittance-absorptance product for ground diffuse radiation. Uses equivalent incident angle
! of ground radiation (radians), and is calculated according to Brandemuehl and Beckman (1980):
Theta = (90.0d0 - 0.5788d0 * Tilt + 0.002693d0 * Tilt**2) * DegToRadians
Call CalcTransRefAbsOfCover(CollectorNum,Theta,TransSys,RefSys,AbsCover1,AbsCover2)
Collector(CollectorNum)%TauAlphaGndDiffuse = TransSys * Parameters(ParamNum)%AbsorOfAbsPlate &
/ (1.d0- (1.d0- Parameters(ParamNum)%AbsorOfAbsPlate) &
* Collector(CollectorNum)%RefDiffInnerCover)
Collector(CollectorNum)%CoversAbsGndDiffuse(1) = AbsCover1
Collector(CollectorNum)%CoversAbsGndDiffuse(2) = AbsCover2
SetDiffRadFlag(CollectorNum) = .FALSE.
ENDIF
Collector(CollectorNum)%InletTemp = Node(InletNode)%Temp
Collector(CollectorNum)%MassFlowRate = Collector(CollectorNum)%MassFlowRateMax
! Request the mass flow rate from the plant component flow utility routine
CALL SetComponentFlowRate(Collector(CollectorNum)%MassFlowRate,InletNode,OutletNode, &
Collector(CollectorNum)%WLoopNum,Collector(CollectorNum)%WLoopSideNum, &
Collector(CollectorNum)%WLoopBranchNum, Collector(CollectorNum)%WLoopCompNum)
IF (Collector(CollectorNum)%InitICS) THEN
TimeElapsed = HourOfDay + TimeStep * TimeStepZone + SysTimeElapsed
SurfNum = Collector(CollectorNum)%Surface
IF (Collector(CollectorNum)%TimeElapsed /= TimeElapsed) THEN
! The simulation has advanced to the next system timestep. Save conditions from the end of the previous
! system timestep for use as initial condition of each iteration that does not advance system timestep.
Collector(CollectorNum)%SavedTempOfWater = Collector(CollectorNum)%TempOfWater
Collector(CollectorNum)%SavedTempOfAbsPlate = Collector(CollectorNum)%TempOfAbsPlate
Collector(CollectorNum)%SavedTempOfInnerCover = Collector(CollectorNum)%TempOfInnerCover
Collector(CollectorNum)%SavedTempOfOuterCover = Collector(CollectorNum)%TempOfOuterCover
IF ( Collector(CollectorNum)%OSCM_ON ) THEN
CALL GetExtVentedCavityTsColl(Collector(CollectorNum)%VentCavIndex, &
Collector(CollectorNum)%SavedTempCollectorOSCM)
ENDIF
Collector(CollectorNum)%TimeElapsed = TimeElapsed
END IF
ENDIF
RETURN
END SUBROUTINE InitSolarCollector