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 GetIceStorageInput
! SUBROUTINE INFORMATION:
! AUTHOR:
! DATE WRITTEN:
! PURPOSE OF THIS SUBROUTINE:!This routine will get the input
!required by the PrimaryPlantLoopManager. As such
!it will interact with the Input Scanner to retrieve
!information from the input file, count the number of
!heating and cooling loops and begin to fill the
!arrays associated with the type PlantLoopProps.
! METHODOLOGY EMPLOYED: to be determined...
! REFERENCES:
! USE STATEMENTS:
USE DataInterfaces, ONLY : ShowSevereError, ShowWarningError, ShowFatalError, SetupOutputVariable, ShowContinueError
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE ScheduleManager
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IceNum
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL :: ErrorsFound
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
! FLOW:
ErrorsFound = .FALSE. ! Always need to reset this since there are multiple types of ice storage systems
!LOAD ARRAYS WITH IceStorage DATA
NumIceStorages = GetNumObjectsFound(cIceStorageSimple) ! by ZG
NumDetIceStorages = GetNumObjectsFound(cIceStorageDetailed)
ALLOCATE (IceStorageTypeMap(NumIceStorages+NumDetIceStorages))
ALLOCATE(CheckEquipName(NumIceStorages+NumDetIceStorages))
CheckEquipName=.true.
! Allocate IceStorage based on NumOfIceStorage
ALLOCATE (IceStorage(NumIceStorages))
ALLOCATE (IceStorageReport(NumIceStorages))
cCurrentModuleObject = cIceStorageSimple
DO IceNum = 1 , NumIceStorages
CALL GetObjectItem(cCurrentModuleObject,IceNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT, &
NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),IceStorage%Name,IceNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
TotalIceStorages=TotalIceStorages+1
IceStorageTypeMap(TotalIceStorages)%StorageType=cCurrentModuleObject
IceStorageTypeMap(TotalIceStorages)%StorageType_Num=IceStorageType_Simple
IceStorageTypeMap(TotalIceStorages)%Name=cAlphaArgs(1)
IceStorageTypeMap(TotalIceStorages)%LocalEqNum=IceNum
IceStorage(IceNum)%MapNum = TotalIceStorages
! ITS name
IceStorage(IceNum)%Name = cAlphaArgs(1)
! Get Ice Thermal Storage Type
IceStorage(IceNum)%ITSType = cAlphaArgs(2)
IF (SameString(IceStorage(IceNum)%ITSType,'IceOnCoilInternal')) THEN
IceStorage(IceNum)%ITSType_Num=ITSType_IceOnCoilInternal
ELSEIF (SameString(IceStorage(IceNum)%ITSType,'IceOnCoilExternal')) THEN
IceStorage(IceNum)%ITSType_Num=ITSType_IceOnCoilExternal
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
ErrorsFound=.true.
ENDIF
! Get and Verify ITS nominal Capacity (user input is in GJ, internal value in in J)
IceStorage(IceNum)%ITSNomCap = rNumericArgs(1)*1.d+09
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
ErrorsFound=.true.
ENDIF
! Get Plant Inlet Node Num
IceStorage(IceNum)%PltInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
! Get Plant Outlet Node Num
IceStorage(IceNum)%PltOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
! Test InletNode and OutletNode
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Chilled Water Nodes')
! Initialize Report Variables
IceStorageReport(IceNum)%MyLoad = 0.0d0
IceStorageReport(IceNum)%U = 0.0d0
IceStorageReport(IceNum)%Urate = 0.0d0
IceStorageReport(IceNum)%IceFracRemain = 1.0d0
IceStorageReport(IceNum)%ITSCoolingRate = 0.0d0
IceStorageReport(IceNum)%ITSCoolingEnergy = 0.0d0
IceStorageReport(IceNum)%ITSChargingRate = 0.0d0
IceStorageReport(IceNum)%ITSChargingEnergy = 0.0d0
IceStorageReport(IceNum)%ITSmdot = 0.0d0
IceStorageReport(IceNum)%ITSInletTemp = 0.0d0
IceStorageReport(IceNum)%ITSOutletTemp = 0.0d0
END DO ! IceNum
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject) )
ENDIF
! Setup Output Variables to Report CurrentModuleObject='ThermalStorage:Ice:Simple'
!********************************************
DO IceNum = 1, NumIceStorages
CALL SetupOutputVariable('Ice Thermal Storage Requested Load [W]', &
IceStorageReport(IceNum)%MyLoad,'System','Average',IceStorage(IceNum)%Name)
! Ice fraction
CALL SetupOutputVariable('Ice Thermal Storage End Fraction []', &
IceStorageReport(IceNum)%IceFracRemain,'Zone','Average',IceStorage(IceNum)%Name)
! Discharge: ITS Information
CALL SetupOutputVariable('Ice Thermal Storage Mass Flow Rate [kg/s]', &
IceStorageReport(IceNum)%ITSmdot,'System','Average',IceStorage(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Inlet Temperature [C]', &
IceStorageReport(IceNum)%ITSInletTemp,'System','Average',IceStorage(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Outlet Temperature [C]', &
IceStorageReport(IceNum)%ITSOutletTemp,'System','Average',IceStorage(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Discharge Rate [W]', &
IceStorageReport(IceNum)%ITSCoolingRate,'System','Average',IceStorage(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Discharge Energy [J]', &
IceStorageReport(IceNum)%ITSCoolingEnergy,'System','Sum',IceStorage(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Charge Rate [W]', &
IceStorageReport(IceNum)%ITSChargingRate,'System','Average',IceStorage(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Charge Energy [J]', &
IceStorageReport(IceNum)%ITSChargingEnergy,'System','Sum',IceStorage(IceNum)%Name)
END DO ! IceNum
ErrorsFound = .FALSE. ! Always need to reset this since there are multiple types of ice storage systems
! Determine the number of detailed ice storage devices are in the input file and allocate appropriately
cCurrentModuleObject = cIceStorageDetailed
ALLOCATE (DetIceStor(NumDetIceStorages)) ! Allocate DetIceStorage based on NumDetIceStorages
DO IceNum = 1, NumDetIceStorages
CALL GetObjectItem(cCurrentModuleObject,IceNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),DetIceStor%Name,IceNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
END IF
TotalIceStorages=TotalIceStorages+1
IceStorageTypeMap(TotalIceStorages)%StorageType=cCurrentModuleObject
IceStorageTypeMap(TotalIceStorages)%StorageType_Num=IceStorageType_Detailed
IceStorageTypeMap(TotalIceStorages)%Name=cAlphaArgs(1)
IceStorageTypeMap(TotalIceStorages)%LocalEqNum=IceNum
DetIceStor(IceNum)%MapNum = TotalIceStorages
DetIceStor(IceNum)%Name = cAlphaArgs(1) ! Detailed ice storage name
! Get and verify availability schedule
DetIceStor(IceNum)%ScheduleName = cAlphaArgs(2) ! Detailed ice storage availability schedule name
IF (lAlphaFieldBlanks(2)) THEN
DetIceStor(IceNum)%ScheduleIndex = ScheduleAlwaysOn
ELSE
DetIceStor(IceNum)%ScheduleIndex = GetScheduleIndex(DetIceStor(IceNum)%ScheduleName)
IF (DetIceStor(IceNum)%ScheduleIndex == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END IF
END IF
! Get and Verify ITS nominal Capacity (user input is in GJ, internal value is in W-hr)
! Convert GJ to J by multiplying by 10^9
! Convert J to W-hr by dividing by number of seconds in an hour (3600)
DetIceStor(IceNum)%NomCapacity = rNumericArgs(1)*(1.d+09)/(SecInHour)
IF (rNumericArgs(1) <= 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
! Get Plant Inlet Node Num
DetIceStor(IceNum)%PlantInNodeNum = GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
! Get Plant Outlet Node Num
DetIceStor(IceNum)%PlantOutNodeNum = GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
! Test InletNode and OutletNode
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Chilled Water Nodes')
! Obtain the Charging and Discharging Curve types and names
DetIceStor(IceNum)%DischargeCurveName = cAlphaArgs(6)
DetIceStor(IceNum)%DischargeCurveNum = GetCurveIndex(cAlphaArgs(6))
IF (DetIceStor(IceNum)%DischargeCurveNum <= 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
ELSE
DetIceStor(IceNum)%DischargeCurveType = GetCurveType(DetIceStor(IceNum)%DischargeCurveNum)
END IF
IF ( (DetIceStor(IceNum)%DischargeCurveType /= cAlphaArgs(5)) .OR. &
(DetIceStor(IceNum)%DischargeCurveType /= 'QUADRATICLINEAR') ) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Discharge curve type not valid, type='//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Type does not match type for curve name or type does not equal QuadraticLinear')
ErrorsFound = .TRUE.
END IF
DetIceStor(IceNum)%ChargeCurveName = cAlphaArgs(8)
DetIceStor(IceNum)%ChargeCurveNum = GetCurveIndex(cAlphaArgs(8))
IF (DetIceStor(IceNum)%ChargeCurveNum <= 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(cAlphaArgs(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
ELSE
DetIceStor(IceNum)%ChargeCurveType = GetCurveType(DetIceStor(IceNum)%ChargeCurveNum)
END IF
IF ( (DetIceStor(IceNum)%ChargeCurveType /= cAlphaArgs(7)) .OR. &
(DetIceStor(IceNum)%ChargeCurveType /= 'QUADRATICLINEAR') ) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Charge curve type not valid, type='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Type does not match type for curve name or type does not equal QuadraticLinear')
ErrorsFound = .TRUE.
END IF
DetIceStor(IceNum)%CurveFitTimeStep = rNumericArgs(2)
IF ( (DetIceStor(IceNum)%CurveFitTimeStep <= 0.0d0) .OR. (DetIceStor(IceNum)%CurveFitTimeStep > 1.0d0) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(2))//'='//TRIM(RoundSigDigits(rNumericArgs(2),3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Curve fit time step invalid, less than zero or greater than 1 for ' &
//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END IF
DetIceStor(IceNum)%ThawProcessIndicator = cAlphaArgs(9)
IF (SameString(DetIceStor(IceNum)%ThawProcessIndicator,'INSIDEMELT')) THEN
DetIceStor(IceNum)%ThawProcessIndex = DetIceInsideMelt
ELSEIF ( (SameString(DetIceStor(IceNum)%ThawProcessIndicator,'OUTSIDEMELT')) .OR. &
(SameString(DetIceStor(IceNum)%ThawProcessIndicator,Blank)) ) THEN
DetIceStor(IceNum)%ThawProcessIndex = DetIceOutsideMelt
ELSE
CALL ShowSevereError('Invalid thaw process indicator of '//TRIM(cAlphaArgs(9))//' was entered')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Value should either be "InsideMelt" or "OutsideMelt"')
DetIceStor(IceNum)%ThawProcessIndex = DetIceInsideMelt ! Severe error will end simulation, but just in case...
ErrorsFound = .TRUE.
END IF
! Get the other ice storage parameters (electric, heat loss, freezing temperature) and stupidity check each one
DetIceStor(IceNum)%DischargeParaElecLoad = rNumericArgs(3)
DetIceStor(IceNum)%ChargeParaElecLoad = rNumericArgs(4)
DetIceStor(IceNum)%TankLossCoeff = rNumericArgs(5)
DetIceStor(IceNum)%FreezingTemp = rNumericArgs(6)
IF ( (DetIceStor(IceNum)%DischargeParaElecLoad < 0.0d0) .OR. (DetIceStor(IceNum)%DischargeParaElecLoad > 1.0d0) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(3))//'='//TRIM(RoundSigDigits(rNumericArgs(3),3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Value is either less than/equal to zero or greater than 1')
ErrorsFound = .TRUE.
END IF
IF ( (DetIceStor(IceNum)%ChargeParaElecLoad < 0.0d0) .OR. (DetIceStor(IceNum)%ChargeParaElecLoad > 1.0d0) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(4))//'='//TRIM(RoundSigDigits(rNumericArgs(4),3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Value is either less than/equal to zero or greater than 1')
ErrorsFound = .TRUE.
END IF
IF ( (DetIceStor(IceNum)%TankLossCoeff < 0.0d0) .OR. (DetIceStor(IceNum)%TankLossCoeff > 0.1d0) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(5))//'='//TRIM(RoundSigDigits(rNumericArgs(5),3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Value is either less than/equal to zero or greater than 0.1 (10%)')
ErrorsFound = .TRUE.
END IF
IF ( (DetIceStor(IceNum)%FreezingTemp < -10.0d0) .OR. (DetIceStor(IceNum)%FreezingTemp > 10.0d0) ) THEN
CALL ShowWarningError('Potentially invalid '//TRIM(cNumericFieldNames(6))//'='//TRIM(RoundSigDigits(rNumericArgs(6),3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Value is either less than -10.0C or greater than 10.0C')
CALL ShowContinueError('This value will be allowed but the user should verify that this temperature is correct')
END IF
! Initialize Report Variables
DetIceStor(IceNum)%CompLoad = 0.0d0
DetIceStor(IceNum)%IceFracChange = 0.0d0
DetIceStor(IceNum)%IceFracRemaining = 1.0d0
DetIceStor(IceNum)%IceFracOnCoil = 1.0d0
DetIceStor(IceNum)%DischargingRate = 0.0d0
DetIceStor(IceNum)%DischargingEnergy = 0.0d0
DetIceStor(IceNum)%ChargingRate = 0.0d0
DetIceStor(IceNum)%ChargingEnergy = 0.0d0
DetIceStor(IceNum)%MassFlowRate = 0.0d0
DetIceStor(IceNum)%BypassMassFlowRate = 0.0d0
DetIceStor(IceNum)%TankMassFlowRate = 0.0d0
DetIceStor(IceNum)%InletTemp = 0.0d0
DetIceStor(IceNum)%OutletTemp = 0.0d0
DetIceStor(IceNum)%TankOutletTemp = 0.0d0
DetIceStor(IceNum)%ParasiticElecRate = 0.0d0
DetIceStor(IceNum)%ParasiticElecEnergy = 0.0d0
END DO ! ...over detailed ice storage units
IF ((NumIceStorages+NumDetIceStorages) <= 0) THEN
CALL ShowSevereError('No Ice Storage Equipment found in GetIceStorage')
ErrorsFound=.true.
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
! Setup Output Variables to Report CurrentModuleObject='ThermalStorage:Ice:Detailed'
!********************************************
DO IceNum = 1, NumDetIceStorages
CALL SetupOutputVariable('Ice Thermal Storage Cooling Rate [W]', &
DetIceStor(IceNum)%CompLoad,'System','Average',DetIceStor(IceNum)%Name)
! Ice fraction
CALL SetupOutputVariable('Ice Thermal Storage Change Fraction []', &
DetIceStor(IceNum)%IceFracChange,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage End Fraction []', &
DetIceStor(IceNum)%IceFracRemaining,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage On Coil Fraction []', &
DetIceStor(IceNum)%IceFracOnCoil,'System','Average',DetIceStor(IceNum)%Name)
! Discharge: ITS Information
CALL SetupOutputVariable('Ice Thermal Storage Mass Flow Rate [kg/s]', &
DetIceStor(IceNum)%MassFlowRate,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Bypass Mass Flow Rate [kg/s]', &
DetIceStor(IceNum)%BypassMassFlowRate,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Tank Mass Flow Rate [kg/s]', &
DetIceStor(IceNum)%TankMassFlowRate,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Fluid Inlet Temperature [C]', &
DetIceStor(IceNum)%InletTemp,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Blended Outlet Temperature [C]', &
DetIceStor(IceNum)%OutletTemp,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Tank Outlet Temperature [C]', &
DetIceStor(IceNum)%TankOutletTemp,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Discharge Rate [W]', &
DetIceStor(IceNum)%DischargingRate,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Discharge Energy [J]', &
DetIceStor(IceNum)%DischargingEnergy,'System','Sum',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Charge Rate [W]', &
DetIceStor(IceNum)%ChargingRate,'System','Average',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Cooling Charge Energy [J]', &
DetIceStor(IceNum)%ChargingEnergy,'System','Sum',DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Ancillary Electric Power [W]', &
DetIceStor(IceNum)%ParasiticElecRate,'System','Average', DetIceStor(IceNum)%Name)
CALL SetupOutputVariable('Ice Thermal Storage Ancillary Electric Energy [J]', &
DetIceStor(IceNum)%ParasiticElecEnergy,'System','Sum',DetIceStor(IceNum)%Name, &
ResourceTypeKey='ELECTRICITY',GroupKey='System')
END DO ! ...over detailed ice storage units
RETURN
END SUBROUTINE GetIceStorageInput