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.
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 ZeroHVACValues
! SUBROUTINE INFORMATION:
! AUTHOR T. Stovall
! DATE WRITTEN Aug 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Reset all values that communicate outside module for HVAC steps
! to zero when called on zone timestep. Otherwise, values may be held over when
! no HVAC load calls module during that zone time step.
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataWater, ONLY: WaterStorage
USE PlantUtilities, ONLY : SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: DemandARRID = 0 ! Index to water tank Demand used for evap condenser
INTEGER :: TankID = 0 ! Index to water tank used for evap condenser
INTEGER :: RackNum = 0 ! Index to refrigerated rack
INTEGER :: CondID = 0 ! Index to condenser
INTEGER :: PlantInletNode = 0 ! Used to zero request for cooling water for condenser
INTEGER :: PlantOutletNode = 0 ! Used to zero request for cooling water for condenser
INTEGER :: PlantLoopIndex = 0 ! Used to zero request for cooling water for condenser
INTEGER :: PlantLoopSideIndex = 0 ! Used to zero request for cooling water for condenser
INTEGER :: PlantBranchIndex = 0 ! Used to zero request for cooling water for condenser
INTEGER :: PlantCompIndex = 0 ! Used to zero request for cooling water for condenser
REAL(r64) :: MassFlowRate =0.0d0 ! Used to zero request for cooling water for condenser
IF(HaveRefrigRacks) THEN
!HaveRefrigRacks is TRUE when NumRefrigeratedRAcks > 0
!RefrigRack ALLOCATED to NumRefrigeratedRacks
DO RackNum = 1,NumRefrigeratedRacks
IF (RefrigRack(RackNum)%CondenserType == RefrigCondenserTypeWater) THEN
PlantInletNode = RefrigRack(RackNum)%InletNode
PlantOutletNode = RefrigRack(RackNum)%OutletNode
PlantLoopIndex = RefrigRack(RackNum)%PlantLoopNum
PlantLoopSideIndex = RefrigRack(RackNum)%PlantLoopSideNum
PlantBranchIndex = RefrigRack(RackNum)%PlantBranchNum
PlantCompIndex = RefrigRack(RackNum)%PlantCompNum
MassFlowRate = 0.d0
CALL SetComponentFlowRate(MassFlowRate, &
PlantInletNode, PlantOutletNode, &
PlantLoopIndex, PlantLoopSideIndex, &
PlantBranchIndex, PlantCompIndex )
END IF
IF (RefrigRack(RackNum)%CondenserType == RefrigCondenserTypeEvap) THEN
IF (RefrigRack(RackNum)%EvapWaterSupplyMode == WaterSupplyFromTank) THEN
DemandARRID = RefrigRack(RackNum)%EvapWaterTankDemandARRID
TankID = RefrigRack(RackNum)%EvapWaterSupTankID
WaterStorage(TankID)%VdotRequestDemand(DemandARRID) = 0.d0
END IF
END IF
END DO ! RackNum
END IF !HaveRefrigRacks
IF(NumRefrigCondensers.GT.0) THEN
!Condenser ALLOCATED to NumRefrigCondensers
DO CondID = 1,NumRefrigCondensers
IF (Condenser(CondID)%CondenserType == RefrigCondenserTypeWater) THEN
PlantInletNode = Condenser(CondID)%InletNode
PlantOutletNode = Condenser(CondID)%OutletNode
PlantLoopIndex = Condenser(CondID)%PlantLoopNum
PlantLoopSideIndex = Condenser(CondID)%PlantLoopSideNum
PlantBranchIndex = Condenser(CondID)%PlantBranchNum
PlantCompIndex = Condenser(CondID)%PlantCompNum
MassFlowRate = 0.d0
CALL SetComponentFlowRate(MassFlowRate, &
PlantInletNode, PlantOutletNode, &
PlantLoopIndex, PlantLoopSideIndex, &
PlantBranchIndex, PlantCompIndex )
END IF
IF (Condenser(CondID)%CondenserType == RefrigCondenserTypeEvap) THEN
IF (Condenser(CondID)%EvapWaterSupplyMode == WaterSupplyFromTank) THEN
DemandARRID = Condenser(CondID)%EvapWaterTankDemandARRID
TankID = Condenser(CondID)%EvapWaterSupTankID
WaterStorage(TankID)%VdotRequestDemand(DemandARRID) = 0.d0
END IF
END IF
END DO ! ICond
END IF ! NumRefrigCondensers>0
RETURN
END SUBROUTINE ZeroHVACValues