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) | :: | TowerNum | |||
logical, | intent(in) | :: | RunFlag |
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 InitTower(TowerNum, RunFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN May 2002
! MODIFIED Don Shirey Sept/Oct 2002, F Buhl Oct 2002
! RE-ENGINEERED R. Raustad, Oct 2005, moved Max/MinAvail to Init and allowed more than design
! water flow rate to pass through towers (up to 2.5 and 1.25 times the design flow
! for 1 or 2-speed and variable speed towers, respectively). Flow multiplier for
! VS Tower is defaulted to 1.25 and can be reassigned by user.
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Cooling Tower components and for
! final checking of tower inputs (post autosizing)
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: BeginEnvrnFlag
USE Psychrometrics, ONLY: PsyTwbFnTdbWPb
USE InputProcessor, ONLY: SameString
USE DataPlant, ONLY: TypeOf_CoolingTower_SingleSpd, TypeOf_CoolingTower_TwoSpd, &
TypeOf_CoolingTower_VarSpd, PlantLoop, ScanPlantLoopsForObject, &
PlantSizesOkayToFinalize, PlantSizeNotComplete, TypeOf_CoolingTower_VarSpdMerkel
USE PlantUtilities, ONLY: InitComponentNodes, SetComponentFlowRate, RegulateCondenserCompFlowReqOp
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: TowerNum ! Number of the current cooling tower being simulated
LOGICAL, INTENT (IN) :: RunFlag ! Indication of
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: ErrorsFound=.false. ! Flag if input data errors are found
LOGICAL, SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: OneTimeFlagForEachTower
! LOGICAL :: FatalError
INTEGER :: TypeOf_Num
INTEGER :: LoopNum
INTEGER :: LoopSideNum
INTEGER :: BranchIndex
INTEGER :: CompIndex
REAL(r64) :: rho ! local density of fluid
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumSimpleTowers))
ALLOCATE(OneTimeFlagForEachTower(NumSimpleTowers))
OneTimeFlagForEachTower = .TRUE.
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
IF (OneTimeFlagForEachTower(TowerNum)) THEN
IF (SimpleTower(TowerNum)%TowerType_Num == CoolingTower_SingleSpeed) THEN
TypeOf_Num = TypeOf_CoolingTower_SingleSpd
ELSEIF (SimpleTower(TowerNum)%TowerType_Num == CoolingTower_TwoSpeed) THEN
TypeOf_Num = TypeOf_CoolingTower_TwoSpd
ELSEIF (SimpleTower(TowerNum)%TowerType_Num == CoolingTower_VariableSpeed) THEN
TypeOf_Num = TypeOf_CoolingTower_VarSpd
ELSEIF (SimpleTower(TowerNum)%TowerType_Num == CoolingTower_VariableSpeedMerkel) THEN
TypeOf_Num = TypeOf_CoolingTower_VarSpdMerkel
ENDIF
! Locate the tower on the plant loops for later usage
CALL ScanPlantLoopsForObject(SimpleTower(TowerNum)%Name, &
TypeOf_Num, &
SimpleTower(TowerNum)%LoopNum, &
SimpleTower(TowerNum)%LoopSideNum, &
SimpleTower(TowerNum)%BranchNum, &
SimpleTower(TowerNum)%CompNum, &
errFlag=ErrorsFound)
IF (ErrorsFound) THEN
CALL ShowFatalError('InitTower: Program terminated due to previous condition(s).')
ENDIF
! check if setpoint on outlet node
IF ((Node(SimpleTower(TowerNum)%WaterOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(SimpleTower(TowerNum)%WaterOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue) ) THEN
SimpleTower(TowerNum)%SetpointIsOnOutlet = .FALSE.
ELSE
SimpleTower(TowerNum)%SetpointIsOnOutlet = .TRUE.
ENDIF
OneTimeFlagForEachTower(TowerNum) = .FALSE.
END IF
! Begin environment initializations
IF(MyEnvrnFlag(TowerNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize) )Then
IF (PlantSizeNotComplete) THEN
SELECT CASE (SimpleTower(TowerNum)%TowerType_Num)
CASE (CoolingTower_SingleSpeed, CoolingTower_TwoSpeed, CoolingTower_VariableSpeed)
CALL SizeTower(TowerNum)
CASE (CoolingTower_VariableSpeedMerkel )
CALL SizeVSMerkelTower(TowerNum)
ENDSELECT
ENDIF
rho = GetDensityGlycol(PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidIndex,&
'InitTower')
SimpleTower(TowerNum)%DesWaterMassFlowRate = SimpleTower(TowerNum)%DesignWaterFlowRate * &
rho
SimpleTower(TowerNum)%DesWaterMassFlowRatePerCell = SimpleTower(TowerNum)%DesWaterMassFlowRate &
/ SimpleTower(TowerNum)%NumCell
CALL InitComponentNodes(0.0D0, SimpleTower(TowerNum)%DesWaterMassFlowRate , &
SimpleTower(TowerNum)%WaterInletNodeNum, &
SimpleTower(TowerNum)%WaterOutletNodeNum, &
SimpleTower(TowerNum)%LoopNum, &
SimpleTower(TowerNum)%LoopSideNum, &
SimpleTower(TowerNum)%BranchNum, &
SimpleTower(TowerNum)%CompNum)
MyEnvrnFlag(TowerNum) = .false.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(TowerNum)=.true.
ENDIF
! Each time initializations
WaterInletNode = SimpleTower(TowerNum)%WaterInletNodeNum
SimpleTowerInlet(TowerNum)%WaterTemp = Node(WaterInletNode)%Temp
IF (SimpleTower(TowerNum)%OutdoorAirInletNodeNum /= 0) THEN
SimpleTowerInlet(TowerNum)%AirTemp = Node(SimpleTower(TowerNum)%OutdoorAirInletNodeNum)%Temp
SimpleTowerInlet(TowerNum)%AirHumRat = Node(SimpleTower(TowerNum)%OutdoorAirInletNodeNum)%HumRat
SimpleTowerInlet(TowerNum)%AirPress = Node(SimpleTower(TowerNum)%OutdoorAirInletNodeNum)%Press
! SimpleTowerInlet(TowerNum)%AirWetBulb = PsyTwbFnTdbWPb(SimpleTowerInlet(TowerNum)%AirTemp, &
! SimpleTowerInlet(TowerNum)%AirHumRat,SimpleTowerInlet(TowerNum)%AirPress)
SimpleTowerInlet(TowerNum)%AirWetBulb = Node(SimpleTower(TowerNum)%OutdoorAirInletNodeNum)%OutAirWetBulb
ELSE
SimpleTowerInlet(TowerNum)%AirTemp = OutDryBulbTemp
SimpleTowerInlet(TowerNum)%AirHumRat = OutHumRat
SimpleTowerInlet(TowerNum)%AirPress = OutBaroPress
SimpleTowerInlet(TowerNum)%AirWetBulb = OutWetBulbTemp
ENDIF
LoopNum = SimpleTower(TowerNum)%LoopNum
LoopSideNum = SimpleTower(TowerNum)%LoopSideNum
BranchIndex = SimpleTower(TowerNum)%BranchNum
CompIndex = SimpleTower(TowerNum)%CompNum
WaterMassFlowRate = RegulateCondenserCompFlowReqOp(SimpleTower(TowerNum)%LoopNum, &
SimpleTower(TowerNum)%LoopSideNum, &
SimpleTower(TowerNum)%BranchNum, &
SimpleTower(TowerNum)%CompNum, &
SimpleTower(TowerNum)%DesWaterMassFlowRate &
* SimpleTower(TowerNum)%TowerMassFlowRateMultiplier)
CALL SetComponentFlowRate(WaterMassFlowRate, &
SimpleTower(TowerNum)%WaterInletNodeNum, &
SimpleTower(TowerNum)%WaterOutletNodeNum, &
SimpleTower(TowerNum)%LoopNum, &
SimpleTower(TowerNum)%LoopSideNum, &
SimpleTower(TowerNum)%BranchNum, &
SimpleTower(TowerNum)%CompNum)
! Added for fluid bypass. 8/2008
SimpleTower(TowerNum)%BypassFraction = 0.0D0
BasinHeaterPower = 0.0D0
RETURN
END SUBROUTINE InitTower