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 ManageTransformers()
! SUBROUTINE INFORMATION:
! AUTHOR Weimin Wang
! DATE WRITTEN June 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! manage transformer models
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TimeStepSys
USE DataGlobals , ONLY: TimeStepZone, SecInHour, MetersHaveBeenInitialized
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataHeatBalance, ONLY: ZnAirRpt
USE InputProcessor, ONLY: SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64),PARAMETER :: AmbTempRef=20.0d0 !reference ambient temperature (C)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TransfNum !transformer number counter
INTEGER :: MeterNum !counter for the meters wired to a transformer
INTEGER :: MeterPtr !pointer to the meters wired to a transformer
INTEGER :: LCNum !counter for the load centers served by a transformer
INTEGER :: ZoneNum !pointer to the zone where transformer is located
REAL(r64), external :: GetInstantMeterValue
REAL(r64), external :: GetCurrentMeterValue
REAL(r64) :: FactorTempCorr !temperature correction factor
REAL(r64) :: ResRef !winding resistance at reference temperature (full load)
REAL(r64) :: ResSpecified !winding resistance at specified temperature (specified load)
REAL(r64) :: ResRatio !ratio of winding resistance = ResSpecified/ResRef
REAL(r64) :: TempChange !winding temperature rise (C)
REAL(r64) :: AmbTemp !ambient temperature (C)
REAL(r64) :: Capacity !transformer nameplate capacity(VA)
REAL(r64) :: PUL !per unit load
REAL(r64) :: SurplusPower !surplus power for an electric load center
REAL(r64) :: ElecLoad !transformer load which may be power in or out depending on the usage mode
REAL(r64) :: PastElecLoad !transformer load at the previous timestep
REAL(r64) :: TotalLossRate !the sum of no load loss rate and load loss rate
REAL(r64) :: Numerator !intermediate variable for numerator
REAL(r64) :: Denominator !intermediate variable for denominator
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE.
IF(NumTransformers <= 0) RETURN
IF(MyOneTimeFlag) THEN
! calculate rated no load losses and rated load losses if the performance input method is based on
! nominal efficiency. This calculation is done only once
DO TransfNum = 1, NumTransformers
IF(Transformer(TransfNum)%PerformanceInputMode == EfficiencyMethod) THEN
ResRef = Transformer(TransfNum)%FactorTempCoeff + Transformer(TransfNum)%TempRise + AmbTempRef
ResSpecified = Transformer(TransfNum)%FactorTempCoeff + Transformer(TransfNum)%RatedTemp
ResRatio = ResSpecified/ResRef
FactorTempCorr = (1.0D0-Transformer(TransfNum)%EddyFrac) * ResRatio + &
Transformer(TransfNum)%EddyFrac * (1.0D0/ResRatio)
Capacity = Transformer(TransfNum)%RatedCapacity
Numerator = Capacity * Transformer(TransfNum)%RatedPUL * (1.0D0-Transformer(TransfNum)%RatedEfficiency)
Denominator = Transformer(TransfNum)%RatedEfficiency * (1.0D0 + &
(Transformer(TransfNum)%RatedPUL / Transformer(TransfNum)%MaxPUL)**2)
Transformer(TransfNum)%RatedNL = Numerator / Denominator
Transformer(TransfNum)%RatedLL = Transformer(TransfNum)%RatedNL / &
(FactorTempCorr * (Transformer(TransfNum)%MaxPUL)**2 )
ENDIF
END DO
MyOneTimeFlag = .FALSE.
ENDIF
DO TransfNum = 1, NumTransformers
ElecLoad = 0.0D0
PastElecLoad = 0.0D0
IF(Transformer(TransfNum)%UsageMode == PowerInFromGrid) THEN
DO MeterNum = 1, SIZE(Transformer(TransfNum)%WiredMeterNames)
IF(MetersHaveBeenInitialized) THEN
MeterPtr = Transformer(TransfNum)%WiredMeterPtrs(MeterNum)
ElecLoad = ElecLoad + GetInstantMeterValue(MeterPtr,1)/ (TimeStepZone * SecInHour) &
+ GetInstantMeterValue(MeterPtr,2)/ (TimeStepSys * SecInHour)
! PastElecLoad store the metered value in the previous time step. This value will be used to check whether
! a transformer is overloaded or not.
PastElecLoad = PastElecLoad + GetCurrentMeterValue(MeterPtr)/ (TimeStepZone * SecInHour)
ELSE
ElecLoad =0.0D0
PastElecLoad = 0.0D0
ENDIF
! Because transformer loss has been accounted for by Electricity:Facility and Electricity:HVAC, the transformer
! loss needs to be deducted from the metered value. Otherwise, double counting (circular relationship) occurs.
IF(Transformer(TransfNum)%SpecialMeter(MeterNum) ) THEN
ElecLoad = ElecLoad - Transformer(TransfNum)%LoadLossRate - Transformer(TransfNum)%NoLoadLossRate
IF (ElecLoad < 0) ElecLoad = 0.0d0 !Essential check.
END IF
END DO
Transformer(TransfNum)%PowerOut = ElecLoad !the metered value is transformer's output in PowerInFromGrid mode
ELSE !Usage mode is PowerOutFromBldg
DO LCNum = 1, Transformer(TransfNum)%LoadCenterNum
SurplusPower = ElecLoadCenter(LCNum)%ElectProdRate - ElecLoadCenter(LCNum)%ElectDemand
IF(SurplusPower < 0) SurplusPower = 0.0d0
ElecLoad = ElecLoad + SurplusPower
PastElecLoad = ElecLoad
END DO
Transformer(TransfNum)%PowerIn = ElecLoad !surplus power is transformer's input in PowerOutFromBldg mode
END IF
! check availability schedule
IF (GetCurrentScheduleValue(Transformer(TransfNum)%AvailSchedPtr) > 0.0d0) THEN
Capacity = Transformer(TransfNum)%RatedCapacity
PUL = ElecLoad / Capacity
IF (PUL > 1.0D0) THEN
PUL = 1.0D0
END IF
!Originally, PUL was used to check whether a transformer is overloaded (PUL > 1.0 or not). However, it was
!found that ElecLoad obtained from GetInstantMeterVlaue() might refer to intermideiate values before
!convergence. The intermediate values may issue false warning. This the reason why PastElecLoad obtained
!by GetCurrentMeterValue() is used here to check overload issue.
IF( (PastElecLoad/Capacity) > 1.0d0) THEN
IF(Transformer(TransfNum)%OverloadErrorIndex == 0) THEN
CALL ShowSevereError('Transformer Overloaded' )
CALL ShowContinueError('Entered in ElectricLoadCenter:Transformer ='//TRIM(Transformer(TransfNum)%Name) )
END IF
CALL ShowRecurringSevereErrorAtEnd('Transformer Overloaded: ' // &
'Entered in ElectricLoadCenter:Transformer ='//TRIM(Transformer(TransfNum)%Name), &
Transformer(TransfNum)%OverloadErrorIndex)
END IF
TempChange = (PUL ** 1.6d0) * Transformer(TransfNum)%TempRise
IF(Transformer(TransfNum)%HeatLossesDestination == ZoneGains) THEN
ZoneNum = Transformer(TransfNum)%ZoneNum
AmbTemp = ZnAirRpt(ZoneNum)%MeanAirTemp
ELSE
AmbTemp = 20.0D0
ENDIF
ResRef = Transformer(TransfNum)%FactorTempCoeff + Transformer(TransfNum)%TempRise + AmbTempRef
ResSpecified = Transformer(TransfNum)%FactorTempCoeff + TempChange + AmbTemp
ResRatio = ResSpecified/ResRef
FactorTempCorr = (1.0D0-Transformer(TransfNum)%EddyFrac) * ResRatio + &
Transformer(TransfNum)%EddyFrac * (1.0D0/ResRatio)
Transformer(TransfNum)%LoadLossRate = Transformer(TransfNum)%RatedLL * (PUL **2) * FactorTempCorr
Transformer(TransfNum)%NoLoadLossRate = Transformer(TransfNum)%RatedNL
ELSE !Transformer is not available.
Transformer(TransfNum)%LoadLossRate = 0.0D0
Transformer(TransfNum)%NoLoadLossRate = 0.0D0
ENDIF
TotalLossRate = Transformer(TransfNum)%LoadLossRate + Transformer(TransfNum)%NoLoadLossRate
IF(Transformer(TransfNum)%UsageMode == PowerInFromGrid) THEN
Transformer(TransfNum)%PowerIn = ElecLoad + TotalLossRate
!Transformer losses are wired to the meter via the variable "%ElecUseUtility" only if transformer losses
!are considered in utility cost. If transformer losses are not considered in utility cost, 0 is assigned
!to the variable "%ElecUseUtility".
IF(Transformer(TransfNum)%ConsiderLosses) THEN
Transformer(TransfNum)%ElecUseUtility = TotalLossRate * TimeStepSys * SecInHour
ELSE
Transformer(TransfNum)%ElecUseUtility = 0.0D0
ENDIF
!Transformer has two modes.If it works in one mode, the variable for meter output in the other mode
!is assigned 0
Transformer(TransfNum)%ElecProducedCoGen = 0.0D0
ELSE !Usage mode is PowerOutFromBldg
Transformer(TransfNum)%PowerOut = ElecLoad - TotalLossRate
IF(Transformer(TransfNum)%PowerOut < 0) Transformer(TransfNum)%PowerOut = 0.0D0
Transformer(TransfNum)%ElecProducedCoGen = -1.0D0 * TotalLossRate * TimeStepSys * SecInHour
!Transformer has two modes.If it works in one mode, the variable for meter output in the other mode
!is assigned 0
Transformer(TransfNum)%ElecUseUtility = 0.0D0
ENDIF
IF( Transformer(TransfNum)%PowerIn <= 0) THEN
Transformer(TransfNum)%Efficiency = 0.0D0
ELSE
Transformer(TransfNum)%Efficiency = Transformer(TransfNum)%PowerOut / Transformer(TransfNum)%PowerIn
ENDIF
Transformer(TransfNum)%NoLoadLossEnergy = Transformer(TransfNum)%NoLoadLossRate * TimeStepSys * SecInHour
Transformer(TransfNum)%LoadLossEnergy = Transformer(TransfNum)%LoadLossRate * TimeStepSys * SecInHour
Transformer(TransfNum)%EnergyIn = Transformer(TransfNum)%PowerIn * TimeStepSys * SecInHour
Transformer(TransfNum)%EnergyOut = Transformer(TransfNum)%PowerOut * TimeStepSys * SecInHour
! Thermal loss rate may not be equal to Total loss rate. This is the case when surplus power is less than the
! calculated total loss rate for a cogeneration transformer. That is why "PowerIn - PowerOut" is used below.
Transformer(TransfNum)%ThermalLossRate = Transformer(TransfNum)%PowerIn - Transformer(TransfNum)%PowerOut
Transformer(TransfNum)%ThermalLossEnergy = TotalLossRate * TimeStepSys * SecInHour
IF (Transformer(TransfNum)%ZoneNum > 0) THEN ! set values for zone heat gains
Transformer(TransfNum)%QdotconvZone = (1.0D0 - Transformer(TransfNum)%ZoneRadFrac)* Transformer(TransfNum)%ThermalLossRate
Transformer(TransfNum)%QdotRadZone = (Transformer(TransfNum)%ZoneRadFrac) * Transformer(TransfNum)%ThermalLossRate
ENDIF
END DO ! End TransfNum Loop
END SUBROUTINE ManageTransformers