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) | :: | UnitNum | |||
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 InitZoneEvaporativeCoolerUnit(UnitNum, ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN July 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: TimeStep, TimeStepZone, WarmupFlag, HourOfDay
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList, ZoneEquipConfig
USE DataHVACGlobals, ONLY: ZoneComp, SysTimeElapsed
USE DataSizing, ONLY: Autosize
USE DataEnvironment, ONLY: StdRhoAir
USE Fans, ONLY: GetFanVolFlow
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: UnitNum ! unit number
INTEGER, INTENT (IN) :: ZoneNum ! number of zone being served
! 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(:) :: MySizeFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFanFlag
LOGICAL :: errFlag
INTEGER :: Loop
LOGICAL,SAVE :: ZoneEquipmentListChecked = .FALSE. ! True after the Zone Equipment List has been checked for items
REAL(r64) :: TimeElapsed
IF (MyOneTimeFlag) THEN
ALLOCATE(MySizeFlag(NumZoneEvapUnits))
MySizeFlag = .TRUE.
ALLOCATE(MyEnvrnFlag(NumZoneEvapUnits))
MyEnvrnFlag = .TRUE.
ALLOCATE(MyFanFlag(NumZoneEvapUnits))
MyFanFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (ALLOCATED(ZoneComp)) THEN
ZoneComp(ZoneEvapUnit(UnitNum)%ZoneEquipType)%ZoneCompAvailMgrs(UnitNum)%ZoneNum = ZoneNum
ZoneEvapUnit(UnitNum)%FanAvailStatus = ZoneComp(ZoneEvapUnit(UnitNum)%ZoneEquipType)%ZoneCompAvailMgrs(UnitNum)%AvailStatus
ENDIF
IF (.NOT. ZoneEquipmentListChecked .AND. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.TRUE.
DO Loop=1,NumZoneEvapUnits
IF (CheckZoneEquipmentList('ZoneHVAC:EvaporativeCoolerUnit',ZoneEvapUnit(Loop)%Name)) THEN
ZoneEvapUnit(Loop)%ZoneNodeNum = ZoneEquipConfig(ZoneNum)%ZoneNode
ELSE
CALL ShowSevereError('InitZoneEvaporativeCoolerUnit: ZoneHVAC:EvaporativeCoolerUnit = ' &
// TRIM(ZoneEvapUnit(Loop)%Name)// &
', is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDIF
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(UnitNum) ) THEN
CALL SizeZoneEvaporativeCoolerUnit(UnitNum)
MySizeFlag(UnitNum) = .FALSE.
END IF
IF (MyFanFlag(UnitNum)) THEN
IF (ZoneEvapUnit(UnitNum)%ActualFanVolFlowRate /= Autosize) THEN
IF (ZoneEvapUnit(UnitNum)%ActualFanVolFlowRate > 0.d0) THEN
ZoneEvapUnit(UnitNum)%DesignFanSpeedRatio = ZoneEvapUnit(UnitNum)%DesignAirVolumeFlowRate &
/ ZoneEvapUnit(UnitNum)%ActualFanVolFlowRate
ENDIF
MyFanFlag(UnitNum) = .FALSE.
ELSE
CALL GetFanVolFlow(ZoneEvapUnit(UnitNum)%FanIndex,ZoneEvapUnit(UnitNum)%ActualFanVolFlowRate)
ENDIF
ENDIF
IF (ZoneEvapUnit(UnitNum)%FanAvailSchedPtr > 0 ) THEN
! include fan is not available, then unit is not available
IF ((GetCurrentScheduleValue(ZoneEvapUnit(UnitNum)%FanAvailSchedPtr) > 0.d0 ) &
.AND. (GetCurrentScheduleValue(ZoneEvapUnit(UnitNum)%AvailSchedIndex) > 0.d0 ) ) THEN
! .AND. ( ZoneComp(ZoneEvapUnit(UnitNum)%ZoneEquipType)%ZoneCompAvailMgrs(UnitNum)%AvailStatus) ) THEN
ZoneEvapUnit(UnitNum)%UnitIsAvailable = .TRUE.
ELSE
ZoneEvapUnit(UnitNum)%UnitIsAvailable = .FALSE.
ENDIF
ELSE
IF (GetCurrentScheduleValue(ZoneEvapUnit(UnitNum)%AvailSchedIndex) > 0.d0 ) THEN
!.AND. ( ZoneComp(ZoneEvapUnit(UnitNum)%ZoneEquipType)%ZoneCompAvailMgrs(UnitNum)%AvailStatus) )THEN
ZoneEvapUnit(UnitNum)%UnitIsAvailable = .TRUE.
ELSE
ZoneEvapUnit(UnitNum)%UnitIsAvailable = .FALSE.
ENDIF
ENDIF
IF (GetCurrentScheduleValue(EvapCond(ZoneEvapUnit(UnitNum)%EvapCooler_1_Index)%SchedPtr) > 0.d0 ) THEN
ZoneEvapUnit(UnitNum)%EvapCooler_1_AvailStatus = .TRUE.
ELSE
ZoneEvapUnit(UnitNum)%EvapCooler_1_AvailStatus = .FALSE.
ENDIF
IF ( ZoneEvapUnit(UnitNum)%EvapCooler_2_Index > 0 ) THEN
IF (GetCurrentScheduleValue(EvapCond(ZoneEvapUnit(UnitNum)%EvapCooler_2_Index)%SchedPtr) > 0.d0 ) THEN
ZoneEvapUnit(UnitNum)%EvapCooler_2_AvailStatus = .TRUE.
ELSE
ZoneEvapUnit(UnitNum)%EvapCooler_2_AvailStatus = .FALSE.
ENDIF
ENDIF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(UnitNum)) THEN
ZoneEvapUnit(UnitNum)%DesignAirMassFlowRate = StdRhoAir * ZoneEvapUnit(UnitNum)%DesignAirVolumeFlowRate
Node(ZoneEvapUnit(UnitNum)%OAInletNodeNum)%MassFlowRateMax = ZoneEvapUnit(UnitNum)%DesignAirMassFlowRate
Node(ZoneEvapUnit(UnitNum)%OAInletNodeNum)%MassFlowRateMin = 0.d0
Node(ZoneEvapUnit(UnitNum)%OAInletNodeNum)%MassFlowRateMinAvail = 0.d0
Node(ZoneEvapUnit(UnitNum)%UnitOutletNodeNum)%MassFlowRateMax = ZoneEvapUnit(UnitNum)%DesignAirMassFlowRate
Node(ZoneEvapUnit(UnitNum)%UnitOutletNodeNum)%MassFlowRateMin = 0.d0
Node(ZoneEvapUnit(UnitNum)%UnitOutletNodeNum)%MassFlowRateMinAvail = 0.d0
IF (ZoneEvapUnit(UnitNum)%UnitReliefNodeNum > 0) THEN
Node(ZoneEvapUnit(UnitNum)%UnitReliefNodeNum)%MassFlowRateMax = ZoneEvapUnit(UnitNum)%DesignAirMassFlowRate
Node(ZoneEvapUnit(UnitNum)%UnitReliefNodeNum)%MassFlowRateMin = 0.d0
Node(ZoneEvapUnit(UnitNum)%UnitReliefNodeNum)%MassFlowRateMinAvail = 0.d0
ENDIF
ZoneEvapUnit(UnitNum)%WasOnLastTimestep = .FALSE.
ZoneEvapUnit(UnitNum)%IsOnThisTimestep = .FALSE.
ZoneEvapUnit(UnitNum)%FanSpeedRatio = 0.d0
ZoneEvapUnit(UnitNum)%UnitFanSpeedRatio = 0.d0
ZoneEvapUnit(UnitNum)%UnitTotalCoolingRate = 0.d0
ZoneEvapUnit(UnitNum)%UnitTotalCoolingEnergy = 0.d0
ZoneEvapUnit(UnitNum)%UnitSensibleCoolingRate = 0.d0
ZoneEvapUnit(UnitNum)%UnitSensibleCoolingEnergy = 0.d0
ZoneEvapUnit(UnitNum)%UnitLatentHeatingRate = 0.d0
ZoneEvapUnit(UnitNum)%UnitLatentHeatingEnergy = 0.d0
ZoneEvapUnit(UnitNum)%UnitLatentCoolingRate = 0.d0
ZoneEvapUnit(UnitNum)%UnitLatentCoolingEnergy = 0.d0
ZoneEvapUnit(UnitNum)%FanAvailStatus = 0.d0
! place default cold setpoints on control nodes of select evap coolers
IF ((ZoneEvapUnit(UnitNum)%EvapCooler_1_Type_Num == iEvapCoolerDirectResearchSpecial) &
.OR. (ZoneEvapUnit(UnitNum)%EvapCooler_1_Type_Num == iEvapCoolerInDirectRDDSpecial)) THEN
IF ( EvapCond(ZoneEvapUnit(UnitNum)%EvapCooler_1_Index)%EvapControlNodeNum > 0 ) THEN
Node(EvapCond(ZoneEvapUnit(UnitNum)%EvapCooler_1_Index)%EvapControlNodeNum)%TempSetPoint = -20.0d0
ENDIF
ENDIF
IF ((ZoneEvapUnit(UnitNum)%EvapCooler_2_Type_Num == iEvapCoolerDirectResearchSpecial) &
.OR. (ZoneEvapUnit(UnitNum)%EvapCooler_2_Type_Num == iEvapCoolerInDirectRDDSpecial)) THEN
IF ( EvapCond(ZoneEvapUnit(UnitNum)%EvapCooler_2_Index)%EvapControlNodeNum > 0 ) THEN
Node(EvapCond(ZoneEvapUnit(UnitNum)%EvapCooler_2_Index)%EvapControlNodeNum)%TempSetPoint = -20.0d0
ENDIF
ENDIF
MyEnvrnFlag(UnitNum) = .FALSE.
ENDIF
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag(UnitNum) = .TRUE.
END IF
TimeElapsed = HourOfDay + TimeStep * TimeStepZone + SysTimeElapsed
IF (ZoneEvapUnit(UnitNum)%TimeElapsed /= TimeElapsed) THEN
ZoneEvapUnit(UnitNum)%WasOnLastTimestep = ZoneEvapUnit(UnitNum)%IsOnThisTimestep
ZoneEvapUnit(UnitNum)%TimeElapsed = TimeElapsed
ENDIF
RETURN
END SUBROUTINE InitZoneEvaporativeCoolerUnit