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) | :: | WindACNum | |||
real(kind=r64), | intent(inout) | :: | QZnReq | |||
integer, | intent(in) | :: | ZoneNum | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 InitWindowAC(WindACNum,QZnReq,ZoneNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN May 2000
! MODIFIED Chandan Sharma, FSEC, March 2011: Added zone sys avail manager
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Window AC Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList, WindowAC_Num
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, CurDeadbandOrSetback
USE DataHvacGlobals, ONLY: ZoneComp, ZoneCompTurnFansOn, ZoneCompTurnFansOff, SmallLoad
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: WindACNum ! number of the current window AC unit being simulated
REAL(r64), INTENT (INOUT) :: QZnReq ! zone load (modified as needed) (W)
INTEGER, INTENT (IN) :: ZoneNum ! index to zone
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE when first HVAC iteration
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
Integer :: InNode ! inlet node number in window AC loop
Integer :: OutNode ! outlet node number in window AC loop
INTEGER :: InletNode ! inlet node number for window AC WindACNum
INTEGER :: OutsideAirNode ! outside air node number in window AC loop
INTEGER :: AirRelNode ! relief air node number in window AC loop
REAL(r64) :: RhoAir ! air density at InNode
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
Integer :: Loop ! loop counter
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag ! one time initialization flag
REAL(r64) :: QToCoolSetPt ! sensible load to cooling setpoint (W)
REAL(r64) :: NoCompOutput ! sensible load delivered with compressor off (W)
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumWindAC))
ALLOCATE(MySizeFlag(NumWindAC))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
IF (ALLOCATED(ZoneComp)) THEN
ZoneComp(WindowAC_Num)%ZoneCompAvailMgrs(WindACNum)%ZoneNum = ZoneNum
WindAC(WindACNum)%AvailStatus = ZoneComp(WindowAC_Num)%ZoneCompAvailMgrs(WindACNum)%AvailStatus
ENDIF
! need to check all Window AC units to see if they are on Zone Equipment List or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
DO Loop=1,NumWindAC
IF (CheckZoneEquipmentList(cWindowAC_UnitTypes(WindAC(Loop)%UnitType),WindAC(Loop)%Name)) CYCLE
CALL ShowSevereError('InitWindowAC: Window AC Unit=['//TRIM(cWindowAC_UnitTypes(WindAC(Loop)%UnitType))//','// &
TRIM(WindAC(Loop)%Name)// &
'] is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(WindACNum) ) THEN
CALL SizeWindowAC(WindACNum)
MySizeFlag(WindACNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(WindACNum)) THEN
InNode = WindAC(WindACNum)%AirInNode
OutNode = WindAC(WindACNum)%AirOutNode
OutsideAirNode = WindAC(WindACNum)%OutsideAirNode
RhoAir = StdRhoAir
! set the mass flow rates from the input volume flow rates
WindAC(WindACNum)%MaxAirMassFlow = RhoAir*WindAC(WindACNum)%MaxAirVolFlow
WindAC(WindACNum)%OutAirMassFlow = RhoAir*WindAC(WindACNum)%OutAirVolFlow
! set the node max and min mass flow rates
Node(OutsideAirNode)%MassFlowRateMax = WindAC(WindACNum)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMin = 0.0d0
Node(OutNode)%MassFlowRateMax = WindAC(WindACNum)%MaxAirMassFlow
Node(OutNode)%MassFlowRateMin = 0.0d0
Node(InNode)%MassFlowRateMax = WindAC(WindACNum)%MaxAirMassFlow
Node(InNode)%MassFlowRateMin = 0.0d0
MyEnvrnFlag(WindACNum) = .FALSE.
END IF ! end one time inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(WindACNum) = .true.
ENDIF
IF (WindAC(WindACNum)%FanSchedPtr .GT. 0) THEN
IF (GetCurrentScheduleValue(WindAC(WindACNum)%FanSchedPtr) .EQ. 0.0d0) THEN
WindAC(WindACNum)%OpMode = CycFanCycCoil
ELSE
WindAC(WindACNum)%OpMode = ContFanCycCoil
END IF
END IF
! These initializations are done every iteration
InletNode = WindAC(WindACNum)%AirInNode
OutsideAirNode = WindAC(WindACNum)%OutsideAirNode
AirRelNode = WindAC(WindACNum)%AirReliefNode
! Set the inlet node mass flow rate
IF (GetCurrentScheduleValue(WindAC(WindACNum)%SchedPtr) .LE. 0.0d0 &
.OR. (GetCurrentScheduleValue(WindAC(WindACNum)%FanAvailSchedPtr) .LE. 0.0d0 .AND. &
.NOT. ZoneCompTurnFansOn) .OR. ZoneCompTurnFansOff) THEN
WindAC(WindACNum)%PartLoadFrac = 0.0d0
Node(InletNode)%MassFlowRate = 0.0d0
Node(InletNode)%MassFlowRateMaxAvail = 0.0d0
Node(InletNode)%MassFlowRateMinAvail = 0.0d0
Node(OutsideAirNode)%MassFlowRate = 0.0d0
Node(OutsideAirNode)%MassFlowRateMaxAvail = 0.0d0
Node(OutsideAirNode)%MassFlowRateMinAvail = 0.0d0
Node(AirRelNode)%MassFlowRate = 0.0d0
Node(AirRelNode)%MassFlowRateMaxAvail = 0.0d0
Node(AirRelNode)%MassFlowRateMinAvail = 0.0d0
ELSE
WindAC(WindACNum)%PartLoadFrac = 1.0d0
Node(InletNode)%MassFlowRate = WindAC(WindACNum)%MaxAirMassFlow
Node(InletNode)%MassFlowRateMaxAvail = Node(InletNode)%MassFlowRate
Node(InletNode)%MassFlowRateMinAvail = Node(InletNode)%MassFlowRate
Node(OutsideAirNode)%MassFlowRate = WindAC(WindACNum)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMaxAvail = WindAC(WindACNum)%OutAirMassFlow
Node(OutsideAirNode)%MassFlowRateMinAvail = 0.0d0
Node(AirRelNode)%MassFlowRate = WindAC(WindACNum)%OutAirMassFlow
Node(AirRelNode)%MassFlowRateMaxAvail = WindAC(WindACNum)%OutAirMassFlow
Node(AirRelNode)%MassFlowRateMinAvail = 0.0d0
END IF
! Original thermostat control logic (works only for cycling fan systems)
IF(QZnReq .LT. (-1.d0*SmallLoad) .AND. .NOT. CurDeadbandOrSetback(ZoneNum) .AND. WindAC(WindACNum)%PartLoadFrac .GT. 0.0d0)THEN
CoolingLoad = .TRUE.
ELSE
CoolingLoad = .FALSE.
END IF
! Constant fan systems are tested for ventilation load to determine if load to be met changes.
IF(WindAC(WindACNum)%OpMode .EQ. ContFanCycCoil .AND. WindAC(WindACNum)%PartLoadFrac .GT. 0.0d0 &
.AND. (GetCurrentScheduleValue(WindAC(WindACNum)%FanAvailSchedPtr) .GT. 0.0d0 .OR. &
ZoneCompTurnFansOn) .AND. .NOT. ZoneCompTurnFansOn)THEN
CALL CalcWindowACOutput(WindACNum,FirstHVACIteration,WindAC(WindACNum)%OpMode, &
0.0d0,.FALSE.,NoCompOutput)
QToCoolSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
! If the unit has a net heating capacity and the zone temp is below the Tstat cooling setpoint
IF(NoCompOutput .GT. (-1.d0 * SmallLoad) .AND. QToCoolSetPt .GT. (-1.d0 * SmallLoad) .AND. CurDeadbandOrSetback(Zonenum) )THEN
IF(NoCompOutput .GT. QToCoolSetPt)THEN
QZnReq = QToCoolSetPt
CoolingLoad = .TRUE.
END IF
END IF
END IF
RETURN
END SUBROUTINE InitWindowAC