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