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.
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 GetSolarCollectorInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN December 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the solar collector input from the input file and sets up the parameters and collector objects.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! USE STATEMENTS:
USE DataGlobals, ONLY: DegToRadians, InitConvTemp
USE DataHeatBalance
USE InputProcessor, ONLY: GetNumObjectsFound, FindItemInList, GetObjectItem, VerifyName, GetObjectDefMaxArgs, &
SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE Psychrometrics, ONLY: RhoH2O
USE DataLoopNode
USE DataPlant !DSU
USE General, ONLY: RoundSigDigits
USE DataSurfaces, ONLY: Surface, OSCM, TotOSCM, TotSurfaces, OtherSideCondModeledExt
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: ErrorsFound = .FALSE. ! Set to true if errors in input, fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: IsBlank ! TRUE if the name is blank
LOGICAL :: IsNotOk ! TRUE if there was a problem with a list name
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: CollectorNum ! Solar collector object number
INTEGER :: CollectorNum2 ! Second solar collector object number for looping
INTEGER :: ParametersNum ! Solar collector parameters object number
INTEGER :: SurfNum ! Collector surface object number
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
CHARACTER(len=MaxNameLength) :: CurrentModuleParamObject ! for ease in renaming.
INTEGER :: NumFields ! Total number of fields in object
INTEGER :: MaxAlphas ! Maximum number of alpha fields in all objects
INTEGER :: MaxNumbers ! Maximum number of numeric fields in all objects
INTEGER :: NumOfICSParam=0 ! number of parameter objects for ICS colectors
INTEGER :: NumOfICSUnits=0 ! number of ICS colector units
INTEGER :: NumOfFlatPlateParam=0 ! number of parameter objects for flat plate colectors
INTEGER :: NumFlatPlateUnits=0 ! number of plat plate solar colector units
INTEGER :: FlatPlateParamNum ! plat plate solar colector parameters counter
INTEGER :: ICSParamNum ! ICS collector parameters counter
INTEGER :: FlatPlateUnitsNum ! plat plate solar colector parameters counter
INTEGER :: ICSUnitsNum ! ICS collector parameters counter
INTEGER :: Found ! index
INTEGER :: VentCavIndex ! vent cavity index
REAL(r64) :: Perimeter ! perimeter of the absorber or collector
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers ! Numeric data
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas ! Alpha data
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .TRUE.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .TRUE.
! FLOW:
MaxNumbers=0
MaxAlphas=0
CurrentModuleParamObject = 'SolarCollectorPerformance:FlatPlate'
NumOfFlatPlateParam = GetNumObjectsFound(CurrentModuleParamObject)
CALL GetObjectDefMaxArgs(TRIM(CurrentModuleParamObject),NumFields,NumAlphas,NumNumbers)
MaxNumbers=MAX(MaxNumbers,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CurrentModuleObject = 'SolarCollector:FlatPlate:Water'
NumFlatPlateUnits = GetNumObjectsFound(CurrentModuleObject)
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumFields,NumAlphas,NumNumbers)
MaxNumbers=MAX(MaxNumbers,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CurrentModuleParamObject = 'SolarCollectorPerformance:IntegralCollectorStorage'
NumOfICSParam = GetNumObjectsFound(CurrentModuleParamObject)
CALL GetObjectDefMaxArgs(TRIM(CurrentModuleParamObject),NumFields,NumAlphas,NumNumbers)
MaxNumbers=MAX(MaxNumbers,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CurrentModuleObject = 'SolarCollector:IntegralCollectorStorage'
NumOfICSUnits = GetNumObjectsFound(CurrentModuleObject)
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumFields,NumAlphas,NumNumbers)
MaxNumbers=MAX(MaxNumbers,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
ALLOCATE(Alphas(MaxAlphas))
Alphas=' '
ALLOCATE(Numbers(MaxNumbers))
Numbers=0.0d0
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(MaxNumbers))
cNumericFields=' '
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(MaxNumbers))
lNumericBlanks=.TRUE.
NumOfCollectors = NumFlatPlateUnits + NumOfICSUnits
NumOfParameters = NumOfFlatPlateParam + NumOfICSParam
IF (NumOfParameters > 0) THEN
ALLOCATE(Parameters(NumOfParameters))
CurrentModuleParamObject = 'SolarCollectorPerformance:FlatPlate'
DO FlatPlateParamNum = 1, NumOfFlatPlateParam
ParametersNum = FlatPlateParamNum
CALL GetObjectItem(CurrentModuleParamObject, &
ParametersNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Collector module parameters name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),Parameters%Name,ParametersNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleParamObject))
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
Parameters(ParametersNum)%Name = cAlphaArgs(1)
! NOTE: This values serves mainly as a reference. The area of the associated surface object is used in all calculations.
Parameters(ParametersNum)%Area = rNumericArgs(1)
SELECT CASE(TRIM(cAlphaArgs(2)))
CASE('WATER')
Parameters(ParametersNum)%TestFluid = WATER
!CASE('AIR')
! Parameters(ParametersNum)%TestFluid = AIR
CASE DEFAULT
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1))// &
': '//TRIM(cAlphaArgs(2))//' is an unsupported Test Fluid for '//TRIM(cAlphaFieldNames(2)))
ErrorsFound = .TRUE.
END SELECT
IF (rNumericArgs(2) > 0.0d0) THEN
Parameters(ParametersNum)%TestMassFlowRate = rNumericArgs(2) * RhoH2O(InitConvTemp)
ELSE
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1))// &
': flow rate must be greater than zero for ' //TRIM(cNumericFieldNames(2)) )
ErrorsFound = .TRUE.
END IF
SELECT CASE(TRIM(cAlphaArgs(3)))
CASE('INLET')
Parameters(ParametersNum)%TestType = INLET
CASE('AVERAGE')
Parameters(ParametersNum)%TestType = AVERAGE
CASE('OUTLET')
Parameters(ParametersNum)%TestType = OUTLET
CASE DEFAULT
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1))// &
': '//TRIM(cAlphaArgs(3))//' is not supported for '//TRIM(cAlphaFieldNames(3)))
ErrorsFound = .TRUE.
END SELECT
! Efficiency equation coefficients
Parameters(ParametersNum)%eff0 = rNumericArgs(3)
Parameters(ParametersNum)%eff1 = rNumericArgs(4)
IF (NumNumbers > 4) THEN
Parameters(ParametersNum)%eff2 = rNumericArgs(5)
ELSE
Parameters(ParametersNum)%eff2 = 0.0d0
END IF
! Incident angle modifier coefficients
IF (NumNumbers > 5) THEN
Parameters(ParametersNum)%iam1 = rNumericArgs(6)
ELSE
Parameters(ParametersNum)%iam1 = 0.0d0
END IF
IF (NumNumbers > 6) THEN
Parameters(FlatPlateParamNum)%iam2 = rNumericArgs(7)
ELSE
Parameters(ParametersNum)%iam2 = 0.0d0
END IF
END DO ! ParametersNum
IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(CurrentModuleParamObject)//' input.')
END IF
IF (NumOfCollectors > 0) THEN
ALLOCATE(Collector(NumOfCollectors))
CurrentModuleObject = 'SolarCollector:FlatPlate:Water'
DO FlatPlateUnitsNum = 1, NumFlatPlateUnits
CollectorNum = FlatPlateUnitsNum
CALL GetObjectItem(CurrentModuleObject,CollectorNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus)
! Collector name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),Collector%Name,CollectorNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
Collector(CollectorNum)%Name = cAlphaArgs(1)
Collector(CollectorNum)%TypeNum = TypeOf_SolarCollectorFlatPlate ! parameter assigned in DataPlant !DSU
! Get parameters object
ParametersNum = FindItemInList(cAlphaArgs(2),Parameters%Name,NumOfParameters)
IF (ParametersNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': '//Trim(CurrentModuleParamObject)//' object called '//TRIM(cAlphaArgs(2))//' not found.')
ErrorsFound = .TRUE.
ELSE
Collector(CollectorNum)%Parameters = ParametersNum
END IF
! Get surface object
SurfNum = FindItemInList(cAlphaArgs(3),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Surface '//TRIM(cAlphaArgs(3))//' not found.')
ErrorsFound = .TRUE.
CYCLE ! avoid hard crash
ELSE
IF (.NOT. Surface(SurfNum)%ExtSolar) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Surface '//TRIM(cAlphaArgs(3))//' is not exposed to exterior radiation.')
END IF
! check surface orientation, warn if upside down
IF (( Surface(SurfNum)%Tilt < -95.0D0 ) .OR. (Surface(SurfNum)%Tilt > 95.0D0)) THEN
CALL ShowWarningError('Suspected input problem with '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError( 'Surface used for solar collector faces down')
CALL ShowContinueError('Surface tilt angle (degrees from ground outward normal) = ' &
//TRIM(RoundSigDigits(Surface(SurfNum)%Tilt,2) ) )
ENDIF
! Check to make sure other solar collectors are not using the same surface
! NOTE: Must search over all solar collector types
DO CollectorNum2 = 1, NumFlatPlateUnits
IF (Collector(CollectorNum2)%Surface == SurfNum) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Surface '//TRIM(cAlphaArgs(3))//' is referenced by more than one '//TRIM(CurrentModuleObject))
ErrorsFound = .TRUE.
EXIT
END IF
END DO ! CollectorNum2
Collector(CollectorNum)%Surface = SurfNum
END IF
! Give warning if surface area and gross area do not match within tolerance
IF (SurfNum > 0 .AND. ParametersNum > 0 .AND. Parameters(ParametersNum)%Area > 0.0d0 &
.AND. ABS(Parameters(ParametersNum)%Area - Surface(SurfNum)%Area)/Surface(SurfNum)%Area > 0.01d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Gross Area of solar collector parameters and surface object differ by more than 1%.')
CALL ShowContinueError('Area of surface object will be used in all calculations.')
END IF
Collector(CollectorNum)%InletNode = GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
Collector(CollectorNum)%OutletNode = GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
IF (NumNumbers > 0) THEN
Collector(CollectorNum)%VolFlowRateMax = rNumericArgs(1) ! Max volumetric flow rate used for plant sizing calculation
ELSE
Collector(CollectorNum)%VolFlowRateMax = 0.0d0 ! Max vol flow rate is not specified; no flow for plant sizing calculation
Collector(CollectorNum)%MassFlowRateMax = 999999.9d0 ! But...set a very high value so that it demands as much as possible
END IF
! Setup report variables
CALL SetupOutputVariable('Solar Collector Incident Angle Modifier []', Collector(CollectorNum)%IncidentAngleModifier, &
'System','Average',Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Efficiency []', Collector(CollectorNum)%Efficiency, &
'System','Average',Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Heat Transfer Rate [W]', Collector(CollectorNum)%Power, &
'System','Average',Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Heat Gain Rate [W]', Collector(CollectorNum)%HeatGain, &
'System','Average',Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Heat Loss Rate [W]', Collector(CollectorNum)%HeatLoss, &
'System','Average',Collector(FlatPlateUnitsNum)%Name)
CALL SetupOutputVariable('Solar Collector Heat Transfer Energy [J]', Collector(CollectorNum)%Energy, &
'System','Sum',Collector(FlatPlateUnitsNum)%Name, &
ResourceTypeKey='SolarWater',EndUseKey='HeatProduced',GroupKey='Plant')
CALL TestCompSet(TRIM(CurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Water Nodes')
END DO ! FlatPlateUnitsNum
! Get data for ICS collector
CurrentModuleParamObject = 'SolarCollectorPerformance:IntegralCollectorStorage'
DO ICSParamNum = 1, NumOfICSParam
ParametersNum = ICSParamNum + NumOfFlatPlateParam
CALL GetObjectItem(CurrentModuleParamObject, &
ICSParamNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Collector module parameters name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),Parameters%Name,ParametersNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleParamObject))
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
Parameters(ParametersNum)%Name = cAlphaArgs(1)
! NOTE: currently the only available choice is RectangularTank. In the future progressive tube type will be
! added
IF (SameString(cAlphaArgs(2), 'RectangularTank')) THEN
Parameters(ParametersNum)%ICSType_Num = ICSRectangularTank
ELSE
CALL ShowSevereError(TRIM(cAlphaFieldNames(2))//' not found='//TRIM(cAlphaArgs(2))// &
' in '//TRIM(CurrentModuleParamObject)//' ='//TRIM(Parameters(ParametersNum)%Name))
ErrorsFound=.true.
ENDIF
! NOTE: This collector gross area is used in all the calculations.
Parameters(ParametersNum)%Area = rNumericArgs(1)
IF ( rNumericArgs(1) <= 0.0d0 ) THEN
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Illegal '//TRIM(cNumericFieldNames(1))//' = '//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError(' Collector gross area must be always gretaer than zero.')
ErrorsFound=.TRUE.
ENDIF
Parameters(ParametersNum)%Volume = rNumericArgs(2)
IF ( rNumericArgs(2) <= 0.0d0 ) THEN
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Illegal '//TRIM(cNumericFieldNames(2))//' = '//TRIM(RoundSigDigits(rNumericArgs(2),2)))
CALL ShowContinueError(' Collector water volume must be always gretaer than zero.')
ErrorsFound=.TRUE.
ENDIF
!
! Note: this value is used to calculate the heat loss through the bottom and side of the collector
!Parameters(ParametersNum)%ULoss = rNumericArgs(3)
Parameters(ParametersNum)%ULossBottom = rNumericArgs(3)
Parameters(ParametersNum)%ULossSide = rNumericArgs(4)
Parameters(ParametersNum)%AspectRatio = rNumericArgs(5)
Parameters(ParametersNum)%SideHeight = rNumericArgs(6)
Parameters(ParametersNum)%ThermalMass = rNumericArgs(7)
Parameters(ParametersNum)%NumOfCovers = rNumericArgs(8)
Parameters(ParametersNum)%CoverSpacing = rNumericArgs(9)
IF (Parameters(ParametersNum)%NumOfCovers == 2)THEN
! Outer cover refractive index
Parameters(ParametersNum)%RefractiveIndex(1) = rNumericArgs(10)
! Outer cover extinction coefficient times thickness of the cover
Parameters(ParametersNum)%ExtCoefTimesThickness(1) = rNumericArgs(11)
! Outer cover Emissivity
Parameters(ParametersNum)%EmissOfCover(1) = rNumericArgs(12)
IF (.NOT. lNumericFieldBlanks(13) .OR. .NOT. lNumericFieldBlanks(14) .OR. .NOT. lNumericFieldBlanks(15))THEN
Parameters(ParametersNum)%RefractiveIndex(2) = rNumericArgs(13)
Parameters(ParametersNum)%ExtCoefTimesThickness(2) = rNumericArgs(14)
Parameters(ParametersNum)%EmissOfCover(2) = rNumericArgs(15)
ELSE
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Illegal input for one of the three inputs of the inner cover optical properties')
ErrorsFound=.TRUE.
ENDIF
ELSEIF (Parameters(ParametersNum)%NumOfCovers == 1)THEN
! Outer cover refractive index
Parameters(ParametersNum)%RefractiveIndex(1) = rNumericArgs(10)
! Outer cover extinction coefficient times thickness of the cover
Parameters(ParametersNum)%ExtCoefTimesThickness(1) = rNumericArgs(11)
! Outer cover emissivity
Parameters(ParametersNum)%EmissOfCover(1) = rNumericArgs(12)
ELSE
CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Illegal '//TRIM(cNumericFieldNames(8))//' = '//TRIM(RoundSigDigits(rNumericArgs(8),2)))
ErrorsFound=.TRUE.
ENDIF
!
! Solar absorptance of the absorber plate
Parameters(ParametersNum)%AbsorOfAbsPlate = rNumericArgs(16)
!
! thermal emmissivity of the absorber plate
Parameters(ParametersNum)%EmissOfAbsPlate = rNumericArgs(17)
END DO ! end of ParametersNum
IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(CurrentModuleParamObject)//' input.')
CurrentModuleObject = 'SolarCollector:IntegralCollectorStorage'
DO ICSUnitsNum = 1, NumOfICSUnits
CollectorNum = ICSUnitsNum + NumFlatPlateUnits
CALL GetObjectItem(CurrentModuleObject, &
ICSUnitsNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Collector name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),Collector%Name,CollectorNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
Collector(CollectorNum)%Name = cAlphaArgs(1)
Collector(CollectorNum)%TypeNum = TypeOf_SolarCollectorICS ! parameter assigned in DataPlant
Collector(CollectorNum)%InitICS = .TRUE.
! Get parameters object
ParametersNum = FindItemInList(cAlphaArgs(2),Parameters%Name,NumOfParameters)
IF (ParametersNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': '//Trim(CurrentModuleParamObject)//' object called '//TRIM(cAlphaArgs(2))//' not found.')
ErrorsFound = .TRUE.
ELSE
Collector(CollectorNum)%Parameters = ParametersNum
END IF
IF (ParametersNum > 0) THEN
! Calculate constant collector parameters only once
Perimeter = 2.0d0 * SQRT(Parameters(ParametersNum)%Area) &
* (SQRT(Parameters(ParametersNum)%AspectRatio) + 1.d0/SQRT(Parameters(ParametersNum)%AspectRatio))
Collector(CollectorNum)%Length = SQRT(Parameters(ParametersNum)%Area/Parameters(ParametersNum)%AspectRatio)
! calculate the collector side heat transfer area and loss coefficient
Collector(CollectorNum)%ICSType_Num = Parameters(ParametersNum)%ICSType_Num
Collector(CollectorNum)%Area = Parameters(ParametersNum)%Area
Collector(CollectorNum)%Volume = Parameters(ParametersNum)%Volume
Collector(CollectorNum)%SideArea = Perimeter * Parameters(ParametersNum)%SideHeight
Collector(CollectorNum)%AreaRatio = Collector(CollectorNum)%SideArea / Collector(CollectorNum)%Area
ENDIF
! Get surface object
SurfNum = FindItemInList(cAlphaArgs(3),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Surface '//TRIM(cAlphaArgs(3))//' not found.')
ErrorsFound = .TRUE.
CYCLE ! avoid hard crash
ELSE
IF (.NOT. Surface(SurfNum)%ExtSolar) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Surface '//TRIM(cAlphaArgs(3))//' is not exposed to exterior radiation.')
END IF
! check surface orientation, warn if upside down
IF (( Surface(SurfNum)%Tilt < -95.0D0 ) .OR. (Surface(SurfNum)%Tilt > 95.0D0)) THEN
CALL ShowWarningError('Suspected input problem with '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError( 'Surface used for solar collector faces down')
CALL ShowContinueError('Surface tilt angle (degrees from ground outward normal) = ' &
//TRIM(RoundSigDigits(Surface(SurfNum)%Tilt,2) ) )
ENDIF
! Check to make sure other solar collectors are not using the same surface
! NOTE: Must search over all solar collector types
DO CollectorNum2 = 1, NumOfCollectors
IF (Collector(CollectorNum2)%Surface == SurfNum) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Surface '//TRIM(cAlphaArgs(3))//' is referenced by more than one '//TRIM(CurrentModuleObject))
ErrorsFound = .TRUE.
EXIT
END IF
END DO ! ICSNum2
Collector(CollectorNum)%Surface = SurfNum
END IF
! Give warning if surface area and gross area do not match within tolerance
IF (SurfNum > 0 .AND. ParametersNum > 0 .AND. Parameters(ParametersNum)%Area > 0.0d0 &
.AND. ABS(Parameters(ParametersNum)%Area - Surface(SurfNum)%Area)/Surface(SurfNum)%Area > 0.01d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))//': ')
CALL ShowContinueError('Gross area of solar collector parameters and surface object differ by more than 1%.')
CALL ShowContinueError('Gross collector area is always used in the calculation. Modify the surface ')
CALL ShowContinueError('coordinates to match its area with collector gross area. Otherwise, the underlying ')
CALL ShowContinueError('surface is assumed to be fully shaded when it is not.')
END IF
Collector(CollectorNum)%BCType = cAlphaArgs(4)
IF (SameString(cAlphaArgs(4), 'AmbientAir')) THEN
Collector(CollectorNum)%OSCMName = ' '
ELSEIF (SameString(cAlphaArgs(4), 'OtherSideConditionsModel')) THEN
Collector(CollectorNum)%OSCMName = cAlphaArgs(5)
Collector(CollectorNum)%OSCM_ON = .TRUE.
Found = FindItemInList(Collector(CollectorNum)%OSCMName,OSCM%Name,TotOSCM)
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cAlphaFieldNames(5))//' not found='//TRIM(Collector(CollectorNum)%OSCMName)// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(Collector(CollectorNum)%Name))
ErrorsFound=.true.
ENDIF
!Collector(CollectorNum)%OSCMPtr = Found
!Surface(SurfNum)%IsICS = .true.
ELSE
CALL ShowSevereError(TRIM(cAlphaFieldNames(5))//' not found='//TRIM(Collector(CollectorNum)%BCType)// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(Collector(CollectorNum)%Name))
ErrorsFound=.true.
ENDIF
IF ( Collector(CollectorNum)%OSCM_ON ) THEN
! get index of ventilated cavity object
CALL GetExtVentedCavityIndex(SurfNum, VentCavIndex)
Collector(CollectorNum)%VentCavIndex = VentCavIndex
ENDIF
Collector(CollectorNum)%InletNode = GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
Collector(CollectorNum)%OutletNode = GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
IF (NumNumbers > 0) THEN
Collector(CollectorNum)%VolFlowRateMax = rNumericArgs(1) ! Max volumetric flow rate used for plant sizing calculation
ELSE
Collector(CollectorNum)%VolFlowRateMax = 0.0d0 ! Max vol flow rate is not specified; no flow for plant sizing calculation
Collector(CollectorNum)%MassFlowRateMax = 999999.9d0 ! But...set a very high value so that it demands as much as possible
END IF
! Setup report variables
CALL SetupOutputVariable('Solar Collector Transmittance Absorptance Product []', &
Collector(CollectorNum)%TauAlpha, 'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Overall Top Heat Loss Coefficient [W/m2-C]', &
Collector(CollectorNum)%UTopLoss,'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Absorber Plate Temperature [C]', &
Collector(CollectorNum)%TempOfAbsPlate, 'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Storage Water Temperature [C]', &
Collector(CollectorNum)%TempOfWater, 'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Thermal Efficiency []', &
Collector(CollectorNum)%Efficiency, 'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Storage Heat Transfer Rate [W]', &
Collector(CollectorNum)%StoredHeatRate, 'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Storage Heat Transfer Energy [J]', &
Collector(CollectorNum)%StoredHeatEnergy, 'System','Sum', &
Collector(CollectorNum)%Name,ResourceTypeKey='SolarWater', &
EndUseKey='HeatProduced',GroupKey='Plant')
CALL SetupOutputVariable('Solar Collector Skin Heat Transfer Rate [W]', &
Collector(CollectorNum)%SkinHeatLossRate, &
'System','Average',Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Skin Heat Transfer Energy [J]', &
Collector(CollectorNum)%CollHeatLossEnergy,'System','Sum', &
Collector(CollectorNum)%Name,ResourceTypeKey='SolarWater', &
EndUseKey='HeatProduced',GroupKey='Plant')
CALL SetupOutputVariable('Solar Collector Heat Transfer Rate [W]', &
Collector(CollectorNum)%HeatRate, 'System','Average', &
Collector(CollectorNum)%Name)
CALL SetupOutputVariable('Solar Collector Heat Transfer Energy [J]', &
Collector(CollectorNum)%HeatEnergy,'System','Sum', &
Collector(CollectorNum)%Name, ResourceTypeKey='SolarWater', &
EndUseKey='HeatProduced',GroupKey='Plant')
CALL TestCompSet(TRIM(CurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Water Nodes')
END DO ! ICSNum
IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(CurrentModuleObject)//' input.')
IF (NumOfCollectors > 0) THEN
ALLOCATE(CheckEquipName(NumOfCollectors))
CheckEquipName = .TRUE.
ENDIF
END IF
RETURN
END SUBROUTINE GetSolarCollectorInput