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) | :: | DesignAirflow | |||
integer, | intent(in) | :: | CyclingScheme | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(in) | :: | RuntimeFrac | |||
real(kind=r64), | intent(inout) | :: | MaxONOFFCyclesperHour | |||
real(kind=r64), | intent(inout) | :: | HPTimeConstant | |||
real(kind=r64), | intent(inout) | :: | FanDelayTime | |||
logical, | intent(in) | :: | Initflag | |||
real(kind=r64), | intent(in) | :: | SensLoad | |||
real(kind=r64), | intent(in) | :: | LatentLoad | |||
integer, | intent(in) | :: | CompOp | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio |
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 SimWatertoAirHP(CompName,CompIndex,DesignAirflow,CyclingScheme, &
FirstHVACIteration,RuntimeFrac,MaxONOFFCyclesperHour,HPTimeConstant, &
FanDelayTime,InitFlag,SensLoad,LatentLoad,CompOp,PartLoadRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Hui Jin
! DATE WRITTEN Oct 2000
! MODIFIED Dan Fisher, Kenneth Tang (Jan 2004)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages Water to Air Heat Pump component simulation.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
USE General, ONLY: TrimSigDigits
USE FluidProperties, ONLY: FindGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT (IN):: DesignAirflow !design air flow rate
REAL(r64), INTENT (IN):: RuntimeFrac !compressor run time fraction
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]
REAL(r64), INTENT (IN):: SensLoad !sensible load
REAL(r64), INTENT (IN):: LatentLoad !latent load
LOGICAL, INTENT (IN):: FirstHVACIteration !first iteration flag
LOGICAL, INTENT (IN):: Initflag !initialization flag used to suppress property routine errors
CHARACTER(len=*), INTENT(IN) :: CompName !component name
INTEGER, INTENT(INOUT) :: CompIndex ! Index for Component name
INTEGER, INTENT(IN) :: CyclingScheme !cycling scheme--either continuous fan/cycling compressor or
!cycling fan/cycling compressor
INTEGER, INTENT(IN) :: CompOp
REAL(r64), INTENT(IN) :: PartLoadRatio
! 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
! FLOW:
! Obtains and Allocates WatertoAirHP related parameters from input file
IF (GetCoilsInputFlag) THEN !First time subroutine has been entered
WaterIndex=FindGlycol('WATER') !Initialize the WaterIndex once
CALL GetWatertoAirHPInput
GetCoilsInputFlag=.false.
End If
IF (CompIndex == 0) THEN
HPNum = FindItemInList(CompName,WatertoAirHP%Name,NumWatertoAirHPs)
IF (HPNum == 0) THEN
CALL ShowFatalError('WaterToAir HP not found='//TRIM(CompName))
ENDIF
CompIndex=HPNum
ELSE
HPNum=CompIndex
IF (HPNum > NumWatertoAirHPs .or. HPNum < 1) THEN
CALL ShowFatalError('SimWatertoAirHP: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(HPNum))// &
', Number of Water to Air HPs='//TRIM(TrimSigDigits(NumWatertoAirHPs))// &
', WaterToAir HP name='//TRIM(CompName))
ENDIF
IF (CheckEquipName(HPNum)) THEN
IF (CompName /= Blank .AND. CompName /= WatertoAirHP(HPNum)%Name) THEN
CALL ShowFatalError('SimWatertoAirHP: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(HPNum))// &
', WaterToAir HP name='//TRIM(CompName)//', stored WaterToAir HP Name for that index='// &
TRIM(WatertoAirHP(HPNum)%Name))
ENDIF
CheckEquipName(HPNum)=.false.
ENDIF
ENDIF
! Calculate the Correct Water to Air HP Model with the current HPNum
IF(WatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPCoolingParamEst)THEN
CALL InitWatertoAirHP(HPNum, InitFlag,MaxONOFFCyclesperHour,HPTimeConstant,FanDelayTime, &
SensLoad,LatentLoad,DesignAirflow,PartLoadRatio)
CALL CalcWatertoAirHPCooling(HPNum,CyclingScheme,FirstHVACIteration,RuntimeFrac,initflag,SensLoad,CompOp,PartLoadRatio)
CALL UpdateWatertoAirHP(HPNum)
ELSEIF(WatertoAirHP(HPNum)%WAHPPlantTypeOfNum==TypeOf_CoilWAHPHeatingParamEst)THEN
CALL InitWatertoAirHP(HPNum, InitFlag,MaxONOFFCyclesperHour,HPTimeConstant,FanDelayTime, &
SensLoad,LatentLoad,DesignAirflow,PartLoadRatio)
CALL CalcWatertoAirHPHeating(HPNum,CyclingScheme,FirstHVACIteration,RuntimeFrac,initflag,SensLoad,CompOp,PartLoadRatio)
CALL UpdateWatertoAirHP(HPNum)
ELSE
CALL ShowFatalError ('SimWatertoAirHP: AirtoAir heatpump not in either HEATING or COOLING')
ENDIF
RETURN
END SUBROUTINE SimWatertoAirHP