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) | :: | WaterConnNum |
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 InitConnections(WaterConnNum)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN August 2006
! MODIFIED Brent Griffith 2010, demand side update
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
!
! METHODOLOGY EMPLOYED:
!
! USE STATEMENTS:
USE DataGlobals, ONLY: SysSizingCalc, DoingSizing
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataLoopNode, ONLY: Node
USE DataEnvironment, ONLY: WaterMainsTemp
USE DataWater, ONLY: WaterStorage
USE DataHeatBalance, ONLY: Zone
USE DataPlant, ONLY: PlantLoop, ScanPlantLoopsForObject, TypeOf_WaterUseConnection
USE PlantUtilities, ONLY: InitComponentNodes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: WaterConnNum
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode
INTEGER :: OutletNode
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag !DSU
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: SetLoopIndexFlag ! get loop number flag !DSU
LOGICAL :: errFlag
IF (MyOneTimeFlag) THEN !DSU
ALLOCATE(SetLoopIndexFlag(NumWaterConnections))
SetLoopIndexFlag = .TRUE. !DSU
MyOneTimeFlag = .FALSE. !DSU
END IF !DSU
IF(SetLoopIndexFlag(WaterConnNum))THEN !DSU
IF(ALLOCATED(PlantLoop) .and. .NOT. WaterConnections(WaterConnNum)%StandAlone) THEN !DSU
errFlag=.false.
CALL ScanPlantLoopsForObject(WaterConnections(WaterConnNum)%Name, & !DSU
TypeOf_WaterUseConnection, & !DSU
WaterConnections(WaterConnNum)%PlantLoopNum, & !DSU
WaterConnections(WaterConnNum)%PlantLoopSide, & !DSU
WaterConnections(WaterConnNum)%PlantLoopBranchNum, & !DSU
WaterConnections(WaterConnNum)%PlantLoopCompNum, & !DSU
errFlag=errFlag) !DSU
IF (errFlag) THEN !DSU
CALL ShowFatalError('InitConnections: Program terminated due to previous condition(s).') !DSU
ENDIF !DSU
SetLoopIndexFlag(WaterConnNum) = .FALSE. !DSU
ENDIF !DSU
IF (WaterConnections(WaterConnNum)%StandAlone) SetLoopIndexFlag(WaterConnNum) = .FALSE.
ENDIF
! Set the cold water temperature
IF (WaterConnections(WaterConnNum)%SupplyTankNum > 0) THEN
WaterConnections(WaterConnNum)%ColdSupplyTemp = WaterStorage(WaterConnections(WaterConnNum)%SupplyTankNum)%Twater
ELSE IF (WaterConnections(WaterConnNum)%ColdTempSchedule > 0) THEN
WaterConnections(WaterConnNum)%ColdSupplyTemp = GetCurrentScheduleValue(WaterConnections(WaterConnNum)%ColdTempSchedule)
ELSE
WaterConnections(WaterConnNum)%ColdSupplyTemp = WaterMainsTemp
END IF
! Initially set ColdTemp to the ColdSupplyTemp; with heat recovery, ColdTemp will change during iteration
WaterConnections(WaterConnNum)%ColdTemp = WaterConnections(WaterConnNum)%ColdSupplyTemp
! Set the hot water temperature
IF (WaterConnections(WaterConnNum)%StandAlone) THEN
IF (WaterConnections(WaterConnNum)%HotTempSchedule > 0) THEN
WaterConnections(WaterConnNum)%HotTemp = GetCurrentScheduleValue(WaterConnections(WaterConnNum)%HotTempSchedule)
ELSE
! If no HotTempSchedule, use all cold water
WaterConnections(WaterConnNum)%HotTemp = WaterConnections(WaterConnNum)%ColdTemp
END IF
ELSE
InletNode = WaterConnections(WaterConnNum)%InletNode
OutletNode = WaterConnections(WaterConnNum)%OutletNode
IF (BeginEnvrnFlag .AND. WaterConnections(WaterConnNum)%Init) THEN
! Clear node initial conditions
IF (InletNode > 0 .AND. OutletNode > 0) THEN
CALL InitComponentNodes(0.d0,WaterConnections(WaterConnNum)%PeakMassFlowRate, &
InletNode, &
OutletNode, &
WaterConnections(WaterConnNum)%PlantLoopNum, &
WaterConnections(WaterConnNum)%PlantLoopSide, &
WaterConnections(WaterConnNum)%PlantLoopBranchNum, &
WaterConnections(WaterConnNum)%PlantLoopCompNum)
WaterConnections(WaterConnNum)%ReturnTemp = Node(InletNode)%Temp
END IF
WaterConnections(WaterConnNum)%Init = .FALSE.
END IF
IF (.NOT. BeginEnvrnFlag) WaterConnections(WaterConnNum)%Init = .TRUE.
IF (InletNode > 0) THEN
If (.not. DoingSizing) THEN
WaterConnections(WaterConnNum)%HotTemp = Node(InletNode)%Temp
ELSE
! plant loop will not be running so need a value here.
! should change to use tank setpoint but water use connections don't have knowledge of the tank they are fed by
WaterConnections(WaterConnNum)%HotTemp = 60.0d0 !
ENDIF
END IF
END IF
RETURN
END SUBROUTINE InitConnections