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 SimDetailedIceStorage
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN February 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is the main simulation subroutine for the detailed
! ice storage model.
! METHODOLOGY EMPLOYED:
! Based on whether the unit is dormant, in charging mode, or in discharging
! mode, the code either passes the flow through the bypass, through the tank,
! or both. This depends on the temperature relative to the setpoint temperature
! and other features of the model. The model itself is a LMTD model that uses
! performance curve fits that are quadratic in fraction charged/discharged and
! linear in LMTD for the calculation of Q. The equations are actually non-
! dimensionalized.
! REFERENCES:
! Ice Storage Component Model Proposal (Revised).doc by Rick Strand (Dec 2005/Jan 2006)
! USE STATEMENTS:
USE CurveManager, ONLY : CurveValue
USE ScheduleManager, ONLY : GetCurrentScheduleValue
USE FluidProperties, ONLY : GetSpecificHeatGlycol
USE DataPlant, ONLY : PlantLoop, CommonPipe_TwoWay, SingleSetpoint, DualSetpointDeadband
USE PlantUtilities, ONLY : SetComponentFlowRate
USE DataBranchAirLoopPlant, ONLY : MassFlowTolerance
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIterNum = 100 ! Maximum number of internal iterations for ice storage solution
REAL(r64), PARAMETER :: SmallestLoad = 0.1d0 ! Smallest load to actually run the ice storage unit [Watts]
REAL(r64), PARAMETER :: TankDischargeToler = 0.001d0 ! Below this fraction, there is nothing left to discharge
REAL(r64), PARAMETER :: TankChargeToler = 0.999d0 ! Above this fraction, we don't have anything left to charge
REAL(r64), PARAMETER :: TemperatureToler = 0.1d0 ! Temperature difference between iterations that indicates convergence [C]
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: ActualLoad ! Actual load on the ice storage unit [W]
REAL(r64) :: AvgFracCharged ! Average fraction charged for the current time step
REAL(r64) :: ChargeFrac ! Fraction of tank to be charged in the current time step
INTEGER :: IterNum ! Iteration number
REAL(r64) :: LMTDstar ! Non-dimensional log mean temperature difference of ice storage unit [non-dimensional]
REAL(r64) :: LocalLoad ! Estimated load on the ice storage unit [W]
INTEGER :: NodeNumIn ! Plant loop inlet node number for component
INTEGER :: NodeNumOut ! Plant loop outlet node number for component
REAL(r64) :: Qstar ! Current load on the ice storage unit [non-dimensional]
REAL(r64) :: TempIn ! Inlet temperature to component (from plant loop) [C]
REAL(r64) :: TempSetPt ! Setpoint temperature defined by loop controls [C]
REAL(r64) :: ToutNew ! Updated outlet temperature from the tank [C]
REAL(r64) :: ToutOld ! Tank outlet temperature from the last iteration [C]
REAL(r64) :: Cp ! local plant fluid specific heat
REAL(r64) :: mdot ! local mass flow rate for plant connection
! FLOW:
! Set local variables
NodeNumIn = DetIceStor(IceNum)%PlantInNodeNum
NodeNumOut = DetIceStor(IceNum)%PlantOutNodeNum
TempIn = Node(NodeNumIn)%Temp
SELECT CASE (PlantLoop(DetIceStor(IceNum)%PlantLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
TempSetPt = Node(NodeNumOut)%TempSetPoint
CASE (DualSetPointDeadBand)
TempSetPt = Node(NodeNumOut)%TempSetPointHi
END SELECT
IterNum = 0
! Set derived type variables
DetIceStor(IceNum)%InletTemp = TempIn
DetIceStor(IceNum)%MassFlowRate = Node(NodeNumIn)%MassFlowRate
!if two-way common pipe and no mass flow and tank is not full, then use design flow rate
IF ((PlantLoop(DetIceStor(IceNum)%PlantLoopNum)%CommonPipeType == CommonPipe_TwoWay) .AND. &
(ABS(DetIceStor(IceNum)%MassFlowRate) < MassFlowTolerance) .AND. &
(DetIceStor(IceNum)%IceFracRemaining < TankChargeToler) ) THEN
DetIceStor(IceNum)%MassFlowRate = DetIceStor(IceNum)%DesignMassFlowRate
ENDIF
! Calculate the current load on the ice storage unit
Cp = GetSpecificHeatGlycol(PlantLoop(DetIceStor(IceNum)%PlantLoopNum)%FluidName, &
TempIn, &
PlantLoop(DetIceStor(IceNum)%PlantLoopNum)%FluidIndex, &
'SimDetailedIceStorage')
LocalLoad = DetIceStor(IceNum)%MassFlowRate * Cp * (TempIn - TempSetPt)
! Determine what the status is regarding the ice storage unit and the loop level flow
IF ( (ABS(LocalLoad) <= SmallestLoad) .OR. (GetCurrentScheduleValue(DetIceStor(IceNum)%ScheduleIndex) <= 0) ) THEN
! No real load on the ice storage device or ice storage OFF--bypass all of the flow and leave the tank alone
DetIceStor(IceNum)%CompLoad = 0.0d0
DetIceStor(IceNum)%OutletTemp = TempIn
DetIceStor(IceNum)%TankOutletTemp = TempIn
mdot = 0.d0
CALL SetComponentFlowRate(mdot, &
DetIceStor(IceNum)%PlantInNodeNum, &
DetIceStor(IceNum)%PlantOutNodeNum, &
DetIceStor(IceNum)%PlantLoopNum, &
DetIceStor(IceNum)%PlantLoopSideNum, &
DetIceStor(IceNum)%PlantBranchNum, &
DetIceStor(IceNum)%PlantCompNum)
DetIceStor(IceNum)%BypassMassFlowRate = mdot
DetIceStor(IceNum)%TankMassFlowRate = 0.0d0
DetIceStor(IceNum)%MassFlowRate = mdot
ELSEIF (LocalLoad < 0.0d0) THEN
! The load is less than zero so we should be charging
! Before we do anything, we should check to make sure that we will actually be charging the unit
IF ( (TempIn > (DetIceStor(IceNum)%FreezingTemp-DeltaTifMin)) .OR. &
(DetIceStor(IceNum)%IceFracRemaining >= TankChargeToler) ) THEN
! If the inlet temperature is not below the freezing temperature of the
! device, then we cannot actually do any charging. Bypass all of the flow.
! Also, if the tank is already sufficiently charged, we don't need to
! do any further charging. So, bypass all of the flow.
DetIceStor(IceNum)%CompLoad = 0.0d0
DetIceStor(IceNum)%OutletTemp = TempIn
DetIceStor(IceNum)%TankOutletTemp = TempIn
mdot = 0.d0
CALL SetComponentFlowRate(mdot, &
DetIceStor(IceNum)%PlantInNodeNum, &
DetIceStor(IceNum)%PlantOutNodeNum, &
DetIceStor(IceNum)%PlantLoopNum, &
DetIceStor(IceNum)%PlantLoopSideNum, &
DetIceStor(IceNum)%PlantBranchNum, &
DetIceStor(IceNum)%PlantCompNum)
DetIceStor(IceNum)%BypassMassFlowRate = mdot
DetIceStor(IceNum)%TankMassFlowRate = 0.0d0
DetIceStor(IceNum)%MassFlowRate = mdot
ELSE
!make flow request so tank will get flow
mdot = DetIceStor(IceNum)%DesignMassFlowRate
CALL SetComponentFlowRate(mdot, &
DetIceStor(IceNum)%PlantInNodeNum, &
DetIceStor(IceNum)%PlantOutNodeNum, &
DetIceStor(IceNum)%PlantLoopNum, &
DetIceStor(IceNum)%PlantLoopSideNum, &
DetIceStor(IceNum)%PlantBranchNum, &
DetIceStor(IceNum)%PlantCompNum)
! We are in charging mode, the temperatures are low enough to charge
! the tank, and we have some charging left to do.
! Make first guess at Qstar based on the current ice fraction remaining
! and LMTDstar that is based on the freezing or TempSetPt temperature.
IF (TempSetPt > (DetIceStor(IceNum)%FreezingTemp-DeltaTofMin)) THEN
! Outlet temperature cannot be above the freezing temperature so set
! the outlet temperature to the freezing temperature and calculate
! LMTDstar based on that assumption.
TempSetPt = DetIceStor(IceNum)%FreezingTemp-DeltaTofMin
END IF
ToutOld = TempSetPt
LMTDstar = CalcDetIceStorLMTDstar(TempIn,ToutOld,DetIceStor(IceNum)%FreezingTemp)
! Find initial guess at average fraction charged during time step
ChargeFrac = LocalLoad * TimeStepSys / DetIceStor(IceNum)%NomCapacity
IF ((DetIceStor(IceNum)%IceFracRemaining+ChargeFrac) > 1.0d0) THEN
ChargeFrac = 1.0d0 - DetIceStor(IceNum)%IceFracRemaining
END IF
IF (DetIceStor(IceNum)%ThawProcessIndex == DetIceInsideMelt) THEN
AvgFracCharged = DetIceStor(IceNum)%IceFracOnCoil + (ChargeFrac/2.0d0)
ELSE ! (DetIceStor(IceNum)%ThawProcessIndex == DetIceOutsideMelt)
AvgFracCharged = DetIceStor(IceNum)%IceFracRemaining + (ChargeFrac/2.0d0)
END IF
Qstar = ABS(CurveValue(DetIceStor(IceNum)%ChargeCurveNum,AvgFracCharged,LMTDstar))
ActualLoad = Qstar * DetIceStor(IceNum)%NomCapacity / DetIceStor(IceNum)%CurveFitTimeStep
ToutNew = TempIn + (ActualLoad/(DetIceStor(IceNum)%MassFlowRate * Cp ))
! Again, the outlet temperature cannot be above the freezing temperature (factoring in the tolerance)
IF (ToutNew > (DetIceStor(IceNum)%FreezingTemp-DeltaTofMin)) ToutNew = DetIceStor(IceNum)%FreezingTemp-DeltaTofMin
IF (ActualLoad > ABS(LocalLoad)) THEN
! We have more than enough capacity to meet the load so no need to iterate to find a solution
DetIceStor(IceNum)%OutletTemp = TempSetPt
DetIceStor(IceNum)%TankOutletTemp = ToutNew
DetIceStor(IceNum)%CompLoad = DetIceStor(IceNum)%MassFlowRate * Cp * ABS(TempIn - TempSetPt)
DetIceStor(IceNum)%TankMassFlowRate = DetIceStor(IceNum)%CompLoad / Cp / ABS(TempIn - ToutNew)
DetIceStor(IceNum)%BypassMassFlowRate = DetIceStor(IceNum)%MassFlowRate - DetIceStor(IceNum)%TankMassFlowRate
ELSE
DO WHILE (IterNum < MaxIterNum)
IF (ABS(ToutOld-ToutNew) > TemperatureToler) THEN
! Not converged yet so recalculated what is needed and keep iterating
! Calculate new values for LMTDstar and Qstar based on updated outlet temperature
ToutOld = ToutNew
LMTDstar = CalcDetIceStorLMTDstar(TempIn,ToutOld,DetIceStor(IceNum)%FreezingTemp)
Qstar = ABS(CurveValue(DetIceStor(IceNum)%ChargeCurveNum,AvgFracCharged,LMTDstar))
! Now make sure that we don't go above 100% charged and calculate the new average fraction
ChargeFrac = Qstar * (TimeStepSys/DetIceStor(IceNum)%CurveFitTimeStep)
IF ((DetIceStor(IceNum)%IceFracRemaining+ChargeFrac) > 1.0d0) THEN
ChargeFrac = 1.0d0 - DetIceStor(IceNum)%IceFracRemaining
Qstar = ChargeFrac
END IF
IF (DetIceStor(IceNum)%ThawProcessIndex == DetIceInsideMelt) THEN
AvgFracCharged = DetIceStor(IceNum)%IceFracOnCoil + (ChargeFrac/2.0d0)
ELSE ! (DetIceStor(IceNum)%ThawProcessIndex == DetIceOutsideMelt)
AvgFracCharged = DetIceStor(IceNum)%IceFracRemaining + (ChargeFrac/2.0d0)
END IF
! Finally, update the actual load and calculate the new outlet temperature; increment iteration counter
ActualLoad = Qstar * DetIceStor(IceNum)%NomCapacity / DetIceStor(IceNum)%CurveFitTimeStep
ToutNew = TempIn + (ActualLoad/(DetIceStor(IceNum)%MassFlowRate * Cp ))
! Again, the outlet temperature cannot be above the freezing temperature (factoring in the tolerance)
IF (ToutNew < (DetIceStor(IceNum)%FreezingTemp-DeltaTofMin)) ToutNew = DetIceStor(IceNum)%FreezingTemp-DeltaTofMin
IterNum = IterNum + 1
ELSE
! Converged to acceptable tolerance so set output variables and exit DO WHILE loop
EXIT
END IF
END DO ! ...loop iterating for the ice storage outlet temperature
! Keep track of times that the iterations got excessive and report if necessary
IF (IterNum >= MaxIterNum) THEN
DetIceStor(IceNum)%ChargeIterErrors = DetIceStor(IceNum)%ChargeIterErrors + 1
IF (DetIceStor(IceNum)%ChargeIterErrors <= 25) THEN
CALL ShowWarningError('Detailed Ice Storage model exceeded its internal charging maximum iteration limit')
CALL ShowContinueError('Detailed Ice Storage System Name = '//TRIM(DetIceStor(IceNum)%Name))
CALL ShowContinueErrorTimeStamp(' ')
ELSE
CALL ShowRecurringWarningErrorAtEnd('Detailed Ice Storage system ['//TRIM(DetIceStor(IceNum)%Name)// &
'] charging maximum iteration limit exceeded occurrence continues.', &
DetIceStor(IceNum)%ChargeErrorCount)
END IF
END IF
! Set the values for the key outlet parameters
! Note that in REAL(r64)ity the tank will probably bypass some flow when it
! gets close to full charge. This is a simplification that assumes
! all flow through the tank during charging and a lower delta T near
! the full charge level. From an energy perspective, this is a reasonable
! approximation.
DetIceStor(IceNum)%OutletTemp = ToutNew
DetIceStor(IceNum)%TankOutletTemp = ToutNew
DetIceStor(IceNum)%BypassMassFlowRate = 0.0d0
DetIceStor(IceNum)%TankMassFlowRate = DetIceStor(IceNum)%MassFlowRate
DetIceStor(IceNum)%CompLoad = DetIceStor(IceNum)%MassFlowRate * Cp * ABS(TempIn - ToutNew)
END IF
END IF
ELSEIF (LocalLoad > 0.0d0) THEN
! The load is greater than zero so we should be discharging
! Before we do anything, we should check to make sure that we will actually be discharging the unit
IF ( (DetIceStor(IceNum)%InletTemp < (DetIceStor(IceNum)%FreezingTemp+DeltaTifMin)) .OR. &
(DetIceStor(IceNum)%IceFracRemaining <= TankDischargeToler) ) THEN
! If the inlet temperature is below the freezing temperature of the
! device, then we cannot actually do any discharging. Bypass all of the flow.
! Also, if the tank is already discharged, we can't to do any further
! discharging. So, bypass all of the flow.
DetIceStor(IceNum)%CompLoad = 0.0d0
DetIceStor(IceNum)%OutletTemp = DetIceStor(IceNum)%InletTemp
DetIceStor(IceNum)%TankOutletTemp = DetIceStor(IceNum)%InletTemp
mdot = 0.d0
CALL SetComponentFlowRate(mdot, &
DetIceStor(IceNum)%PlantInNodeNum, &
DetIceStor(IceNum)%PlantOutNodeNum, &
DetIceStor(IceNum)%PlantLoopNum, &
DetIceStor(IceNum)%PlantLoopSideNum, &
DetIceStor(IceNum)%PlantBranchNum, &
DetIceStor(IceNum)%PlantCompNum)
DetIceStor(IceNum)%BypassMassFlowRate = mdot
DetIceStor(IceNum)%TankMassFlowRate = 0.0d0
DetIceStor(IceNum)%MassFlowRate = mdot
ELSE
!make flow request so tank will get flow
mdot = DetIceStor(IceNum)%DesignMassFlowRate
CALL SetComponentFlowRate(mdot, &
DetIceStor(IceNum)%PlantInNodeNum, &
DetIceStor(IceNum)%PlantOutNodeNum, &
DetIceStor(IceNum)%PlantLoopNum, &
DetIceStor(IceNum)%PlantLoopSideNum, &
DetIceStor(IceNum)%PlantBranchNum, &
DetIceStor(IceNum)%PlantCompNum)
! We are in discharging mode, the temperatures are high enough to discharge
! the tank, and we have some discharging left to do.
IF (TempSetPt < (DetIceStor(IceNum)%FreezingTemp+DeltaTofMin)) THEN
! Outlet temperature cannot be below the freezing temperature so set
! the outlet temperature to the freezing temperature and calculate
! LMTDstar based on that assumption.
TempSetPt = DetIceStor(IceNum)%FreezingTemp+DeltaTofMin
END IF
ToutOld = TempSetPt
LMTDstar = CalcDetIceStorLMTDstar(TempIn,ToutOld,DetIceStor(IceNum)%FreezingTemp)
! Find initial guess at average fraction charged during time step
ChargeFrac = LocalLoad * TimeStepSys / DetIceStor(IceNum)%NomCapacity
IF ((DetIceStor(IceNum)%IceFracRemaining-ChargeFrac) < 0.0d0) ChargeFrac = DetIceStor(IceNum)%IceFracRemaining
AvgFracCharged = DetIceStor(IceNum)%IceFracRemaining - (ChargeFrac/2.0d0)
Qstar = ABS(CurveValue(DetIceStor(IceNum)%DischargeCurveNum,(1.0d0-AvgFracCharged),LMTDstar))
ActualLoad = Qstar * DetIceStor(IceNum)%NomCapacity / DetIceStor(IceNum)%CurveFitTimeStep
ToutNew = TempIn - (ActualLoad/(DetIceStor(IceNum)%MassFlowRate * Cp ))
! Again, the outlet temperature cannot be below the freezing temperature (factoring in the tolerance)
IF (ToutNew < (DetIceStor(IceNum)%FreezingTemp+DeltaTofMin)) ToutNew = DetIceStor(IceNum)%FreezingTemp+DeltaTofMin
IF (ActualLoad > LocalLoad) THEN
! We have more than enough storage to meet the load so no need to iterate to find a solution
DetIceStor(IceNum)%OutletTemp = TempSetPt
DetIceStor(IceNum)%TankOutletTemp = ToutNew
DetIceStor(IceNum)%CompLoad = DetIceStor(IceNum)%MassFlowRate * Cp * ABS(TempIn - TempSetPt)
DetIceStor(IceNum)%TankMassFlowRate = DetIceStor(IceNum)%CompLoad / Cp / ABS(TempIn - ToutNew)
DetIceStor(IceNum)%BypassMassFlowRate = DetIceStor(IceNum)%MassFlowRate - DetIceStor(IceNum)%TankMassFlowRate
ELSE
DO WHILE (IterNum < MaxIterNum)
IF (ABS(ToutOld-ToutNew) > TemperatureToler) THEN
! Not converged yet so recalculated what is needed and keep iterating
! Calculate new values for LMTDstar and Qstar based on updated outlet temperature
ToutOld = ToutNew
LMTDstar = CalcDetIceStorLMTDstar(TempIn,ToutOld,DetIceStor(IceNum)%FreezingTemp)
Qstar = ABS(CurveValue(DetIceStor(IceNum)%DischargeCurveNum,(1.0d0-AvgFracCharged),LMTDstar))
! Now make sure that we don't go below 100% discharged and calculate the new average fraction
ChargeFrac = Qstar * (TimeStepSys/DetIceStor(IceNum)%CurveFitTimeStep)
IF ((DetIceStor(IceNum)%IceFracRemaining-ChargeFrac) < 0.0d0) THEN
ChargeFrac = DetIceStor(IceNum)%IceFracRemaining
Qstar = ChargeFrac
END IF
AvgFracCharged = DetIceStor(IceNum)%IceFracRemaining - (ChargeFrac/2.0d0)
! Finally, update the actual load and calculate the new outlet temperature; increment iteration counter
ActualLoad = Qstar * DetIceStor(IceNum)%NomCapacity / DetIceStor(IceNum)%CurveFitTimeStep
ToutNew = TempIn - (ActualLoad/(DetIceStor(IceNum)%MassFlowRate * Cp))
! Again, the outlet temperature cannot be below the freezing temperature (factoring in the tolerance)
IF (ToutNew < (DetIceStor(IceNum)%FreezingTemp+DeltaTofMin)) ToutNew = DetIceStor(IceNum)%FreezingTemp+DeltaTofMin
IterNum = IterNum + 1
ELSE
! Converged to acceptable tolerance so set output variables and exit DO WHILE loop
EXIT
END IF
END DO ! ...loop iterating for the ice storage outlet temperature
! Keep track of times that the iterations got excessive
IF (IterNum >= MaxIterNum) THEN
DetIceStor(IceNum)%DischargeIterErrors = DetIceStor(IceNum)%DischargeIterErrors + 1
IF (DetIceStor(IceNum)%DischargeIterErrors <= 25) THEN
CALL ShowWarningError('Detailed Ice Storage model exceeded its internal discharging maximum iteration limit')
CALL ShowContinueError('Detailed Ice Storage System Name = '//TRIM(DetIceStor(IceNum)%Name))
CALL ShowContinueErrorTimeStamp(' ')
ELSE
CALL ShowRecurringWarningErrorAtEnd('Detailed Ice Storage system ['//TRIM(DetIceStor(IceNum)%Name)// &
'] discharging maximum iteration limit exceeded occurrence continues.', &
DetIceStor(IceNum)%DischargeErrorCount)
END IF
END IF
! We are now done finding the outlet temperature of the tank. We need
! to compare the outlet temperature to the setpoint temperature again
! to see where we are at and then we can set the values for the key
! outlet parameters. If outlet temperature is greater than or equal
! to the setpoint temperature, then send all flow through the tank.
! Otherwise, we have more capacity than needed so let's bypass some
! flow and meet the setpoint temperautre.
IF (ToutNew >= TempSetPt) THEN
DetIceStor(IceNum)%OutletTemp = ToutNew
DetIceStor(IceNum)%TankOutletTemp = ToutNew
DetIceStor(IceNum)%BypassMassFlowRate = 0.0d0
DetIceStor(IceNum)%TankMassFlowRate = DetIceStor(IceNum)%MassFlowRate
DetIceStor(IceNum)%CompLoad = DetIceStor(IceNum)%MassFlowRate * Cp * ABS(TempIn - ToutNew)
ELSE
DetIceStor(IceNum)%OutletTemp = TempSetPt
DetIceStor(IceNum)%TankOutletTemp = ToutNew
DetIceStor(IceNum)%CompLoad = DetIceStor(IceNum)%MassFlowRate * Cp * ABS(TempIn - TempSetPt)
DetIceStor(IceNum)%TankMassFlowRate = DetIceStor(IceNum)%CompLoad/(Cp * ABS(TempIn - ToutNew))
DetIceStor(IceNum)%BypassMassFlowRate = DetIceStor(IceNum)%MassFlowRate - DetIceStor(IceNum)%TankMassFlowRate
END IF
END IF
END IF
ELSE ! Shouldn't get here ever (print error if we do)
CALL ShowFatalError('Detailed Ice Storage systemic code error--contact EnergyPlus support')
END IF
RETURN
END SUBROUTINE SimDetailedIceStorage