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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | CompName | |||
integer, | intent(inout) | :: | CompIndex | |||
real(kind=r64), | intent(in) | :: | SensLoad | |||
real(kind=r64), | intent(in) | :: | LatentLoad | |||
integer, | intent(in) | :: | CyclingScheme | |||
real(kind=r64), | intent(in) | :: | RuntimeFrac | |||
real(kind=r64), | intent(inout) | :: | MaxONOFFCyclesperHour | |||
real(kind=r64), | intent(inout) | :: | HPTimeConstant | |||
real(kind=r64), | intent(inout) | :: | FanDelayTime | |||
integer, | intent(in) | :: | CompOp | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(in), | optional | :: | OnOffAirFlowRat |
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 SimWatertoAirHPSimple(CompName,CompIndex,SensLoad,LatentLoad, &
CyclingScheme,RuntimeFrac,MaxONOFFCyclesperHour, &
HPTimeConstant,FanDelayTime,CompOp, PartLoadRatio, FirstHVACIteration, OnOffAirFlowRat)
! AUTHOR Arun Shenoy
! DATE WRITTEN Nov 2003
! MODIFIED na
! RE-ENGINEERED Kenneth Tang (Jan 2005)
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages Simple Water to Air Heat Pump component simulation.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! (1) Lash.T.A.,1992.Simulation and Analysis of a Water Loop Heat Pump System.
! M.S. Thesis, University of Illinois at Urbana Champaign.
! (2) Shenoy, Arun. 2004. Simulation, Modeling and Analysis of Water to Air Heat Pump.
! State Energy Simulation Program. M.S. Thesis, Department of Mechanical and Aerospace Engineering,
! Oklahoma State University. (downloadable from www.hvac.okstate.edu)
! (3) Tang,C.C.. 2005. Modeling Packaged Heat Pumps in a Quasi-Steady
! State Energy Simulation Program. M.S. Thesis, Department of Mechanical and Aerospace Engineering,
! Oklahoma State University. (downloadable from www.hvac.okstate.edu)
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
USE FluidProperties, ONLY: FindGlycol
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: CompName ! Coil Name
INTEGER, INTENT(INOUT) :: CompIndex ! Index for Component name
REAL(r64), INTENT(IN) :: SensLoad ! Sensible demand load [W]
REAL(r64), INTENT(IN) :: LatentLoad ! Latent demand load [W]
INTEGER, INTENT(IN) :: CyclingScheme ! Continuous fan OR cycling compressor
REAL(r64), INTENT (IN) :: RuntimeFrac ! Compressor run time fraction or
! percent on-time (on-time/cycle time)
REAL(r64), INTENT (INOUT) :: MaxONOFFCyclesperHour ! Maximum cycling rate of heat pump [cycles/hr]
REAL(r64), INTENT (INOUT) :: HPTimeConstant ! Heat pump time constant [s]
REAL(r64), INTENT (INOUT) :: FanDelayTime ! Fan delay time, time delay for the HP's fan to
! shut off after compressor cycle off [s]
INTEGER, INTENT(IN) :: CompOp
REAL(r64), INTENT(IN) :: PartLoadRatio
LOGICAL, INTENT (IN) :: FirstHVACIteration
REAL(r64), OPTIONAL, INTENT(IN) :: OnOffAirFlowRat ! ratio of comp on to comp off air flow rate
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: HPNum ! The WatertoAirHP that you are currently loading input into
REAL(r64) :: OnOffAirFlowRatio ! ratio of comp on to comp off air flow rate
REAL(r64) :: WaterPartLoad ! The part load ratio of water
! FLOW:
! Obtains and Allocates WatertoAirHP related parameters from input file
IF (GetCoilsInputFlag) THEN !First time subroutine has been entered
CALL GetSimpleWatertoAirHPInput
! WaterIndex=FindGlycol('WATER') !Initialize the WaterIndex once
GetCoilsInputFlag=.FALSE.
End If
IF (CompIndex == 0) THEN
HPNum = FindItemInList(CompName,SimpleWatertoAirHP%Name,NumWatertoAirHPs )
IF (HPNum == 0) THEN
CALL ShowFatalError('WaterToAirHPSimple not found='//TRIM(CompName))
ENDIF
CompIndex=HPNum
ELSE
HPNum=CompIndex
IF (HPNum > NumWatertoAirHPs .or. HPNum < 1) THEN
CALL ShowFatalError('SimWatertoAirHPSimple: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(HPNum))// &
', Number of Water to Air HPs='//TRIM(TrimSigDigits(NumWatertoAirHPs))// &
', WaterToAir HP name='//TRIM(CompName))
ENDIF
IF (CompName /= Blank .AND. CompName /= SimpleWatertoAirHP(HPNum)%Name) THEN
CALL ShowFatalError('SimWatertoAirHPSimple: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(HPNum))// &
', WaterToAir HP name='//TRIM(CompName)//', stored WaterToAir HP Name for that index='// &
TRIM(SimpleWatertoAirHP(HPNum)%Name))
ENDIF
ENDIF
IF(PRESENT(OnOffAirFlowRat))THEN
OnOffAirFlowRatio = OnOffAirFlowRat
ELSE
OnOffAirFlowRatio = 1.0d0
END IF
! Calculate the Correct Water to Air HP Model with the current HPNum
IF((SimpleWatertoAirHP(HPNum)%WaterCyclingMode)==WaterCycling)THEN
WaterPartLoad = RuntimeFrac
!IF (WaterPartLoad < 0.1d0)THEN
! WaterPartLoad = 0.1d0
!ENDIF
ELSE
WaterPartLoad = 1.0d0
ENDIF
IF(SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPCoolingEquationFit)THEN
! Cooling mode
CALL InitSimpleWatertoAirHP(HPNum,MaxONOFFCyclesperHour,HPTimeConstant,FanDelayTime,SensLoad,LatentLoad,CyclingScheme, &
OnOffAirFlowRatio,WaterPartLoad,FirstHVACIteration)
CALL CalcHPCoolingSimple(HPNum,CyclingScheme,RuntimeFrac,SensLoad,LatentLoad,CompOp, PartLoadRatio, &
OnOffAirFlowRatio,WaterPartLoad)
CALL UpdateSimpleWatertoAirHP(HPNum)
ELSEIF(SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPHeatingEquationFit)THEN
! Heating mode
CALL InitSimpleWatertoAirHP(HPNum,MaxONOFFCyclesperHour,HPTimeConstant,FanDelayTime,SensLoad,constant_zero,CyclingScheme, &
OnOffAirFlowRatio,WaterPartLoad,FirstHVACIteration)
CALL CalcHPHeatingSimple(HPNum,CyclingScheme,RuntimeFrac,SensLoad,CompOp,PartLoadRatio, OnOffAirFlowRatio,WaterPartLoad)
CALL UpdateSimpleWatertoAirHP(HPNum)
ELSE
CALL ShowFatalError ('SimWatertoAirHPSimple: WatertoAir heatpump not in either HEATING or COOLING mode')
ENDIF
RETURN
END SUBROUTINE SimWatertoAirHPSimple