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) | :: | CompNum | |||
real(kind=r64), | intent(in) | :: | TargetSupplySideLoopLeavingTemp | |||
integer, | intent(in) | :: | HXActionMode |
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 FindHXDemandSideLoopFlow(CompNum, TargetSupplySideLoopLeavingTemp, HXActionMode)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN November 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! modulate demand side flow rate to hit a target leaving temperature (within tolerance)
! METHODOLOGY EMPLOYED:
! uses E+'s Regula Falsi numercial method
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: WarmUpFlag
USE General, ONLY: RoundSigDigits, SolveRegulaFalsi
USE PlantUtilities, ONLY: SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CompNum
REAL(r64), INTENT(IN) :: TargetSupplySideLoopLeavingTemp
INTEGER, INTENT(IN) :: HXActionMode
! SUBROUTINE PARAMETER DEFINITIONS:
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:
INTEGER :: SolFla ! Flag of solver
REAL(r64), DIMENSION(2) :: Par ! Parameter array passed to solver
REAL(r64) :: LeavingTempMinFlow
REAL(r64) :: LeavingTempFullFlow
REAL(r64) :: SupSideMdot ! mass flow rate of fluid entering from supply side loop
REAL(r64) :: DmdSideMdot ! mass flow rate of fluid entering from demand side loop
SupSideMdot = Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%MassFlowRate
! first see if root is bracketed
! min demand flow
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMin
CALL CalcFluidHeatExchanger(CompNum,SupSideMdot, DmdSideMdot)
LeavingTempMinFlow = FluidHX(CompNum)%SupplySideLoop%OutletTemp
! full demand flow
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax
CALL CalcFluidHeatExchanger(CompNum,SupSideMdot, DmdSideMdot)
LeavingTempFullFlow = FluidHX(CompNum)%SupplySideLoop%OutletTemp
SELECT CASE (HXActionMode)
CASE (HeatingSupplySideLoop)
IF ((LeavingTempFullFlow > TargetSupplySideLoopLeavingTemp) &
.AND. (TargetSupplySideLoopLeavingTemp > LeavingTempMinFlow )) THEN
! need to solve
Par(1) = REAL( CompNum , r64) ! HX index
Par(2) = TargetSupplySideLoopLeavingTemp
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, DmdSideMdot, HXDemandSideLoopFlowResidual,&
FluidHX(CompNum)%DemandSideLoop%MassFlowRateMin , &
FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax, Par)
IF (SolFla == -1) THEN ! no convergence
IF (.NOT. WarmupFlag) THEN
IF (FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorCount < 1) THEN
FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorCount = FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorCount + 1
CALL ShowWarningError(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Iteration Limit exceeded calculating demand side loop flow rate' )
CALL ShowContinueError('Simulation continues with calculated demand side mass flow rate = ' &
//RoundSigDigits(DmdSideMdot, 7) )
ENDIF
CALL ShowRecurringWarningErrorAtEnd(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Iteration Limit exceeded calculating demand side loop flow rate continues.', &
FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorIndex, DmdSideMdot, DmdSideMdot)
ENDIF
ELSEIF (SolFla == -2) THEN !f(x0) and f(x1) have the same sign
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax * &
(LeavingTempFullFlow - TargetSupplySideLoopLeavingTemp) &
/(LeavingTempFullFlow - LeavingTempMinFlow)
IF (.NOT. WarmupFlag) THEN
IF (FluidHX(CompNum)%DmdSideModulatSolvFailErrorCount < 1) THEN
FluidHX(CompNum)%DmdSideModulatSolvFailErrorCount = FluidHX(CompNum)%DmdSideModulatSolvFailErrorCount + 1
CALL ShowWarningError(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Solver failed to calculate demand side loop flow rate' )
CALL ShowContinueError('Simulation continues with estimated demand side mass flow rate = ' &
//RoundSigDigits(DmdSideMdot, 7) )
ENDIF
CALL ShowRecurringWarningErrorAtEnd(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Solver failed to calculate demand side loop flow rate continues.', &
FluidHX(CompNum)%DmdSideModulatSolvFailErrorIndex, DmdSideMdot, DmdSideMdot)
ENDIF
ENDIF
CALL SetComponentFlowRate(DmdSideMdot, &
FluidHX(CompNum)%DemandSideLoop%InletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%OutletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%LoopNum, &
FluidHX(CompNum)%DemandSideLoop%LoopSideNum, &
FluidHX(CompNum)%DemandSideLoop%BranchNum, &
FluidHX(CompNum)%DemandSideLoop%CompNum)
ELSEIF ( ( TargetSupplySideLoopLeavingTemp >= LeavingTempFullFlow ) &
.AND. (LeavingTempFullFlow > LeavingTempMinFlow) ) THEN
! run at full flow
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax
CALL SetComponentFlowRate(DmdSideMdot, &
FluidHX(CompNum)%DemandSideLoop%InletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%OutletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%LoopNum, &
FluidHX(CompNum)%DemandSideLoop%LoopSideNum, &
FluidHX(CompNum)%DemandSideLoop%BranchNum, &
FluidHX(CompNum)%DemandSideLoop%CompNum)
ELSEIF ( LeavingTempMinFlow >= TargetSupplySideLoopLeavingTemp) THEN
! run at min flow
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMin
CALL SetComponentFlowRate(DmdSideMdot, &
FluidHX(CompNum)%DemandSideLoop%InletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%OutletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%LoopNum, &
FluidHX(CompNum)%DemandSideLoop%LoopSideNum, &
FluidHX(CompNum)%DemandSideLoop%BranchNum, &
FluidHX(CompNum)%DemandSideLoop%CompNum)
ENDIF
CASE (CoolingSupplySideLoop)
IF ((LeavingTempFullFlow < TargetSupplySideLoopLeavingTemp) &
.AND. (TargetSupplySideLoopLeavingTemp < LeavingTempMinFlow )) THEN
! need to solve
Par(1) = REAL( CompNum , r64) ! HX index
Par(2) = TargetSupplySideLoopLeavingTemp
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, DmdSideMdot, HXDemandSideLoopFlowResidual,&
FluidHX(CompNum)%DemandSideLoop%MassFlowRateMin , &
FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax, Par)
IF (SolFla == -1) THEN ! no convergence
IF (.NOT. WarmupFlag) THEN
IF (FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorCount < 1) THEN
FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorCount = FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorCount + 1
CALL ShowWarningError(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Iteration Limit exceeded calculating demand side loop flow rate' )
CALL ShowContinueError('Simulation continues with calculated demand side mass flow rate = ' &
//RoundSigDigits(DmdSideMdot, 7) )
ENDIF
CALL ShowRecurringWarningErrorAtEnd(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Iteration Limit exceeded calculating demand side loop flow rate continues.', &
FluidHX(CompNum)%DmdSideModulatSolvNoConvergeErrorIndex, DmdSideMdot, DmdSideMdot)
ENDIF
ELSEIF (SolFla == -2) THEN !f(x0) and f(x1) have the same sign
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax * &
(LeavingTempFullFlow - TargetSupplySideLoopLeavingTemp) &
/(LeavingTempFullFlow - LeavingTempMinFlow)
IF (.NOT. WarmupFlag) THEN
IF (FluidHX(CompNum)%DmdSideModulatSolvFailErrorCount < 1) THEN
FluidHX(CompNum)%DmdSideModulatSolvFailErrorCount = FluidHX(CompNum)%DmdSideModulatSolvFailErrorCount + 1
CALL ShowWarningError(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Solver failed to calculate demand side loop flow rate' )
CALL ShowContinueError('Simulation continues with estimated demand side mass flow rate = ' &
//RoundSigDigits(DmdSideMdot, 7) )
ENDIF
CALL ShowRecurringWarningErrorAtEnd(ComponentClassName//' named '//TRIM(FluidHX(CompNum)%Name)// &
' - Solver failed to calculate demand side loop flow rate continues.' ,&
FluidHX(CompNum)%DmdSideModulatSolvFailErrorIndex, DmdSideMdot, DmdSideMdot)
ENDIF
ENDIF
CALL SetComponentFlowRate(DmdSideMdot, &
FluidHX(CompNum)%DemandSideLoop%InletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%OutletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%LoopNum, &
FluidHX(CompNum)%DemandSideLoop%LoopSideNum, &
FluidHX(CompNum)%DemandSideLoop%BranchNum, &
FluidHX(CompNum)%DemandSideLoop%CompNum)
ELSEIF ( ( TargetSupplySideLoopLeavingTemp <= LeavingTempFullFlow ) &
.AND. (LeavingTempFullFlow < LeavingTempMinFlow) ) THEN
! run at full flow
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMax
CALL SetComponentFlowRate(DmdSideMdot, &
FluidHX(CompNum)%DemandSideLoop%InletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%OutletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%LoopNum, &
FluidHX(CompNum)%DemandSideLoop%LoopSideNum, &
FluidHX(CompNum)%DemandSideLoop%BranchNum, &
FluidHX(CompNum)%DemandSideLoop%CompNum)
ELSEIF ( LeavingTempMinFlow <= TargetSupplySideLoopLeavingTemp) THEN
! run at min flow
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%MassFlowRateMin
CALL SetComponentFlowRate(DmdSideMdot, &
FluidHX(CompNum)%DemandSideLoop%InletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%OutletNodeNum, &
FluidHX(CompNum)%DemandSideLoop%LoopNum, &
FluidHX(CompNum)%DemandSideLoop%LoopSideNum, &
FluidHX(CompNum)%DemandSideLoop%BranchNum, &
FluidHX(CompNum)%DemandSideLoop%CompNum)
ENDIF
END SELECT
RETURN
END SUBROUTINE FindHXDemandSideLoopFlow