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, | intent(in) | :: | TowerNum | |||
real(kind=r64), | intent(inout) | :: | MyLoad |
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 CalcMerkelVariableSpeedTower(TowerNum, MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR B.Griffith
! DATE WRITTEN August 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate varialble speed tower model using Merkel's theory with UA adjustments developed by Scheier
! METHODOLOGY EMPLOYED:
! Find a fan speed that operates the tower to meet MyLoad
! REFERENCES:
! na
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE DataPlant, ONLY : SingleSetpoint, DualSetpointDeadband
USE DataBranchAirLoopPlant, ONLY : MassFlowTolerance
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: TowerNum
REAL(r64), INTENT(INOUT) :: MyLoad
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: DesignWetBlub = 25.56d0 ! tower outdoor air entering wetblub for design [C]
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations for solver
REAL(r64), PARAMETER :: Acc = 1.d-3 ! Accuracy of solver result
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), DIMENSION(8) :: Par ! Parameter array passed to solver
INTEGER :: SolFla ! Flag of solver
REAL(r64) :: CpWater
INTEGER :: LoopNum
INTEGER :: LoopSideNum
REAL(r64) :: TempSetpoint
REAL(r64) :: WaterMassFlowRatePerCellMin
REAL(r64) :: WaterMassFlowRatePerCellMax
INTEGER :: NumCellMin
INTEGER :: NumCellMax
INTEGER :: NumCellOn
REAL(r64) :: WaterMassFlowRatePerCell
REAL(r64) :: UAdesignPerCell
REAL(r64) :: AirFlowRatePerCell
REAL(r64) :: OutletWaterTempOff
REAL(r64) :: FreeConvQdot
REAL(r64) :: WaterFlowRateRatio
REAL(r64) :: UAwetbulbAdjFac
REAL(r64) :: UAairFlowAdjFac
REAL(r64) :: UAWaterFlowAdjFac
REAL(r64) :: UAadjustedPerCell
REAL(r64) :: FullSpeedFanQdot
LOGICAL :: IncrNumCellFlag
REAL(r64) :: MinSpeedFanQdot
REAL(r64) :: FanPowerAdjustFac
WaterInletNode = SimpleTower(TowerNum)%WaterInletNodeNum
CpWater = GetSpecificHeatGlycol(PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidName, &
Node(WaterInletNode)%Temp, &
PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidIndex, &
'CalcMerkelVariableSpeedTower')
WaterOutletNode = SimpleTower(TowerNum)%WaterOutletNodeNum
Qactual = 0.0d0
CTFanPower = 0.0d0
OutletWaterTemp = Node(WaterInletNode)%Temp
LoopNum = SimpleTower(TowerNum)%LoopNum
LoopSideNum = SimpleTower(TowerNum)%LoopSideNum
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
IF (SimpleTower(TowerNum)%SetpointIsOnOutlet) THEN
TempSetPoint = Node(WaterOutletNode)%TempSetpoint
ELSE
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpoint
ENDIF
CASE (DualSetPointDeadBand)
IF (SimpleTower(TowerNum)%SetpointIsOnOutlet) THEN
TempSetPoint = Node(WaterOutletNode)%TempSetpointHi
ELSE
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpointHi
ENDIF
END SELECT
! Added for multi-cell. Determine the number of cells operating
IF (SimpleTower(TowerNum)%DesWaterMassFlowRate > 0.0D0) THEN
WaterMassFlowRatePerCellMin = SimpleTower(TowerNum)%DesWaterMassFlowRate * &
SimpleTower(TowerNum)%MinFracFlowRate / SimpleTower(TowerNum)%NumCell
WaterMassFlowRatePerCellMax = SimpleTower(TowerNum)%DesWaterMassFlowRate * &
SimpleTower(TowerNum)%MaxFracFlowRate / SimpleTower(TowerNum)%NumCell
!round it up to the nearest integer
NumCellMin = MIN(INT((WaterMassFlowRate / WaterMassFlowRatePerCellMax)+.9999d0),SimpleTower(TowerNum)%NumCell)
NumCellMax = MIN(INT((WaterMassFlowRate / WaterMassFlowRatePerCellMin)+.9999d0),SimpleTower(TowerNum)%NumCell)
ENDIF
! cap min at 1
IF(NumCellMin <= 0)NumCellMin = 1
IF(NumCellMax <= 0)NumCellMax = 1
IF(SimpleTower(TowerNum)%CellCtrl_Num == CellCtrl_MinCell)THEN
NumCellON = NumCellMin
ELSE
NumCellON = NumCellMax
END IF
SimpleTower(TowerNum)%NumCellON = NumCellON
WaterMassFlowRatePerCell = WaterMassFlowRate / NumCellON
! MassFlowTolerance is a parameter to indicate a no flow condition
IF(WaterMassFlowRate.LE.MassFlowTolerance .OR. (MyLoad > SmallLoad)) THEN
! for multiple cells, we assume that it's a common bassin
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
RETURN
ENDIF
! first find free convection cooling rate
UAdesignPerCell = SimpleTower(TowerNum)%FreeConvTowerUA / SimpleTower(TowerNum)%NumCell
AirFlowRatePerCell = SimpleTower(TowerNum)%FreeConvAirFlowRate / SimpleTower(TowerNum)%NumCell
OutletWaterTempOFF = Node(WaterInletNode)%Temp
WaterMassFlowRate = Node(WaterInletNode)%MassFlowRate
Call SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRatePerCell,UAdesignPerCell,OutletWaterTempOFF)
FreeConvQdot = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTempOFF)
CTFanPower = 0.0d0
IF (ABS(MyLoad) <= FreeConvQdot) THEN ! can meet load with free convection and fan off
OutletWaterTemp = OutletWaterTempOFF
AirFlowRateRatio = 0.d0
Qactual = FreeConvQdot
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
RETURN
ENDIF
! next find full fan speed cooling rate
UAdesignPerCell = SimpleTower(TowerNum)%HighSpeedTowerUA / SimpleTower(TowerNum)%NumCell
AirFlowRatePerCell = SimpleTower(TowerNum)%HighSpeedAirFlowRate / SimpleTower(TowerNum)%NumCell
AirFlowRateRatio = 1.d0
WaterFlowRateRatio = WaterMassFlowRatePerCell / SimpleTower(TowerNum)%DesWaterMassFlowRatePerCell
UAwetbulbAdjFac = CurveValue(SimpleTower(TowerNum)%UAModFuncWetbulbDiffCurvePtr, &
(DesignWetBlub - SimpleTowerInlet(TowerNum)%AirWetBulb))
UAairflowAdjFac = CurveValue(SimpleTower(TowerNum)%UAModFuncAirFlowRatioCurvePtr, AirFlowRateRatio)
UAwaterflowAdjFac = CurveValue(SimpleTower(TowerNum)%UAModFuncWaterFlowRatioCurvePtr, WaterFlowRateRatio)
UAadjustedPerCell = UAdesignPerCell*UAwetbulbAdjFac*UAairflowAdjFac*UAwaterflowAdjFac
CALL SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRatePerCell,UAadjustedPerCell, OutletWaterTemp)
FullSpeedFanQdot = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
IF (FullSpeedFanQdot <= ABS(MyLoad)) THEN ! full speed is what we want.
IF ((FullSpeedFanQdot+ SmallLoad) < ABS(MyLoad) .and. (NumCellON < SimpleTower(TowerNum)%NumCell) &
.AND. ((WaterMassFlowRate/(NumCellON+1)) .ge. WaterMassFlowRatePerCellMin)) THEN
! If full fan and not meeting setpoint, then increase number of cells until all are used or load is satisfied
IncrNumCellFlag = .TRUE. ! set value to true to enter in the loop
DO WHILE (IncrNumCellFlag)
NumCellON = NumCellON + 1
SimpleTower(TowerNum)%NumCellON = NumCellON
WaterMassFlowRatePerCell = WaterMassFlowRate / NumCellON
WaterFlowRateRatio = WaterMassFlowRatePerCell / SimpleTower(TowerNum)%DesWaterMassFlowRatePerCell
UAwaterflowAdjFac = CurveValue(SimpleTower(TowerNum)%UAModFuncWaterFlowRatioCurvePtr, WaterFlowRateRatio)
UAadjustedPerCell = UAdesignPerCell*UAwetbulbAdjFac*UAairflowAdjFac*UAwaterflowAdjFac
CALL SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRatePerCell,UAadjustedPerCell, OutletWaterTemp)
IF ((FullSpeedFanQdot+ SmallLoad) < ABS(MyLoad) .and. (NumCellON < SimpleTower(TowerNum)%NumCell) &
.AND. ((WaterMassFlowRate/(NumCellON+1)) .ge. WaterMassFlowRatePerCellMin)) THEN
IncrNumCellFlag = .TRUE.
ELSE
IncrNumCellFlag = .FALSE.
ENDIF
ENDDO
FullSpeedFanQdot = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
ENDIF
Qactual = FullSpeedFanQdot
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
! now calculate fan power
FanPowerAdjustFac = CurveValue(SimpleTower(TowerNum)%FanPowerfAirFlowCurve, AirFlowRateRatio)
CTFanPower = SimpleTower(TowerNum)%HighSpeedFanPower * FanPowerAdjustFac * NumCellON / &
SimpleTower(TowerNum)%NumCell
RETURN
ENDIF
! next find minimum air flow ratio cooling rate
AirFlowRateRatio = SimpleTower(TowerNum)%MinimumVSAirFlowFrac
AirFlowRatePerCell =AirFlowRateRatio * SimpleTower(TowerNum)%HighSpeedAirFlowRate / SimpleTower(TowerNum)%NumCell
UAairflowAdjFac = CurveValue(SimpleTower(TowerNum)%UAModFuncAirFlowRatioCurvePtr, AirFlowRateRatio)
UAadjustedPerCell = UAdesignPerCell*UAwetbulbAdjFac*UAairflowAdjFac*UAwaterflowAdjFac
CALL SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRatePerCell,UAadjustedPerCell, OutletWaterTemp)
MinSpeedFanQdot = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
IF (ABS(MyLoad) <= MinSpeedFanQdot) THEN ! min fan speed already exceeds load)
Qactual = MinSpeedFanQdot
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
! now calculate fan power
FanPowerAdjustFac = CurveValue(SimpleTower(TowerNum)%FanPowerfAirFlowCurve, AirFlowRateRatio)
CTFanPower = SimpleTower(TowerNum)%HighSpeedFanPower * FanPowerAdjustFac * NumCellON / &
SimpleTower(TowerNum)%NumCell
RETURN
ENDIF
IF ((MinSpeedFanQdot < ABS(MyLoad)) .AND. (ABS(MyLoad) < FullSpeedFanQdot)) THEN
! load can be refined by modulationg fan speed, call regulafalsi
Par(1) = REAL(TowerNum, r64)
Par(2) = MyLoad
Par(3) = WaterMassFlowRatePerCell
Par(4) = UAdesignPerCell
Par(5) = UAwetbulbAdjFac
Par(6) = UAwaterflowAdjFac
Par(7) = CpWater
Par(8) = WaterMassFlowRate
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, AirFlowRateRatio, VSMerkelResidual, &
SimpleTower(TowerNum)%MinimumVSAirFlowFrac, 1.0d0, Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF (SimpleTower(TowerNum)%VSMerkelAFRErrorIter < 1) THEN
SimpleTower(TowerNum)%VSMerkelAFRErrorIter = SimpleTower(TowerNum)%VSMerkelAFRErrorIter +1
CALL ShowWarningError(TRIM(cCoolingTower_VariableSpeedMerkel)// &
' - Iteration limit exceeded calculating variable speed fan ratio for unit = ' &
//TRIM(SimpleTower(TowerNum)%Name ) )
CALL ShowContinueError('Estimated air flow ratio = '// &
RoundSigDigits((ABS(MyLoad) - MinSpeedFanQdot)/(FullSpeedFanQdot - MinSpeedFanQdot ), 4 ) )
CALL ShowContinueError('Calculated air flow ratio = '//roundSigDigits(AirFlowRateRatio, 4) )
CALL ShowContinueErrorTimeStamp('The calculated air flow ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCoolingTower_VariableSpeedMerkel)//' "' &
//TRIM(SimpleTower(TowerNum)%Name )//'" - Iteration limit exceeded calculating air flow ratio error continues.' &
//' air flow ratio statistics follow.', &
SimpleTower(TowerNum)%VSMerkelAFRErrorIter, AirFlowRateRatio, AirFlowRateRatio)
ENDIF
ELSE IF (SolFla == -2) THEN
AirFlowRateRatio = (ABS(MyLoad) - MinSpeedFanQdot)/(FullSpeedFanQdot - MinSpeedFanQdot )
IF(.NOT. WarmupFlag)THEN
IF ( SimpleTower(TowerNum)%VSMerkelAFRErrorFail < 1) THEN
SimpleTower(TowerNum)%VSMerkelAFRErrorFail = SimpleTower(TowerNum)%VSMerkelAFRErrorFail +1
CALL ShowWarningError(TRIM(cCoolingTower_VariableSpeedMerkel)// &
' - solver failed calculating variable speed fan ratio for unit = ' &
//TRIM(SimpleTower(TowerNum)%Name ) )
CALL ShowContinueError('Estimated air flow ratio = '// RoundSigDigits(AirFlowRateRatio, 4 ) )
CALL ShowContinueErrorTimeStamp('The estimated air flow ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCoolingTower_VariableSpeedMerkel)//' "' &
//TRIM(SimpleTower(TowerNum)%Name )//'" - solver failed calculating air flow ratio error continues.' &
//' air flow ratio statistics follow.', &
SimpleTower(TowerNum)%VSMerkelAFRErrorFail, AirFlowRateRatio, AirFlowRateRatio)
ENDIF
ENDIF
! now rerun to get peformance with AirFlowRateRatio
AirFlowRatePerCell = AirFlowRateRatio * SimpleTower(TowerNum)%HighSpeedAirFlowRate / SimpleTower(TowerNum)%NumCell
UAairflowAdjFac = CurveValue(SimpleTower(TowerNum)%UAModFuncAirFlowRatioCurvePtr, AirFlowRateRatio)
UAadjustedPerCell = UAdesignPerCell*UAwetbulbAdjFac*UAairflowAdjFac*UAwaterflowAdjFac
CALL SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRatePerCell,UAadjustedPerCell, OutletWaterTemp)
Qactual = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
! now calculate fan power
FanPowerAdjustFac = CurveValue(SimpleTower(TowerNum)%FanPowerfAirFlowCurve, AirFlowRateRatio)
CTFanPower = SimpleTower(TowerNum)%HighSpeedFanPower * FanPowerAdjustFac * NumCellON / &
SimpleTower(TowerNum)%NumCell
ENDIF
RETURN
END SUBROUTINE CalcMerkelVariableSpeedTower