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) | :: | SourceNum | |||
logical, | intent(in) | :: | RunFlag | |||
real(kind=r64), | intent(in) | :: | MyLoad | |||
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 InitWaterSource(SourceNum ,RunFlag, MyLoad, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Edwin Lee
! DATE WRITTEN November 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the water source objects
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, WarmupFlag
USE DataPlant, ONLY : PlantLoop, ScanPlantLoopsForObject,PlantSizeNotComplete, PlantSizesOkayToFinalize
USE PlantUtilities, ONLY : InitComponentNodes, SetComponentFlowRate
USE FluidProperties, ONLY : GetDensityGlycol, GetSpecificHeatGlycol
USE ScheduleManager, ONLY : GetCurrentScheduleValue
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: SourceNum ! number of the current component being simulated
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when component operating
REAL(r64), INTENT(IN) :: MyLoad
LOGICAL, INTENT(IN) :: FirstHVACIteration ! initialize variables when TRUE
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='InitWaterSource'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: rho ! local fluid density
REAL(r64) :: cp ! local specific heat
LOGICAL :: errFlag
!FLOW
! Init more variables
IF (WaterSource(SourceNum)%MyFlag) THEN
! Locate the component on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(WaterSource(SourceNum)%Name, &
TypeOf_WaterSource, &
WaterSource(SourceNum)%Location%LoopNum, &
WaterSource(SourceNum)%Location%LoopSideNum, &
WaterSource(SourceNum)%Location%BranchNum, &
WaterSource(SourceNum)%Location%CompNum, &
InletNodeNumber = WaterSource(SourceNum)%InletNodeNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError(RoutineName//': Program terminated due to previous condition(s).')
ENDIF
WaterSource(SourceNum)%MyFlag=.FALSE.
ENDIF
!Initialize critical Demand Side Variables at the beginning of each environment
IF(WaterSource(SourceNum)%MyEnvironFlag .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize))Then
IF (PlantSizeNotComplete) CALL SizeWaterSource(SourceNum)
rho = GetDensityGlycol(PlantLoop(WaterSource(SourceNum)%Location%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(WaterSource(SourceNum)%Location%LoopNum)%FluidIndex,&
RoutineName)
WaterSource(SourceNum)%MassFlowRateMax = WaterSource(SourceNum)%DesVolFlowRate * rho
CALL InitComponentNodes(0.0D0,WaterSource(SourceNum)%MassFlowRateMax, &
WaterSource(SourceNum)%InletNodeNum, &
WaterSource(SourceNum)%OutletNodeNum, &
WaterSource(SourceNum)%Location%LoopNum, &
WaterSource(SourceNum)%Location%LoopSideNum, &
WaterSource(SourceNum)%Location%BranchNum, &
WaterSource(SourceNum)%Location%CompNum)
WaterSource(SourceNum)%MyEnvironFlag = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
WaterSource(SourceNum)%MyEnvironFlag=.true.
ENDIF
! OK, so we can set up the inlet and boundary temperatures now
WaterSource(SourceNum)%InletTemp = Node(WaterSource(SourceNum)%InletNodeNum)%Temp
IF (WaterSource(SourceNum)%TempSpecType == TempSpecType_Schedule) THEN
WaterSource(SourceNum)%BoundaryTemp = GetCurrentScheduleValue(WaterSource(SourceNum)%TempSpecScheduleNum)
END IF
! Calculate specific heat
Cp = GetSpecificHeatGlycol(PlantLoop(WaterSource(SourceNum)%Location%LoopNum)%FluidName, &
WaterSource(SourceNum)%BoundaryTemp, &
PlantLoop(WaterSource(SourceNum)%Location%LoopNum)%FluidIndex, &
RoutineName)
! if myload is > 0 then we want to heat the loop
! if myload is < 0 then we want to cool the loop
! thus, given a fixed outlet temperature (the boundary temp, Tbnd), the eq is:
! myload = mdot * cp * (Tbnd - Tin)
! re-arranging:
! mdot = myload / [cp * (Tbnd - Tin)]
! if mdot
WaterSource(SourceNum)%MassFlowRate=MyLoad/(Cp*(WaterSource(SourceNum)%BoundaryTemp-WaterSource(SourceNum)%InletTemp))
! If the mdot is negative it means we can't help the load so we will want to just go to zero.
! If the mdot is already zero, then well, we still want to go to zero
! If the mdot is positive, just make sure we constrain it to the design value
IF (WaterSource(SourceNum)%MassFlowRate < 0) THEN
WaterSource(SourceNum)%MassFlowRate = 0.0d0
ELSE
IF (.NOT. WaterSource(SourceNum)%EMSOverrideOnMassFlowRateMax) THEN
WaterSource(SourceNum)%MassFlowRate = MIN(WaterSource(SourceNum)%MassFlowRate, WaterSource(SourceNum)%MassFlowRateMax)
ELSE
WaterSource(SourceNum)%MassFlowRate = MIN(WaterSource(SourceNum)%MassFlowRate, &
WaterSource(SourceNum)%EMSOverrideValueMassFlowRateMax)
ENDIF
END IF
CALL SetComponentFlowRate( WaterSource(SourceNum)%MassFlowRate, &
WaterSource(SourceNum)%InletNodeNum, &
WaterSource(SourceNum)%OutletNodeNum, &
WaterSource(SourceNum)%Location%LoopNum, &
WaterSource(SourceNum)%Location%LoopSideNum, &
WaterSource(SourceNum)%Location%BranchNum, &
WaterSource(SourceNum)%Location%CompNum)
! at this point the mass flow rate, inlet temp, and boundary temp structure vars have been updated
! the calc routine will update the outlet temp and heat transfer rate/energies
END SUBROUTINE InitWaterSource