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) | :: | PVTnum |
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 ControlPVTcollector(PVTnum)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN August 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! make control decisions for PVT collector
! METHODOLOGY EMPLOYED:
! decide if PVT should be in cooling or heat mode and if it should be bypassed or not
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode , ONLY: Node
USE DataHeatBalance, ONLY: QRadSWOutIncident
USE DataPlant , ONLY: PlantReport
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: PVTnum !
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SurfNum = 0
! INTEGER :: PlantLoopNum = 0
! REAL(r64) :: mdot = 0.0D0
SurfNum = PVT(PVTnum)%SurfNum
IF ( PVT(PVTnum)%WorkingFluidType == AirWorkingFluid ) THEN
IF (PVT(PVTnum)%PVTModelType == SimplePVTmodel) THEN
IF (QRadSWOutIncident(SurfNum) > MinIrradiance) then
! is heating wanted?
! Outlet node is required to have a setpoint.
IF ( Node(PVT(PVTnum)%HVACOutletNodeNum)%TempSetPoint &
> Node(PVT(PVTnum)%HVACInletNodeNum)%Temp ) THEN
PVT(PVTnum)%HeatingUseful = .TRUE.
PVT(PVTnum)%CoolingUseful = .FALSE.
PVT(PVTnum)%BypassDamperOff = .TRUE.
ELSE
PVT(PVTnum)%HeatingUseful = .FALSE.
PVT(PVTnum)%CoolingUseful = .TRUE.
PVT(PVTnum)%BypassDamperOff = .FALSE.
ENDIF
ELSE
! is cooling wanted?
IF (Node(PVT(PVTnum)%HVACOutletNodeNum)%TempSetPoint &
< Node(PVT(PVTnum)%HVACInletNodeNum)%Temp ) THEN
PVT(PVTnum)%CoolingUseful = .TRUE.
PVT(PVTnum)%HeatingUseful = .FALSE.
PVT(PVTnum)%BypassDamperOff = .TRUE.
ELSE
PVT(PVTnum)%CoolingUseful = .FALSE.
PVT(PVTnum)%HeatingUseful = .TRUE.
PVT(PVTnum)%BypassDamperOff = .FALSE.
ENDIF
ENDIF
ENDIF
ELSEIF ( PVT(PVTnum)%WorkingFluidType == LiquidWorkingFluid ) THEN
!PlantLoopNum = PVT(PVTNum)%PlantLoopNum
! mdot = Node(PVT(PVTNum)%PlantInletNodeNum)%MassFlowRate
!If (.NOT. Allocated(PlantReport)) RETURN ! this can happen early before plant is setup
IF (PVT(PVTnum)%PVTModelType == SimplePVTmodel) THEN
IF (QRadSWOutIncident(SurfNum) > MinIrradiance) THEN
! is heating wanted?
! IF (mdot > 0.0D0) THEN
! If (PlantReport(PlantLoopNum)%HeatingDemand > 0.0) THEN
PVT(PVTnum)%HeatingUseful = .TRUE.
! PVT(PVTnum)%CoolingUseful = .FALSE.
PVT(PVTnum)%BypassDamperOff = .TRUE.
! ELSE
! PVT(PVTnum)%HeatingUseful = .FALSE.
! PVT(PVTnum)%CoolingUseful = .TRUE.
! PVT(PVTnum)%BypassDamperOff = .FALSE.
! ENDIF
ELSE
! is cooling wanted?
! IF (mdot > 0.0D0) THEN
! If (PlantReport(PlantLoopNum)%CoolingDemand > 0.0) THEN
! PVT(PVTnum)%CoolingUseful = .TRUE.
! PVT(PVTnum)%HeatingUseful = .FALSE.
! PVT(PVTnum)%BypassDamperOff = .TRUE.
! ELSE
PVT(PVTnum)%CoolingUseful = .FALSE.
! PVT(PVTnum)%HeatingUseful = .TRUE.
PVT(PVTnum)%BypassDamperOff = .FALSE.
! ENDIF
ENDIF
ENDIF
ENDIF
RETURN
END SUBROUTINE ControlPVTcollector