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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | TESCoilNum |
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 InitTESCoil(TESCoilNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN <date_written>
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant, ONLY: TypeOf_PackagedTESCoolingCoil, PlantLoop, ScanPlantLoopsForObject
USE General, ONLY: RoundSigDigits
USE ScheduleManager, ONLY: GetCurrentScheduleValue
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: TESCoilNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MyFlag ! One time environment flag
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MySizeFlag ! One time sizing flag
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MyEnvrnFlag ! flag for init once at start of environment
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MyWarmupFlag ! flag for init after warmup complete
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE. ! One time flag used to allocate MyEnvrnFlag and MySizeFlag
LOGICAL :: errFlag
INTEGER :: plloopnum
INTEGER :: lsnum
INTEGER :: brnum
INTEGER :: cpnum
REAL(r64) :: tmpSchedValue
IF (MyOneTimeFlag) THEN
! initialize the environment and sizing flags
ALLOCATE(MyFlag(NumTESCoils))
ALLOCATE(MySizeFlag(NumTESCoils))
ALLOCATE(MyEnvrnFlag(NumTESCoils))
ALLOCATE(MyWarmupFlag(NumTESCoils))
MyFlag = .TRUE.
MySizeFlag = .TRUE.
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .FALSE.
MyWarmupFlag = .FALSE.
END IF
IF (MyFlag(TESCoilNum)) THEN
IF (TESCoil(TESCoilNum)%TESPlantConnectionAvailable) THEN
errFlag = .FALSE.
CALL ScanPlantLoopsForObject(TESCoil(TESCoilNum)%Name, &
TypeOf_PackagedTESCoolingCoil, &
plloopnum, &
lsnum, &
brnum, &
cpnum)
! double check node names match
IF (errFlag) THEN
CALL ShowFatalError('InitTESCoil: Program terminated due to previous condition(s).')
ENDIF
TESCoil(TESCoilNum)%TESPlantLoopNum = plloopnum
TESCoil(TESCoilNum)%TESPlantLoopSideNum = lsnum
TESCoil(TESCoilNum)%TESPlantBranchNum = brnum
TESCoil(TESCoilNum)%TESPlantCompNum = cpnum
IF ((PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumIn /= &
TESCoil(TESCoilNum)%TESPlantInletNodeNum ) .OR. &
(PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumOut /= &
TESCoil(TESCoilNum)%TESPlantOutletNodeNum) ) THEN
CALL ShowSevereError('InitTESCoil: Coil:Cooling:DX:SingleSpeed:ThermalStorage ="'// &
TRIM(TESCoil(TESCoilNum)%Name)//'", non-matching plant nodes.')
CALL ShowContinueError('...in Branch="'//TRIM(PlantLoop(TESCoil(TESCoilNum)%TESPlantLoopNum)% &
LoopSide(TESCoil(TESCoilNum)%TESPlantLoopSideNum)% &
Branch(TESCoil(TESCoilNum)%TESPlantBranchNum)%Name)// &
'", Component referenced with:')
CALL ShowContinueError('...Inlet Node="'// &
TRIM(NodeID(PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumIn)))
CALL ShowContinueError('...Outlet Node="'// &
TRIM(NodeID(PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumOut)))
CALL ShowContinueError('...TES Inlet Node="'//TRIM(NodeID(TESCoil(TESCoilNum)%TESPlantInletNodeNum)))
CALL ShowContinueError('...TES Outlet Node="'//TRIM(NodeID(TESCoil(TESCoilNum)%TESPlantOutletNodeNum)))
errflag=.true.
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('InitTESCoil: Program terminated due to previous condition(s).')
ENDIF
ENDIF ! any plant connection to TES
MyFlag(TESCoilNum) = .FALSE.
ENDIF
IF (MySizeFlag(TESCoilNum)) THEN
CALL SizeTESCoil(TESCoilNum)
MySizeFlag(TESCoilNum) = .FALSE.
ENDIF
IF (BeginEnvrnFlag .AND. MyEnvrnFlag(TESCoilNum)) THEN
TESCoil(TESCoilNum)%CurControlMode = OffMode
TESCoil(TESCoilNum)%QdotPlant = 0.d0
TESCoil(TESCoilNum)%Q_Plant = 0.d0
TESCoil(TESCoilNum)%QdotAmbient = 0.d0
TESCoil(TESCoilNum)%Q_Ambient = 0.d0
TESCoil(TESCoilNum)%QdotTES = 0.d0
TESCoil(TESCoilNum)%Q_TES = 0.d0
TESCoil(TESCoilNum)%TimeElapsed = 0.d0
TESCoil(TESCoilNum)%IceFracRemain = 0.d0
TESCoil(TESCoilNum)%IceFracRemainLastTimestep = 0.d0
TESCoil(TESCoilNum)%FluidTankTempFinal = TESCoil(TESCoilNum)%RatedFluidTankTemp
TESCoil(TESCoilNum)%FluidTankTempFinalLastTimestep = TESCoil(TESCoilNum)%RatedFluidTankTemp
TESCoil(TESCoilNum)%ElecCoolingPower = 0.d0 ! electric power for cooling [W]
TESCoil(TESCoilNum)%ElecCoolingEnergy = 0.d0 ! electric energy for cooling [J], metered
TESCoil(TESCoilNum)%EvapTotCoolingRate = 0.d0 ! evaporator coil total cooling rate [W]
TESCoil(TESCoilNum)%EvapTotCoolingEnergy = 0.d0 ! evaporatory coil total cooling energy [J], metered
TESCoil(TESCoilNum)%EvapSensCoolingRate = 0.d0
TESCoil(TESCoilNum)%EvapSensCoolingEnergy = 0.d0
TESCoil(TESCoilNum)%EvapLatCoolingRate = 0.d0
TESCoil(TESCoilNum)%EvapLatCoolingEnergy = 0.d0
TESCoil(TESCoilNum)%RuntimeFraction = 0.d0
TESCoil(TESCoilNum)%ElectColdWeatherPower = 0.d0 ! electric power for cold weather protection [W]
TESCoil(TESCoilNum)%ElectColdWeatherEnergy = 0.d0 ! electric energy for cold weather protection [J], metered
TESCoil(TESCoilNum)%ElectEvapCondBasinHeaterPower = 0.d0
TESCoil(TESCoilNum)%ElectEvapCondBasinHeaterEnergy = 0.d0
MyEnvrnFlag(TESCoilNum) = .FALSE.
ENDIF
IF (.NOT. BeginEnvrnFlag) MyEnvrnFlag(TESCoilNum) = .TRUE.
IF ( MyWarmupFlag(TESCoilNum) .and. (.not. WarmUpFlag)) THEN
!reset to initial condition once warm up is over.
TESCoil(TESCoilNum)%IceFracRemain = 0.d0
TESCoil(TESCoilNum)%IceFracRemainLastTimestep = 0.d0
TESCoil(TESCoilNum)%FluidTankTempFinal = TESCoil(TESCoilNum)%RatedFluidTankTemp
TESCoil(TESCoilNum)%FluidTankTempFinalLastTimestep = TESCoil(TESCoilNum)%RatedFluidTankTemp
MyWarmupFlag(TESCoilNum) = .FALSE.
ENDIF
IF (WarmUpFlag ) MyWarmupFlag(TESCoilNum) = .TRUE.
! determine control mode
IF (GetCurrentScheduleValue(TESCoil(TESCoilNum)%AvailSchedNum) /= 0.d0) THEN
IF (TESCoil(TESCoilNum)%ModeControlType == ScheduledOpModes) THEN
tmpSchedValue = GetCurrentScheduleValue(TESCoil(TESCoilNum)%ControlModeSchedNum)
TESCoil(TESCoilNum)%CurControlMode = INT(tmpSchedValue)
! check if value is valid
SELECT CASE (TESCoil(TESCoilNum)%CurControlMode)
CASE (OffMode, CoolingOnlyMode, CoolingAndChargeMode, CoolingAndDischargeMode, ChargeOnlyMode, DischargeOnlyMode)
! do nothing, these are okay
CASE DEFAULT
TESCoil(TESCoilNum)%CurControlMode = OffMode
IF (TESCoil(TESCoilNum)%ControlModeErrorIndex == 0) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control schedule value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from schedule =' &
//TRIM(RoundSigDigits(tmpSchedValue, 8)) )
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('InitTESCoil: Invalid control schedule value for TES operating mode, set to Off', &
TESCoil(TESCoilNum)%ControlModeErrorIndex, &
ReportMaxOf = tmpSchedValue, &
ReportMinOf = tmpSchedValue)
END SELECT
ELSEIF (TESCoil(TESCoilNum)%ModeControlType == EMSActuatedOpModes) THEN
IF (TESCoil(TESCoilNum)%EMSControlModeOn) THEN
TESCoil(TESCoilNum)%CurControlMode = FLOOR(TESCoil(TESCoilNum)%EMSControlModeValue)
! check if value is valid
SELECT CASE (TESCoil(TESCoilNum)%CurControlMode)
CASE ( OffMode )
CASE ( CoolingOnlyMode )
IF (.NOT. ( TESCoil(TESCoilNum)%CoolingOnlyModeIsAvailable)) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from EMS indicates Cooling Only Mode but that mode is not available.')
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
CASE ( CoolingAndChargeMode )
IF (.NOT. ( TESCoil(TESCoilNum)%CoolingAndChargeModeAvailable)) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from EMS indicates Cooling And Charge Mode but that mode is not available.')
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
CASE ( CoolingAndDischargeMode )
IF (.NOT. ( TESCoil(TESCoilNum)%CoolingAndDischargeModeAvailable)) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from EMS indicates Cooling And Discharge Mode but that mode is not available.')
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
CASE ( ChargeOnlyMode )
IF (.NOT. ( TESCoil(TESCoilNum)%ChargeOnlyModeAvailable)) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from EMS indicates Charge Only Mode but that mode is not available.')
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
CASE ( DischargeOnlyMode)
IF (.NOT. ( TESCoil(TESCoilNum)%DischargeOnlyModeAvailable)) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from EMS indicates Discharge Only Mode but that mode is not available.' )
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
CASE DEFAULT
TESCoil(TESCoilNum)%CurControlMode = OffMode
IF (TESCoil(TESCoilNum)%ControlModeErrorIndex == 0) THEN
CALL ShowSevereMessage('InitTESCoil: Invalid control value for operating mode')
CALL ShowContinueError('Occurs for Coil:Cooling:DX:SingleSpeed:ThermalStorage name = ' &
//TRIM(TESCoil(TESCoilNum)%Name) )
CALL ShowContinueError('Value returned from EMS =' &
//TRIM(RoundSigDigits(TESCoil(TESCoilNum)%EMSControlModeValue, 8)) )
CALL ShowContinueError('Operating mode will be set to Off, and the simulation continues')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('InitTESCoil: Invalid control schedule value for TES operating mode, set to Off', &
TESCoil(TESCoilNum)%ControlModeErrorIndex, &
ReportMaxOf = TESCoil(TESCoilNum)%EMSControlModeValue, &
ReportMinOf = TESCoil(TESCoilNum)%EMSControlModeValue)
END SELECT
ELSE
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
ENDIF
ELSE
TESCoil(TESCoilNum)%CurControlMode = OffMode
ENDIF
TESCoil(TESCoilNum)%QdotPlant = 0.d0 ! heat exchange rate for plant connection to TES tank [W]
TESCoil(TESCoilNum)%Q_Plant = 0.d0 ! heat exchange energy for plant connection to TES tank [J]
TESCoil(TESCoilNum)%QdotAmbient = 0.d0 ! heat exchange rate for skin losses/gains for TES tank to surroundings [W]
TESCoil(TESCoilNum)%Q_Ambient = 0.d0 ! heat exchange enegy for skin losses/gains for TES tank to surroundings [J]
TESCoil(TESCoilNum)%QdotTES = 0.d0 ! heat exchange rate by mechanical systems to charge or discharge TES [W]
TESCoil(TESCoilNum)%Q_TES = 0.d0 ! heat exchange energy by mechanical systems to charge or discharge TES [J]
! dynamic calculated data
TESCoil(TESCoilNum)%ElecCoolingPower = 0.d0 ! electric power for cooling [W]
TESCoil(TESCoilNum)%ElecCoolingEnergy = 0.d0 ! electric energy for cooling [J], metered
TESCoil(TESCoilNum)%EvapTotCoolingRate = 0.d0 ! evaporator coil total cooling rate [W]
TESCoil(TESCoilNum)%EvapTotCoolingEnergy = 0.d0 ! evaporatory coil total cooling energy [J], metered
TESCoil(TESCoilNum)%EvapSensCoolingRate = 0.d0
TESCoil(TESCoilNum)%EvapSensCoolingEnergy = 0.d0
TESCoil(TESCoilNum)%EvapLatCoolingRate = 0.d0
TESCoil(TESCoilNum)%EvapLatCoolingEnergy = 0.d0
TESCoil(TESCoilNum)%RuntimeFraction = 0.d0
TESCoil(TESCoilNum)%CondenserRuntimeFraction = 0.d0 !
TESCoil(TESCoilNum)%ElectColdWeatherPower = 0.d0 ! electric power for cold weather protection [W]
TESCoil(TESCoilNum)%ElectColdWeatherEnergy = 0.d0 ! electric energy for cold weather protection [J], metered
TESCoil(TESCoilNum)%ElectEvapCondBasinHeaterPower = 0.d0
TESCoil(TESCoilNum)%ElectEvapCondBasinHeaterEnergy = 0.d0
RETURN
END SUBROUTINE InitTESCoil