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 | |||
integer, | intent(in) | :: | ZoneNum |
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 InitZoneAirUserDefined(CompNum, ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN Feb. 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! initialize data for user-defined zone HVAC forced air component model
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW, PsyCpAirFnWTdb
USE DataEnvironment, ONLY: OutBaroPress
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, ZoneSysMoistureDemand
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CompNum
INTEGER, INTENT(IN) :: ZoneNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFlag
LOGICAL :: errFlag
INTEGER :: Loop
IF (MyOneTimeFlag) THEN
ALLOCATE(MyFlag(NumUserZoneAir))
MyFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (MyFlag(CompNum)) THEN
IF (UserZoneAirHVAC(CompNum)%NumPlantConnections > 0) THEN
DO Loop = 1, UserZoneAirHVAC(CompNum)%NumPlantConnections
errFlag = .false.
CALL ScanPlantLoopsForObject(UserZoneAirHVAC(CompNum)%Name, &
TypeOf_ZoneHVACAirUserDefined, &
UserZoneAirHVAC(CompNum)%Loop(loop)%LoopNum, &
UserZoneAirHVAC(CompNum)%Loop(loop)%LoopSideNum, &
UserZoneAirHVAC(CompNum)%Loop(loop)%BranchNum, &
UserZoneAirHVAC(CompNum)%Loop(loop)%CompNum , &
InletNodeNumber = UserZoneAirHVAC(CompNum)%Loop(loop)%InletNodeNum)
IF (errFlag) THEN
CALL ShowFatalError('InitPlantUserComponent: Program terminated due to previous condition(s).')
ENDIF
!set user input for flow priority
PlantLoop(UserZoneAirHVAC(CompNum)%Loop(loop)%LoopNum)% &
LoopSide(UserZoneAirHVAC(CompNum)%Loop(loop)%LoopSideNum)% &
Branch(UserZoneAirHVAC(CompNum)%Loop(loop)%BranchNum)% &
Comp(UserZoneAirHVAC(CompNum)%Loop(loop)%CompNum)%FlowPriority &
= UserZoneAirHVAC(CompNum)%Loop(loop)%FlowPriority
! set user input for how loads served
PlantLoop(UserZoneAirHVAC(CompNum)%Loop(loop)%LoopNum)% &
LoopSide(UserZoneAirHVAC(CompNum)%Loop(loop)%LoopSideNum)% &
Branch(UserZoneAirHVAC(CompNum)%Loop(loop)%BranchNum)% &
Comp(UserZoneAirHVAC(CompNum)%Loop(loop)%CompNum)%HowLoadServed &
= UserZoneAirHVAC(CompNum)%Loop(loop)%HowLoadServed
ENDDO
ENDIF
ENDIF
! fill internal variable targets
UserZoneAirHVAC(CompNum)%RemainingOutputToHeatingSP = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
UserZoneAirHVAC(CompNum)%RemainingOutputToCoolingSP = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
UserZoneAirHVAC(CompNum)%RemainingOutputReqToDehumidSP = ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToDehumidSP
UserZoneAirHVAC(CompNum)%RemainingOutputReqToHumidSP = ZoneSysMoistureDemand(ZoneNum)%RemainingOutputReqToHumidSP
UserZoneAirHVAC(CompNum)%ZoneAir%InletRho = PsyRhoAirFnPbTdbW(OutBaroPress, &
Node(UserZoneAirHVAC(CompNum)%ZoneAir%InletNodeNum)%Temp, &
Node(UserZoneAirHVAC(CompNum)%ZoneAir%InletNodeNum)%HumRat, &
'InitZoneAirUserDefined' )
UserZoneAirHVAC(CompNum)%ZoneAir%InletCp = PsyCpAirFnWTdb( &
Node(UserZoneAirHVAC(CompNum)%ZoneAir%InletNodeNum)%HumRat, &
Node(UserZoneAirHVAC(CompNum)%ZoneAir%InletNodeNum)%Temp , &
'InitZoneAirUserDefined')
UserZoneAirHVAC(CompNum)%ZoneAir%InletTemp = &
Node(UserZoneAirHVAC(CompNum)%ZoneAir%InletNodeNum)%Temp
UserZoneAirHVAC(CompNum)%ZoneAir%InletHumRat = &
Node(UserZoneAirHVAC(CompNum)%ZoneAir%InletNodeNum)%HumRat
IF (UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum > 0) THEN
UserZoneAirHVAC(CompNum)%SourceAir%InletRho = PsyRhoAirFnPbTdbW(OutBaroPress, &
Node(UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum)%Temp, &
Node(UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum)%HumRat, &
'InitZoneAirUserDefined')
UserZoneAirHVAC(CompNum)%SourceAir%InletCp = PsyCpAirFnWTdb( &
Node(UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum)%HumRat, &
Node(UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum)%Temp, &
'InitZoneAirUserDefined' )
UserZoneAirHVAC(CompNum)%SourceAir%InletTemp = &
Node(UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum)%Temp
UserZoneAirHVAC(CompNum)%SourceAir%InletHumRat = &
Node(UserZoneAirHVAC(CompNum)%SourceAir%InletNodeNum)%HumRat
ENDIF
IF (UserZoneAirHVAC(CompNum)%NumPlantConnections > 0) THEN
Do Loop = 1, UserZoneAirHVAC(CompNum)%NumPlantConnections
UserZoneAirHVAC(CompNum)%Loop(Loop)%InletRho = GetDensityGlycol( &
PlantLoop(UserZoneAirHVAC(CompNum)%Loop(Loop)%LoopNum)%FluidName, &
Node(UserZoneAirHVAC(CompNum)%Loop(Loop)%InletNodeNum)%Temp, &
PlantLoop(UserZoneAirHVAC(CompNum)%Loop(Loop)%LoopNum)%FluidIndex, &
'InitZoneAirUserDefined')
UserZoneAirHVAC(CompNum)%Loop(Loop)%InletCp = GetSpecificHeatGlycol( &
PlantLoop(UserZoneAirHVAC(CompNum)%Loop(Loop)%LoopNum)%FluidName, &
Node(UserZoneAirHVAC(CompNum)%Loop(Loop)%InletNodeNum)%Temp, &
PlantLoop(UserZoneAirHVAC(CompNum)%Loop(Loop)%LoopNum)%FluidIndex, &
'InitZoneAirUserDefined')
UserZoneAirHVAC(CompNum)%Loop(Loop)%InletTemp = &
Node(UserZoneAirHVAC(CompNum)%Loop(Loop)%InletNodeNum)%Temp
UserZoneAirHVAC(CompNum)%Loop(Loop)%InletMassFlowRate = &
Node(UserZoneAirHVAC(CompNum)%Loop(Loop)%InletNodeNum)%MassFlowRate
ENDDO
ENDIF
RETURN
END SUBROUTINE InitZoneAirUserDefined