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 GetHighTempRadiantSystem
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN February 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads the input for high temperature radiant systems
! from the user input file. This will contain all of the information
! needed to simulate a high temperature radiant system.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : NumOfZones
USE DataHeatBalance, ONLY : Zone
USE DataSurfaces, ONLY : Surface, TotSurfaces
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, FindItemInList, SameString, VerifyName, GetObjectDefMaxArgs
USE ScheduleManager, ONLY : GetScheduleIndex
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
REAL(r64), PARAMETER :: MaxCombustionEffic = 1.00d0 ! Limit the combustion efficiency to perfection
REAL(r64), PARAMETER :: MaxFraction = 1.0d0 ! Limit the highest allowed fraction for heat transfer parts
REAL(r64), PARAMETER :: MinCombustionEffic = 0.01d0 ! Limit the minimum combustion efficiency
REAL(r64), PARAMETER :: MinFraction = 0.0d0 ! Limit the lowest allowed fraction for heat transfer parts
REAL(r64), PARAMETER :: MinThrottlingRange = 0.5d0 ! Smallest throttling range allowed in degrees Celsius
! INTEGER, PARAMETER :: MaxDistribSurfaces = 20 ! Maximum number of surfaces that a radiant heater can radiate to
CHARACTER(len=*), PARAMETER :: RoutineName='GetHighTempRadiantSystem: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AllFracsSummed ! Sum of the fractions radiant, latent, and lost (must be <= 1)
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
INTEGER :: Item ! Item to be "gotten"
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: SurfNum ! Surface number DO loop counter
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
! FLOW:
! Initializations and allocations
NumOfHighTempRadSys = GetNumObjectsFound('ZoneHVAC:HighTemperatureRadiant')
ALLOCATE(HighTempRadSys(NumOfHighTempRadSys))
ALLOCATE(CheckEquipName(NumOfHighTempRadSys))
CheckEquipName=.true.
! extensible object, do not need max args because using IPShortCuts
cCurrentModuleObject = 'ZoneHVAC:HighTemperatureRadiant'
! Obtain all of the user data related to high temperature radiant systems...
DO Item = 1, NumOfHighTempRadSys
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),HighTempRadSys%Name,Item-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
! General user input data
HighTempRadSys(Item)%Name = cAlphaArgs(1)
HighTempRadSys(Item)%SchedName = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
HighTempRadSys(Item)%SchedPtr = ScheduleAlwaysOn
ELSE
HighTempRadSys(Item)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (HighTempRadSys(Item)%SchedPtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
END IF
HighTempRadSys(Item)%ZoneName = cAlphaArgs(3)
HighTempRadSys(Item)%ZonePtr = FindIteminList(cAlphaArgs(3),Zone%Name,NumOfZones)
IF (HighTempRadSys(Item)%ZonePtr == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
HighTempRadSys(Item)%MaxPowerCapac = rNumericArgs(1)
IF (SameString(cAlphaArgs(4),cNaturalGas)) THEN
HighTempRadSys(Item)%HeaterType = Gas
ELSE IF (SameString(cAlphaArgs(4),cElectricity)) THEN
HighTempRadSys(Item)%HeaterType = Electric
ELSE IF (SameString(cAlphaArgs(4),cGas)) THEN
HighTempRadSys(Item)%HeaterType = Gas
ELSE IF (SameString(cAlphaArgs(4),cElectric)) THEN
HighTempRadSys(Item)%HeaterType = Electric
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
IF (HighTempRadSys(Item)%HeaterType == Gas) THEN
HighTempRadSys(Item)%CombustionEffic = rNumericArgs(2)
! Limit the combustion efficiency to between zero and one...
IF (HighTempRadSys(Item)%CombustionEffic < MinCombustionEffic) THEN
HighTempRadSys(Item)%CombustionEffic = MinCombustionEffic
CALL ShowWarningError(TRIM(cNumericFieldNames(2))//' was less than the allowable minimum, reset to minimum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%CombustionEffic > MaxCombustionEffic) THEN
HighTempRadSys(Item)%CombustionEffic = MaxCombustionEffic
CALL ShowWarningError(TRIM(cNumericFieldNames(2))//' was greater than the allowable maximum, reset to maximum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
ELSE
HighTempRadSys(Item)%CombustionEffic = MaxCombustionEffic ! No inefficiency in the heater
END IF
HighTempRadSys(Item)%FracRadiant = rNumericArgs(3)
IF (HighTempRadSys(Item)%FracRadiant < MinFraction) THEN
HighTempRadSys(Item)%FracRadiant = MinFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(3))//' was less than the allowable minimum, reset to minimum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%FracRadiant > MaxFraction) THEN
HighTempRadSys(Item)%FracRadiant = MaxFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(3))//' was greater than the allowable maximum, reset to maximum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
HighTempRadSys(Item)%FracLatent = rNumericArgs(4)
IF (HighTempRadSys(Item)%FracLatent < MinFraction) THEN
HighTempRadSys(Item)%FracLatent = MinFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(4))//' was less than the allowable minimum, reset to minimum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%FracLatent > MaxFraction) THEN
HighTempRadSys(Item)%FracLatent = MaxFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(4))//' was greater than the allowable maximum, reset to maximum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
HighTempRadSys(Item)%FracLost = rNumericArgs(5)
IF (HighTempRadSys(Item)%FracLost < MinFraction) THEN
HighTempRadSys(Item)%FracLost = MinFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(5))//' was less than the allowable minimum, reset to minimum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%FracLost > MaxFraction) THEN
HighTempRadSys(Item)%FracLost = MaxFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(5))//' was greater than the allowable maximum, reset to maximum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
! Based on the input for fractions radiant, latent, and lost, determine the fraction convective (remaining fraction)
AllFracsSummed = HighTempRadSys(Item)%FracRadiant + HighTempRadSys(Item)%FracLatent + HighTempRadSys(Item)%FracLost
IF (AllFracsSummed > MaxFraction) THEN
CALL ShowSevereError('Fractions radiant, latent, and lost sum up to greater than 1 for'//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
HighTempRadSys(Item)%FracConvect = 0.0d0
ELSE
HighTempRadSys(Item)%FracConvect = 1.0d0 - AllFracsSummed
END IF
! Process the temperature control type
IF (SameString(cAlphaArgs(5),cMATControl)) THEN
HighTempRadSys(Item)%ControlType = MATControl
ELSE IF (SameString(cAlphaArgs(5),cMRTControl)) THEN
HighTempRadSys(Item)%ControlType = MRTControl
ELSE IF (SameString(cAlphaArgs(5),cOperativeControl)) THEN
HighTempRadSys(Item)%ControlType = OperativeControl
ELSE IF (SameString(cAlphaArgs(5),cMATSPControl)) THEN
HighTempRadSys(Item)%ControlType = MATSPControl
ELSE IF (SameString(cAlphaArgs(5),cMRTSPControl)) THEN
HighTempRadSys(Item)%ControlType = MRTSPControl
ELSE IF (SameString(cAlphaArgs(5),cOperativeSPControl)) THEN
HighTempRadSys(Item)%ControlType = OperativeSPControl
ELSE
CALL ShowWarningError('Invalid '//TRIM(cAlphaFieldNames(5))//' = '//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Control reset to OPERATIVE control for this '//TRIM(cCurrentModuleObject))
HighTempRadSys(Item)%ControlType = OperativeControl
END IF
HighTempRadSys(Item)%ThrottlRange = rNumericArgs(6)
IF (HighTempRadSys(Item)%ThrottlRange < MinThrottlingRange) THEN
HighTempRadSys(Item)%ThrottlRange = 1.0d0
CALL ShowWarningError(TRIM(cNumericFieldNames(6))//' is below the minimum allowed.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Thus, the throttling range value has been reset to 1.0')
END IF
HighTempRadSys(Item)%SetptSched = cAlphaArgs(6)
HighTempRadSys(Item)%SetptSchedPtr = GetScheduleIndex(cAlphaArgs(6))
IF ((HighTempRadSys(Item)%SetptSchedPtr == 0).AND.(.NOT. lAlphaFieldBlanks(6))) THEN
CALL ShowSevereError(TRIM(cAlphaFieldNames(6))//' not found: '//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
HighTempRadSys(Item)%FracDistribPerson = rNumericArgs(7)
IF (HighTempRadSys(Item)%FracDistribPerson < MinFraction) THEN
HighTempRadSys(Item)%FracDistribPerson = MinFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(7))//' was less than the allowable minimum, reset to minimum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%FracDistribPerson > MaxFraction) THEN
HighTempRadSys(Item)%FracDistribPerson = MaxFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(7))//' was greater than the allowable maximum, reset to maximum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
HighTempRadSys(Item)%TotSurfToDistrib = NumNumbers - 7
! IF (HighTempRadSys(Item)%TotSurfToDistrib > MaxDistribSurfaces) THEN
! CALL ShowSevereError('Trying to distribute radiant energy to too many surfaces for heater '//TRIM(cAlphaArgs(1)))
! CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
! ErrorsFound=.true.
! END IF
ALLOCATE(HighTempRadSys(Item)%SurfaceName(HighTempRadSys(Item)%TotSurfToDistrib))
ALLOCATE(HighTempRadSys(Item)%SurfacePtr(HighTempRadSys(Item)%TotSurfToDistrib))
ALLOCATE(HighTempRadSys(Item)%FracDistribToSurf(HighTempRadSys(Item)%TotSurfToDistrib))
AllFracsSummed = HighTempRadSys(Item)%FracDistribPerson
DO SurfNum = 1, HighTempRadSys(Item)%TotSurfToDistrib
HighTempRadSys(Item)%SurfaceName(SurfNum) = cAlphaArgs(SurfNum+6)
HighTempRadSys(Item)%SurfacePtr(SurfNum) = FindIteminList(cAlphaArgs(SurfNum+6),Surface%Name,TotSurfaces)
HighTempRadSys(Item)%FracDistribToSurf(SurfNum) = rNumericArgs(SurfNum+7)
! Error trap for surfaces that do not exist or surfaces not in the zone the radiant heater is in
IF (HighTempRadSys(Item)%SurfacePtr(SurfNum) == 0) THEN
CALL ShowSevereError(RoutineName//'Invalid Surface name = '//TRIM(HighTempRadSys(Item)%SurfaceName(SurfNum)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ELSE IF (Surface(HighTempRadSys(Item)%SurfacePtr(SurfNum))%Zone /= HighTempRadSys(Item)%ZonePtr) THEN
CALL ShowWarningError('Surface referenced in ZoneHVAC:HighTemperatureRadiant not in same zone as Radiant System,'// &
'surface='//TRIM(HighTempRadSys(Item)%SurfaceName(SurfNum)))
CALL ShowContinueError('Surface is in Zone='//TRIM(Zone(Surface(HighTempRadSys(Item)%SurfacePtr(SurfNum))%Zone)%Name)// &
' ZoneHVAC:HighTemperatureRadiant in Zone='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
! Error trap for fractions that are out of range
IF (HighTempRadSys(Item)%FracDistribToSurf(SurfNum) < MinFraction) THEN
HighTempRadSys(Item)%FracDistribToSurf(SurfNum) = MinFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(SurfNum+7))//' was less than the allowable minimum, reset to minimum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%FracDistribToSurf(SurfNum) > MaxFraction) THEN
HighTempRadSys(Item)%FracDistribToSurf(SurfNum) = MaxFraction
CALL ShowWarningError(TRIM(cNumericFieldNames(SurfNum+7))// &
' was greater than the allowable maximum, reset to maximum value.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
IF (HighTempRadSys(Item)%SurfacePtr(SurfNum) /= 0) THEN
Surface( HighTempRadSys(Item)%SurfacePtr(SurfNum) )%IntConvSurfGetsRadiantHeat = .TRUE.
ENDIF
AllFracsSummed = AllFracsSummed + HighTempRadSys(Item)%FracDistribToSurf(SurfNum)
END DO ! ...end of DO loop through surfaces that the heater radiates to.
! Error trap if the fractions add up to greater than 1.0
IF (AllFracsSummed > (MaxFraction + 0.01d0) ) THEN
CALL ShowSevereError('Fraction of radiation distributed to surfaces sums up to greater than 1 for '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END IF
IF (AllFracsSummed < (MaxFraction - 0.01d0) ) THEN ! User didn't distribute all of the radiation warn that some will be lost
CALL ShowWarningError('Fraction of radiation distributed to surfaces sums up to less than 1 for '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('As a result, some of the radiant energy delivered by the high temp radiant heater will be lost.')
CALL ShowContinueError('Occurs for '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)))
END IF
END DO ! ...end of DO loop through all of the high temperature radiant heaters
! Set up the output variables for high temperature radiant heaters
DO Item = 1, NumOfHighTempRadSys
CALL SetupOutputVariable('Zone Radiant HVAC Heating Rate [W]', &
HighTempRadSys(Item)%HeatPower,'System','Average', &
HighTempRadSys(Item)%Name)
CALL SetupOutputVariable('Zone Radiant HVAC Heating Energy [J]', &
HighTempRadSys(Item)%HeatEnergy,'System','Sum', &
HighTempRadSys(Item)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATINGCOILS',GroupKey='System')
IF (HighTempRadSys(Item)%HeaterType == Gas) THEN
CALL SetupOutputVariable('Zone Radiant HVAC Gas Rate [W]', &
HighTempRadSys(Item)%GasPower,'System','Average', &
HighTempRadSys(Item)%Name)
CALL SetupOutputVariable('Zone Radiant HVAC Gas Energy [J]', &
HighTempRadSys(Item)%GasEnergy,'System','Sum', &
HighTempRadSys(Item)%Name, &
ResourceTypeKey='Gas',EndUseKey='Heating',GroupKey='System')
ELSE IF (HighTempRadSys(Item)%HeaterType == Electric) THEN
CALL SetupOutputVariable('Zone Radiant HVAC Electric Power [W]', &
HighTempRadSys(Item)%ElecPower,'System','Average', &
HighTempRadSys(Item)%Name)
CALL SetupOutputVariable('Zone Radiant HVAC Electric Energy [J]', &
HighTempRadSys(Item)%ElecEnergy,'System','Sum', &
HighTempRadSys(Item)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Heating',GroupKey='System')
END IF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Preceding condition(s) cause termination.')
END IF
RETURN
END SUBROUTINE GetHighTempRadiantSystem