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 GetTranspiredCollectorInput
! SUBROUTINE INFORMATION:
! AUTHOR B.T. Griffith
! DATE WRITTEN November 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Retrieve user input and set up data structure
! METHODOLOGY EMPLOYED:
! usual EnergyPlus input
! Extensible UTSC object for underlying heat transfer surfaces and for multisystem
! REFERENCES:
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, GetObjectDefMaxArgs, FindItemInList , &
SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE DataGlobals, ONLY: PI, ScheduleAlwaysOn
USE DataInterfaces, ONLY: ShowSevereError, SetupOutputVariable
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE DataSurfaces, ONLY: Surface, OSCM, TotOSCM, TotSurfaces, OtherSideCondModeledExt
USE ScheduleManager, ONLY: GetScheduleIndex
USE DataLoopNode, ONLY: NodeType_Air, NodeConnectionType_Inlet, NodeConnectionType_Outlet, ObjectIsNotParent, &
NodeConnectionType_Sensor
USE NodeInputManager, ONLY: GetOnlySingleNode
USE DataHeatBalance, ONLY: VeryRough, Rough, MediumRough, MediumSmooth, Smooth, VerySmooth
USE BranchNodeConnections, ONLY: TestCompSet
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: Alphas ! Alpha items for extensible
! Solar Collectors:Unglazed Transpired object
INTEGER :: Item ! Item to be "gotten"
REAL(r64), DIMENSION(11) :: Numbers ! Numeric items for object
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: MaxNumAlphas !argumenet for call to GetObjectDefMaxArgs
INTEGER :: MaxNumNumbers !argumenet for call to GetObjectDefMaxArgs
INTEGER :: Dummy !argumenet for call to GetObjectDefMaxArgs
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
INTEGER :: Found
INTEGER :: AlphaOffset !local temp var
CHARACTER(len=MaxNameLength) :: Roughness
INTEGER :: thisSurf ! do loop counter
REAL(r64) :: AvgAzimuth ! temp for error checking
REAL(r64) :: AvgTilt ! temp for error checking
INTEGER :: SurfID ! local surface "pointer"
REAL(r64) :: TiltRads ! average tilt of collector in radians
REAL(r64) :: tempHdeltaNPL ! temporary variable for bouyancy length scale
INTEGER :: numUTSCSplitter !
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: AlphasSplit ! Alpha items for extensible
! Solar Collectors:Unglazed Transpired object
INTEGER :: ItemSplit ! Item to be "gotten"
REAL(r64) , DIMENSION(1) :: NumbersSplit ! Numeric items for object
INTEGER :: NumAlphasSplit ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbersSplit ! Number of Numbers for each GetObjectItem call
INTEGER :: MaxNumAlphasSplit !argumenet for call to GetObjectDefMaxArgs
INTEGER :: MaxNumNumbersSplit !argumenet for call to GetObjectDefMaxArgs
INTEGER :: IOStatusSplit ! Used in GetObjectItem
INTEGER :: NumOASys ! do loop counter
INTEGER :: ACountBase ! counter for alhpasSplit
Logical, allocatable, Dimension(:) :: SplitterNameOK ! check for correct association of
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
CHARACTER(len=MaxNameLength) :: CurrentModuleMultiObject ! for ease in renaming.
CurrentModuleObject = 'SolarCollector:UnglazedTranspired'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Dummy, MaxNumAlphas,MaxNumNumbers)
IF (MaxNumNumbers /= 11) THEN
CALL ShowSevereError('GetTranspiredCollectorInput: '//TRIM(CurrentModuleObject)//' Object Definition indicates '// &
'not = 11 Number Objects, Number Indicated='// &
TRIM(TrimSigDigits(MaxNumNumbers)))
ErrorsFound=.true.
ENDIF
ALLOCATE(Alphas(MaxNumAlphas))
Numbers = 0.0d0
Alphas = ' '
numUTSC = GetNumObjectsFound(CurrentModuleObject)
numUTSCSplitter = 0 !init
CurrentModuleMultiObject = 'SolarCollector:UnglazedTranspired:Multisystem'
numUTSCSplitter = GetNumObjectsFound(CurrentModuleMultiObject)
ALLOCATE(UTSC(NumUTSC))
ALLOCATE(CheckEquipName(NumUTSC))
CheckEquipName=.true.
ALLOCATE(SplitterNameOK(numUTSCSplitter))
SplitterNameOK = .FALSE.
DO Item=1,NumUTSC
CALL GetObjectItem(CurrentModuleObject,Item,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! first handle alphas
UTSC(Item)%Name = Alphas(1)
! now check for multisystem
If (numUTSCSplitter > 0) Then
CALL GetObjectDefMaxArgs(TRIM(CurrentModuleMultiObject),Dummy, MaxNumAlphasSplit,MaxNumNumbersSplit)
IF (MaxNumNumbersSplit /= 0) THEN
CALL ShowSevereError('GetTranspiredCollectorInput: '//TRIM(CurrentModuleMultiObject)//' Object Definition '// &
'indicates not = 0 Number Objects, Number Indicated='// &
TRIM(TrimSigDigits(MaxNumNumbersSplit)))
ErrorsFound=.true.
ENDIF
IF (.NOT.ALLOCATED(AlphasSplit)) Allocate(AlphasSplit(MaxNumAlphasSplit))
NumbersSplit = 0.0d0
AlphasSplit = ' '
Do ItemSplit = 1, NumUTSCSplitter
CALL GetObjectItem(CurrentModuleMultiObject,ItemSplit,AlphasSplit,NumAlphasSplit, &
NumbersSplit,NumNumbersSplit,IOStatusSplit)
If (.NOT.( SameString(AlphasSplit(1),Alphas(1)) ) ) Cycle
SplitterNameOK(ItemSplit) = .true.
UTSC(Item)%NumOASysAttached = floor(NumAlphasSplit/4.0d0)
IF (MOD((NumAlphasSplit),4) /= 1) THEN
CALL ShowSevereError('GetTranspiredCollectorInput: '//TRIM(CurrentModuleMultiObject)// &
' Object Definition indicates not uniform quadtuples of nodes for '// &
TRIM(AlphasSplit(1)) )
ErrorsFound=.true.
ENDIF
ALLOCATE (UTSC(Item)%InletNode(UTSC(Item)%NumOASysAttached))
UTSC(Item)%InletNode = 0
ALLOCATE (UTSC(Item)%OutletNode(UTSC(Item)%NumOASysAttached))
UTSC(Item)%OutletNode = 0
ALLOCATE (UTSC(Item)%ControlNode(UTSC(Item)%NumOASysAttached))
UTSC(Item)%ControlNode = 0
ALLOCATE (UTSC(Item)%ZoneNode(UTSC(Item)%NumOASysAttached))
UTSC(Item)%ZoneNode = 0
Do NumOASys = 1, UTSC(Item)%NumOASysAttached
ACountBase = (NumOASys - 1)*4 + 2
UTSC(Item)%InletNode(NumOASys) = &
GetOnlySingleNode(AlphasSplit(ACountBase),ErrorsFound,TRIM(CurrentModuleObject), &
AlphasSplit(1), NodeType_Air,NodeConnectionType_Inlet,NumOASys,ObjectIsNotParent)
UTSC(Item)%OutletNode(NumOASys) = &
GetOnlySingleNode(AlphasSplit(ACountBase + 1),ErrorsFound, &
TRIM(CurrentModuleObject), &
AlphasSplit(1), NodeType_Air,NodeConnectionType_Outlet,NumOASys,ObjectIsNotParent)
CALL TestCompSet(TRIM(CurrentModuleObject),AlphasSplit(1),AlphasSplit(ACountBase), &
AlphasSplit(ACountBase + 1), 'Transpired Collector Air Nodes') !appears that test fails by design??
UTSC(Item)%ControlNode(NumOASys) = &
GetOnlySingleNode(AlphasSplit(ACountBase + 2),ErrorsFound, &
TRIM(CurrentModuleObject), &
AlphasSplit(1), NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsNotParent)
UTSC(Item)%ZoneNode(NumOASys) = &
GetOnlySingleNode(AlphasSplit(ACountBase + 3),ErrorsFound, &
TRIM(CurrentModuleObject), &
AlphasSplit(1), NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsNotParent)
ENDDO ! Each OA System in a Multisystem
! DEALLOCATE(AlphasSplit)
ENDDO ! each Multisystem present
ENDIF ! any UTSC Multisystem present
UTSC(Item)%OSCMName = Alphas(2)
Found = FindItemInList(UTSC(Item)%OSCMName,OSCM%Name,TotOSCM)
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cAlphaFieldNames(2))//' not found='//TRIM(UTSC(Item)%OSCMName)// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
ENDIF
UTSC(Item)%OSCMPtr = Found
IF (lAlphaFieldBlanks(3)) THEN
UTSC(Item)%SchedPtr = ScheduleAlwaysOn
ELSE
UTSC(Item)%SchedPtr = GetScheduleIndex(Alphas(3))
IF (UTSC(Item)%SchedPtr == 0) THEN
CALL ShowSevereError(TRIM(cAlphaFieldNames(3))//'not found='//TRIM(Alphas(3))// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
ENDIF
!now if UTSC(Item)%NumOASysAttached still not set, assume no multisystem
IF (UTSC(Item)%NumOASysAttached == 0) THEN
UTSC(Item)%NumOASysAttached = 1
ALLOCATE (UTSC(Item)%InletNode(1))
UTSC(Item)%InletNode(1) = 0
ALLOCATE (UTSC(Item)%OutletNode(1))
UTSC(Item)%OutletNode(1) = 0
ALLOCATE (UTSC(Item)%ControlNode(1))
UTSC(Item)%ControlNode(1)= 0
ALLOCATE (UTSC(Item)%ZoneNode(1))
UTSC(Item)%ZoneNode(1)= 0
UTSC(Item)%InletNode(1) = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
UTSC(Item)%OutletNode(1) = &
GetOnlySingleNode(Alphas(5),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet(TRIM(CurrentModuleObject),Alphas(1),Alphas(4),Alphas(5), &
'Transpired Collector Air Nodes')
UTSC(Item)%ControlNode(1) = &
GetOnlySingleNode(Alphas(6),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsNotParent)
UTSC(Item)%ZoneNode(1) = &
GetOnlySingleNode(Alphas(7),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsNotParent)
ENDIF !no splitter
UTSC(Item)%FreeHeatSetpointSchedPtr = GetScheduleIndex(Alphas(8))
IF (UTSC(Item)%FreeHeatSetpointSchedPtr == 0) THEN
CALL ShowSevereError(TRIM(cAlphaFieldNames(8))//' not found='//TRIM(Alphas(8))// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
IF (SameString(Alphas(9),'Triangle')) THEN
UTSC(Item)%layout = Layout_Triangle
ELSEIF (SameString(Alphas(9),'Square')) THEN
UTSC(Item)%layout = Layout_Square
ELSE
CALL ShowSevereError(TRIM(cAlphaFieldNames(9))//' has incorrect entry of '//Trim(alphas(9))// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound = .TRUE.
CYCLE
ENDIF
IF (SameString(Alphas(10),'Kutscher1994')) THEN
UTSC(Item)%Correlation = Correlation_Kutscher1994
ELSEIF (SameString(Alphas(10),'VanDeckerHollandsBrunger2001')) THEN
UTSC(Item)%Correlation = Correlation_VanDeckerHollandsBrunger2001
ELSE
CALL ShowSevereError(TRIM(cAlphaFieldNames(10))//' has incorrect entry of '//Trim(alphas(9))// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound = .TRUE.
CYCLE
ENDIF
Roughness = Alphas(11)
!Select the correct Number for the associated ascii name for the roughness type
IF (SameString(Roughness,'VeryRough')) UTSC(Item)%CollRoughness=VeryRough
IF (SameString(Roughness,'Rough')) UTSC(Item)%CollRoughness=Rough
IF (SameString(Roughness,'MediumRough')) UTSC(Item)%CollRoughness=MediumRough
IF (SameString(Roughness,'MediumSmooth')) UTSC(Item)%CollRoughness=MediumSmooth
IF (SameString(Roughness,'Smooth')) UTSC(Item)%CollRoughness=Smooth
IF (SameString(Roughness,'VerySmooth')) UTSC(Item)%CollRoughness=VerySmooth
! Was it set?
IF (UTSC(Item)%CollRoughness == 0) THEN
CALL ShowSevereError(TRIM(cAlphaFieldNames(11))//' has incorrect entry of '//TRIM(Alphas(11))// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
ENDIF
AlphaOffset = 11
UTSC(Item)%NumSurfs = NumAlphas - AlphaOffset
IF (UTSC(Item)%NumSurfs == 0) THEN
Call ShowSevereError('No underlying surfaces specified in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound = .true.
CYCLE
ENDIF
ALLOCATE(UTSC(Item)%SurfPtrs(UTSC(Item)%NumSurfs))
UTSC(Item)%SurfPtrs = 0
DO thisSurf = 1, UTSC(Item)%NumSurfs
Found = FindItemInList(Alphas(thisSurf + AlphaOffset), Surface%Name, TotSurfaces)
If (Found == 0) Then
CALL ShowSevereError('Surface Name not found='//TRIM(Alphas(thisSurf + AlphaOffset))// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
! check that surface is appropriate, Heat transfer, Sun, Wind,
IF (.not. surface(Found)%HeatTransSurf) then
CALL ShowSevereError('Surface '//TRIM(Alphas(thisSurf + AlphaOffset))//' not of Heat Transfer type '// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
IF (.not. surface(found)%ExtSolar) then
CALL ShowSevereError('Surface '//TRIM(Alphas(thisSurf + AlphaOffset))//' not exposed to sun '// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
IF (.not. surface(found)%ExtWind) then
CALL ShowSevereError('Surface '//TRIM(Alphas(thisSurf + AlphaOffset))//' not exposed to wind '// &
' in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
If(surface(found)%ExtBoundCond /= OtherSideCondModeledExt) Then
CALL ShowSevereError('Surface '//TRIM(Alphas(thisSurf + AlphaOffset))//' does not have OtherSideConditionsModel '// &
'for exterior boundary conditions in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ErrorsFound=.true.
CYCLE
ENDIF
! check surface orientation, warn if upside down
IF (( Surface(found)%Tilt < -95.0D0 ) .OR. (Surface(found)%Tilt > 95.0D0)) THEN
CALL ShowWarningError('Suspected input problem with collector surface = '//TRIM(Alphas(thisSurf + AlphaOffset)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(UTSC(Item)%Name) )
CALL ShowContinueError( 'Surface used for solar collector faces down')
CALL ShowContinueError('Surface tilt angle (degrees from ground outward normal) = ' &
//TRIM(RoundSigDigits(Surface(found)%Tilt,2)) )
ENDIF
UTSC(Item)%SurfPtrs(thisSurf) = Found
ENDDO
IF (ErrorsFound) CYCLE ! previous inner do loop may have detected problems that need to be cycle'd again to avoid crash
! now that we should have all the surfaces, do some preperations and checks.
! are they all similar tilt and azimuth? Issue warnings so people can do it if they really want
AvgAzimuth = SUM(Surface(UTSC(Item)%SurfPtrs)%Azimuth * Surface(UTSC(Item)%SurfPtrs)%Area) &
/SUM(Surface(UTSC(Item)%SurfPtrs)%Area)
AvgTilt = SUM(Surface(UTSC(Item)%SurfPtrs)%Tilt * Surface(UTSC(Item)%SurfPtrs)%Area) &
/SUM(Surface(UTSC(Item)%SurfPtrs)%Area)
DO thisSurf = 1, UTSC(Item)%NumSurfs
SurfID = UTSC(Item)%SurfPtrs(thisSurf)
If (ABS(Surface(SurfID)%Azimuth - AvgAzimuth) > 15.d0 ) Then
Call ShowWarningError('Surface '//TRIM(Surface(SurfID)%name)//' has Azimuth different from others in '// &
'the group associated with '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ENDIF
IF (ABS(Surface(SurfID)%Tilt - AvgTilt) > 10.d0 ) Then
Call ShowWarningError('Surface '//TRIM(Surface(SurfID)%name)//' has Tilt different from others in '// &
'the group associated with '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
ENDIF
!test that there are no windows. Now allow windows
! If (Surface(SurfID)%GrossArea > Surface(SurfID)%Area) Then
! Call ShowWarningError('Surface '//TRIM(Surface(SurfID)%name)//' has a subsurface whose area is not being ' &
! //'subtracted in the group of surfaces associated with '//TRIM(UTSC(Item)%Name))
! endif
ENDDO
UTSC(Item)%Tilt = AvgTilt
UTSC(Item)%Azimuth = AvgAzimuth
! find area weighted centroid.
! UTSC(Item)%Centroid%X = SUM(Surface(UTSC(Item)%SurfPtrs)%Centroid%X*Surface(UTSC(Item)%SurfPtrs)%Area) &
! /SUM(Surface(UTSC(Item)%SurfPtrs)%Area)
! UTSC(Item)%Centroid%Y = SUM(Surface(UTSC(Item)%SurfPtrs)%Centroid%Y*Surface(UTSC(Item)%SurfPtrs)%Area) &
! /SUM(Surface(UTSC(Item)%SurfPtrs)%Area)
UTSC(Item)%Centroid%Z = SUM(Surface(UTSC(Item)%SurfPtrs)%Centroid%Z*Surface(UTSC(Item)%SurfPtrs)%Area) &
/SUM(Surface(UTSC(Item)%SurfPtrs)%Area)
!now handle numbers from input object
UTSC(Item)%HoleDia = Numbers(1)
UTSC(Item)%Pitch = Numbers(2)
UTSC(Item)%LWEmitt = Numbers(3)
UTSC(Item)%SolAbsorp = Numbers(4)
UTSC(Item)%Height = Numbers(5)
UTSC(Item)%PlenGapThick = Numbers(6)
IF (UTSC(Item)%PlenGapThick <= 0.0d0) THEN
CALL ShowSevereError('Plenum gap must be greater than Zero in '//TRIM(CurrentModuleObject)//' ='//TRIM(UTSC(Item)%Name))
CYCLE
ENDIF
UTSC(Item)%PlenCrossArea = Numbers(7)
UTSC(Item)%AreaRatio = Numbers(8)
UTSC(Item)%CollectThick = Numbers(9)
UTSC(Item)%Cv = Numbers(10)
UTSC(Item)%Cd = Numbers(11)
! Fill out data we now know
! sum areas of HT surface areas
UTSC(Item)%ProjArea = SUM(Surface(UTSC(Item)%SurfPtrs)%Area)
IF (UTSC(Item)%ProjArea == 0) THEN
CALL ShowSevereError('Gross area of underlying surfaces is zero in '//TRIM(CurrentModuleObject)// &
' ='//TRIM(UTSC(Item)%Name))
CYCLE
endif
UTSC(Item)%ActualArea = UTSC(Item)%ProjArea * UTSC(Item)%AreaRatio
! need to update this for slots as well as holes
SELECT CASE (UTSC(Item)%Layout)
CASE(Layout_Triangle) ! 'TRIANGLE'
UTSC(Item)%Porosity = 0.907d0*(UTSC(Item)%HoleDia / UTSC(Item)%Pitch)**2.0d0 !Kutscher equation, Triangle layout
CASE(Layout_Square) ! 'SQUARE'
UTSC(Item)%Porosity = (PI/4.d0)*(UTSC(Item)%HoleDia**2.0d0)/(UTSC(Item)%Pitch**2.0d0) !Waterloo equation, square layout
END SELECT
TiltRads = ABS(AvgTilt) * DegToRadians
TempHdeltaNPL = SIN(TiltRads)*UTSC(Item)%Height / 4.0d0
UTSC(Item)%HdeltaNPL = MAX(tempHdeltaNPL, UTSC(Item)%PlenGapThick)
CALL SetupOutputVariable('Solar Collector Heat Exchanger Effectiveness []',UTSC(Item)%HXeff, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Leaving Air Temperature [C]',UTSC(Item)%TairHX, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Outside Face Suction Velocity [m/s]',UTSC(Item)%Vsuction, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Surface Temperature [C]',UTSC(Item)%Tcoll, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Plenum Air Temperature [C]',UTSC(Item)%Tplen, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Sensible Heating Rate [W]',UTSC(Item)%SensHeatingRate, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Sensible Heating Energy [J]',UTSC(Item)%SensHeatingEnergy, &
'System','Sum',UTSC(Item)%Name, &
ResourceTypeKey='SolarAir' , EndUseKey='HeatProduced',GroupKey = 'System')
CALL SetupOutputVariable('Solar Collector Natural Ventilation Air Change Rate [ACH]',UTSC(Item)%PassiveACH, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Natural Ventilation Mass Flow Rate [kg/s]',UTSC(Item)%PassiveMdotVent, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Wind Natural Ventilation Mass Flow Rate [kg/s]',UTSC(Item)%PassiveMdotWind, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Buoyancy Natural Ventilation Mass Flow Rate [kg/s]',UTSC(Item)%PassiveMdotTherm, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Incident Solar Radiation [W/m2]',UTSC(Item)%Isc, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector System Efficiency []',UTSC(Item)%UTSCEfficiency, &
'System','Average',UTSC(Item)%Name)
CALL SetupOutputVariable('Solar Collector Surface Efficiency []',UTSC(Item)%UTSCCollEff, &
'System','Average',UTSC(Item)%Name)
ENDDO
Do ItemSplit = 1, NumUTSCSplitter
If (.not.SplitterNameOK(ItemSplit)) then
CALL ShowSevereError('Did not find a match, check names for Solar Collectors:Transpired Collector:Multisystem')
ErrorsFound = .true.
endif
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('GetTranspiredCollectorInput: Errors found in input')
ENDIF
DEALLOCATE(Alphas)
RETURN
END SUBROUTINE GetTranspiredCollectorInput