Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
real(kind=r64), | intent(in), | optional | DIMENSION(:) | :: | Par |
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.
FUNCTION CalcFurnaceResidual(PartLoadRatio, Par) RESULT (Residuum)
! FUNCTION INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN Feb 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! To calculate the part-load ratio for cooling and heating coils
! METHODOLOGY EMPLOYED:
! Use SolveRegulaFalsi to call this Function to converge on a solution
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: PartLoadRatio ! DX cooling coil part load ratio
REAL(r64), INTENT(IN), DIMENSION(:), OPTIONAL :: Par ! Function parameters
REAL(r64) :: Residuum ! Result (force to 0)
! Parameter description example:
! Par(1) = REAL(FurnaceNum,r64) ! Index to furnace
! Par(2) = 0.0 ! FirstHVACIteration FLAG, if 1.0 then TRUE, if 0.0 then FALSE
! Par(3) = REAL(OpMode,r64) ! Fan control, if 1.0 then cycling fan, if 0.0 then continuous fan
! Par(4) = REAL(CompOp,r64) ! Compressor control, if 1.0 then compressor ON, if 0.0 then compressor OFF
! Par(5) = CoolCoilLoad ! Sensible or Latent load to be met by furnace
! Par(6) = 1.0 ! Type of load FLAG, 0.0 if heating load, 1.0 if cooling or moisture load
! Par(7) = 1.0 ! Output calculation FLAG, 0.0 for latent capacity, 1.0 for sensible capacity
! Par(8) = OnOffAirFlowRatio ! Ratio of compressor ON air mass flow to AVERAGE air mass flow over time step
! Par(9) = HXUnitOn ! flag to enable HX, 1=ON and 2=OFF
! Par(10) = HeatingCoilPLR ! used to calculate latent degradation for cycling fan RH control
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: FurnaceNum ! Index to furnace
LOGICAL :: FirstHVACIteration ! FirstHVACIteration flag
INTEGER :: FanOpMode ! Cycling fan or constant fan
INTEGER :: CompOp ! Compressor on/off; 1=on, 0=off
REAL(r64) :: CoolPartLoadRatio ! DX cooling coil part load ratio
REAL(r64) :: HeatPartLoadRatio ! DX heating coil part load ratio (0 for other heating coil types)
REAL(r64) :: HeatCoilLoad ! Heating coil load for gas heater
REAL(r64) :: SensibleLoadMet ! Sensible cooling load met (furnace outlet with respect to control zone temp)
REAL(r64) :: LatentLoadMet ! Latent cooling load met (furnace outlet with respect to control zone humidity ratio)
REAL(r64) :: LoadToBeMet ! Sensible or Latent load to be met by furnace
REAL(r64) :: OnOffAirFlowRatio ! Ratio of compressor ON air mass flow to AVERAGE air mass flow over time step
REAL(r64) :: RuntimeFrac ! heat pump runtime fraction
REAL(r64) :: CoolingHeatingPLRRatio ! ratio of cooling PLR to heating PLR, used for cycling fan RH control
LOGICAL :: HXUnitOn ! flag to enable HX based on zone moisture load
LOGICAL :: errflag ! flag denoting error in runtime calculation
! Convert parameters to usable variables
FurnaceNum = INT(Par(1))
IF(Par(2) .EQ. 1.0d0)THEN
FirstHVACIteration = .TRUE.
ELSE
FirstHVACIteration = .FALSE.
END IF
FanOpMode = INT(Par(3))
CompOp = INT(Par(4))
LoadToBeMet = Par(5)
IF(Par(6) .EQ. 1.0d0)THEN
CoolPartLoadRatio = PartLoadRatio
HeatPartLoadRatio = 0.0d0
HeatCoilLoad = 0.0d0
ELSE
CoolPartLoadRatio = 0.0d0
HeatPartLoadRatio = PartLoadRatio
IF(Furnace(FurnaceNum)%HeatingCoilType_Num .EQ. Coil_HeatingGas .OR. &
Furnace(FurnaceNum)%HeatingCoilType_Num .EQ. Coil_HeatingElectric .OR. &
Furnace(FurnaceNum)%HeatingCoilType_Num .EQ. Coil_HeatingWater .OR. &
Furnace(FurnaceNum)%HeatingCoilType_Num .EQ. Coil_HeatingSteam )THEN
HeatCoilLoad = Furnace(FurnaceNum)%DesignHeatingCapacity * PartLoadRatio
ELSE
HeatCoilLoad = 0.0d0
END IF
END IF
! OnOffAirFlowRatio = Par(8)
IF(Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatPump_WaterToAir) THEN
CALL HeatPumpRunFrac(FurnaceNum,PartLoadRatio,errflag,RuntimeFrac)
Furnace(FurnaceNum)%CompPartLoadRatio = PartLoadRatio
Furnace(FurnaceNum)%WSHPRuntimeFrac = RuntimeFrac
END IF
IF(Par(9) .EQ. 1.0d0)THEN
HXUnitOn = .TRUE.
ELSE
HXUnitOn = .FALSE.
END IF
IF(Par(10) .GT. 0.0d0)THEN
! Par(10) = Furnace(FurnaceNum)%HeatPartLoadRatio
! FanOpMode = CycFan and Furnace(FurnaceNum)%HeatPartLoadRatio must be > 0 for Part(10) to be greater than 0
! This variable used when in heating mode and dehumidification (cooling) is required.
CoolingHeatingPLRRatio = MIN(1.0d0,CoolPartLoadRatio/Furnace(FurnaceNum)%HeatPartLoadRatio)
ELSE
CoolingHeatingPLRRatio = 1.0d0
END IF
! Subroutine arguments
! CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,FanOpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
! HeatCoilLoad, ReHeatCoilLoad, SensibleLoadMet, LatentLoadMet, OnOffAirFlowRatio, HXUnitOn)
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,FanOpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
HeatCoilLoad, 0.0d0, SensibleLoadMet, LatentLoadMet, OnOffAirFlowRatio, HXUnitOn, &
CoolingHeatingPLRRatio)
! Calculate residual based on output calculation flag
IF(Par(7) .EQ. 1.0d0) THEN
IF(LoadToBeMet .EQ. 0.0d0)THEN
Residuum = (SensibleLoadMet - LoadToBeMet)/100.0d0
ELSE
Residuum = (SensibleLoadMet - LoadToBeMet)/LoadToBeMet
END IF
ELSE
IF(LoadToBeMet .EQ. 0.0d0)THEN
Residuum = (LatentLoadMet - LoadToBeMet)/100.0d0
ELSE
Residuum = (LatentLoadMet - LoadToBeMet)/LoadToBeMet
END IF
END IF
RETURN
END FUNCTION CalcFurnaceResidual