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 CalcWaterToAirResidual(PartLoadRatio, Par) RESULT (Residuum)
! FUNCTION INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN October 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! To calculate the part-load ratio for water to air HP's
! this is used for parameter estimation WAHPs but not equation fit WAHPs
! 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) = ZoneSensLoadMetFanONCompOFF ! Output with fan ON compressor OFF
! 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) :: ZoneSensLoadMet ! Sensible cooling load met (furnace outlet with respect to control zone temp)
REAL(r64) :: ZoneLatLoadMet ! 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
LOGICAL :: errflag
REAL(r64) :: RuntimeFrac
REAL(r64) :: Dummy
REAL(r64) :: HPCoilSensDemand
REAL(r64) :: ZoneSensLoadMetFanONCompOFF
REAL(r64) :: OnOffAirFlowRatio
LOGICAL :: HXUnitOn ! flag to enable HX based on zone moisture load (not valid for water-to-air HP's
! 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
END IF
ZoneSensLoadMetFanONCompOFF = Par(8)
!calculate the run time fraction
CALL HeatPumpRunFrac(FurnaceNum,PartLoadRatio,errflag,RuntimeFrac)
!update the fan part load factor
!see 'Note' under INITIAL CALCULATIONS
IF(Par(6) .EQ. 1.0d0)THEN
IF(RuntimeFrac > 0.0d0)THEN
OnOffFanPartLoadFraction = CoolPartLoadRatio/RuntimeFrac
ELSE
OnOffFanPartLoadFraction = 1.0d0
ENDIF
ELSE
IF(RuntimeFrac > 0.0d0)THEN
OnOffFanPartLoadFraction = PartLoadRatio/RuntimeFrac
! Else IF(RuntimeFrac == 0.0d0)THEN
! OnOffFanPartLoadFraction = 0.0
ELSE
OnOffFanPartLoadFraction = 1.0d0
ENDIF
END IF
OnOffFanPartLoadFractionSave = OnOffFanPartLoadFraction
!update fan and compressor run times
Furnace(FurnaceNum)%CompPartLoadRatio = PartLoadRatio
Furnace(FurnaceNum)%WSHPRuntimeFrac = RuntimeFrac
!Calculate the heating coil demand as (the zone sensible load - load met by fan heat and mixed air)
!Note; The load met by fan heat and mixed air is calculated as mdot(zoneinletenthalpy-zoneoutletenthalpy)
!This accounts for the negative sign in the equation.
!Calculate the heat coil sensible capacity as the load met by the system with the fan and compressor on less
!the load met by the system with the compressor off.
! HPCoilSensCapacity = ZoneSensLoadMetFanONCompON - ZoneSensLoadMetFanONCompOFF
!Set input parameters for heat pump coil model
HPCoilSensDemand = LoadToBeMet - RuntimeFrac*ZoneSensLoadMetFanONCompOFF
! HPCoilSensDemand = LoadToBeMet - PartLoadRatio*ZoneSensLoadMetFanONCompOFF
IF(Par(6) .EQ. 1.0d0)THEN
Furnace(FurnaceNum)%HeatingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%CoolingCoilSensDemand = ABS(HPCoilSensDemand)
ELSE
Furnace(FurnaceNum)%HeatingCoilSensDemand = HPCoilSensDemand
Furnace(FurnaceNum)%CoolingCoilSensDemand = 0.0d0
END IF
Furnace(FurnaceNum)%InitHeatPump = .FALSE. !initialization call to Calc Furnace
!Calculate the zone loads met and the new part load ratio and for the specified run time
Dummy=0.0d0
OnOffAirFlowRatio = 1.0d0
IF(Par(9) .EQ. 1.0d0)THEN
HXUnitOn = .TRUE.
ELSE
HXUnitOn = .FALSE.
END IF
! Subroutine arguments
! CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,FanOpMode,CompOp,CoolPartLoadRatio,&
! HeatPartLoadRatio, HeatCoilLoad, ReHeatCoilLoad, SensibleLoadMet, LatentLoadMet, HXUnitOn)
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,FanOpMode,CompOp,CoolPartLoadRatio,&
HeatPartLoadRatio, Dummy, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, HXUnitOn)
! Calculate residual based on output calculation flag
IF(Par(7) .EQ. 1.0d0) THEN
Residuum = (ZoneSensLoadMet - LoadToBeMet)/LoadToBeMet
ELSE
Residuum = (ZoneLatLoadMet - LoadToBeMet)/LoadToBeMet
END IF
RETURN
END FUNCTION CalcWaterToAirResidual