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) | :: | GenNum | |||
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 InitMTGenerators(GenNum, RunFlag, MyLoad, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR R. Raustad/D. Shirey
! DATE WRITTEN Mar 2008
! MODIFIED na
! RE-ENGINEERED B. Griffith, Sept 2010, plant upgrades, general fluid props
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the CT generators.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE FluidProperties, ONLY: GetDensityGlycol
USE CurveManager, ONLY: CurveValue
USE DataPlant, ONLY: PlantLoop,ScanPlantLoopsForObject, TypeOf_Generator_MicroTurbine
USE PlantUtilities, ONLY: SetComponentFlowRate, InitComponentNodes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: GenNum
LOGICAL, INTENT(IN) :: RunFlag !
REAL(r64), INTENT(IN) :: MyLoad ! electrical load in W
Logical, INTENT(IN) :: FirstHVACIteration
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Num ! Loop index over all generators
INTEGER :: HeatRecInletNode ! Inlet node number in heat recovery loop
INTEGER :: HeatRecOutletNode ! Outlet node number in heat recovery loop
LOGICAL,SAVE :: InitGeneratorOnce = .TRUE. ! Flag for 1 time initialization
LOGICAL,SAVE, ALLOCATABLE, DIMENSION(:) :: MyEnvrnFlag ! Flag for init once at start of environment
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyPlantScanFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MySizeAndNodeInitFlag
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE. ! Initialization flag
REAL(r64) :: rho ! local temporary fluid density
REAL(r64) :: DesiredMassFlowRate
LOGICAL :: errFlag
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE (MyEnvrnFlag (NumMTGenerators))
ALLOCATE (MyPlantScanFlag(NumMTGenerators))
ALLOCATE(MySizeAndNodeInitFlag(NumMTGenerators))
MyEnvrnFlag = .TRUE.
MyPlantScanFlag = .TRUE.
MySizeAndNodeInitFlag = .TRUE.
MyOneTimeFlag = .FALSE.
ENDIF
IF (MyPlantScanFlag(GenNum) .AND. ALLOCATED(PlantLoop) &
.AND. MTGenerator(GenNum)%HeatRecActive) THEN
errFlag = .FALSE.
CALL ScanPlantLoopsForObject(MTGenerator(GenNum)%Name, &
TypeOf_Generator_MicroTurbine, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum, &
errFlag = errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitMTGenerators: Program terminated due to previous condition(s).')
ENDIF
MyPlantScanFlag(GenNum) = .FALSE.
ENDIF
IF (MySizeAndNodeInitFlag(GenNum) .AND. (.NOT. MyPlantScanFlag(GenNum)) &
.AND. MTGenerator(GenNum)%HeatRecActive ) THEN
HeatRecInletNode = MTGenerator(GenNum)%HeatRecInletNodeNum
HeatRecOutletNode = MTGenerator(GenNum)%HeatRecOutletNodeNum
!size mass flow rate
rho = GetDensityGlycol(PlantLoop(MTGenerator(GenNum)%HRLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(MTGenerator(GenNum)%HRLoopNum)%FluidIndex, &
'InitMTGenerators')
MTGenerator(GenNum)%DesignHeatRecMassFlowRate = rho * MTGenerator(GenNum)%RefHeatRecVolFlowRate
MTGenerator(GenNum)%HeatRecMaxMassFlowRate = rho * MTGenerator(GenNum)%HeatRecMaxVolFlowRate
CALL InitComponentNodes(0.0D0, MTGenerator(GenNum)%HeatRecMaxMassFlowRate, &
HeatRecInletNode, &
HeatRecOutletNode, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum )
MySizeAndNodeInitFlag(GenNum) = .FALSE.
END IF ! end one time inits
IF (.not. MTGenerator(GenNum)%HeatRecActive) RETURN
HeatRecInletNode = MTGenerator(GenNum)%HeatRecInletNodeNum
HeatRecOutletNode = MTGenerator(GenNum)%HeatRecOutletNodeNum
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(GenNum)) THEN
! set the node max and min mass flow rates
CALL InitComponentNodes(0.0D0, MTGenerator(GenNum)%HeatRecMaxMassFlowRate, &
HeatRecInletNode, &
HeatRecOutletNode, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum )
Node(HeatRecInletNode)%Temp = 20.0d0 ! Set the node temperature, assuming freeze control
Node(HeatRecOutletNode)%Temp = 20.0d0
MyEnvrnFlag(GenNum) = .FALSE.
END IF ! end environmental inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(GenNum) =.TRUE.
END IF
! set/request flow rates
IF (FirstHVACIteration) THEN
IF (.NOT. RunFlag) THEN
DesiredMassFlowRate = 0.d0
ELSEIF (RunFlag .AND. MTGenerator(GenNum)%InternalFlowControl) THEN
! assume dispatch power in MyLoad is what gets produced (future, reset during calc routine and iterate)
IF (MTGenerator(GenNum)%HeatRecFlowFTempPowCurveNum .NE. 0) THEN
DesiredMassFlowRate = MTGenerator(GenNum)%DesignHeatRecMassFlowRate &
* CurveValue(MTGenerator(GenNum)%HeatRecFlowFTempPowCurveNum, &
Node(HeatRecInletNode)%Temp, &
MyLoad)
ELSE
DesiredMassFlowRate = MTGenerator(GenNum)%DesignHeatRecMassFlowRate ! Assume modifier = 1 if curve not specified
END IF
DesiredMassFlowRate = MAX(constant_zero, DesiredMassFlowRate) ! protect from neg. curve result
ELSEIF (RunFlag .AND. (.NOT. MTGenerator(GenNum)%InternalFlowControl)) THEN
DesiredMassFlowRate = MTGenerator(GenNum)%DesignHeatRecMassFlowRate
END IF
CALL SetComponentFlowRate(DesiredMassFlowRate, &
HeatRecInletNode, &
HeatRecOutletNode, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum )
ELSE ! not FirstHVACIteration
IF (.NOT. RunFlag) THEN
Node(HeatRecInletNode)%MassFlowRate = MIN(constant_zero, Node(HeatRecInletNode)%MassFlowRateMaxAvail)
Node(HeatRecInletNode)%MassFlowRate = MAX(constant_zero, Node(HeatRecInletNode)%MassFlowRateMinAvail)
ELSE IF (RunFlag .AND. MTGenerator(GenNum)%InternalFlowControl) THEN
! assume dispatch power in MyLoad is what gets produced (future, reset during calc routine and iterate)
IF (MTGenerator(GenNum)%HeatRecFlowFTempPowCurveNum .NE. 0) THEN
DesiredMassFlowRate = MTGenerator(GenNum)%DesignHeatRecMassFlowRate &
* CurveValue(MTGenerator(GenNum)%HeatRecFlowFTempPowCurveNum, &
Node(HeatRecInletNode)%Temp, &
MyLoad)
CALL SetComponentFlowRate(DesiredMassFlowRate, &
HeatRecInletNode, &
HeatRecOutletNode, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum )
ELSE
CALL SetComponentFlowRate(MTGenerator(GenNum)%HeatRecMdot, &
HeatRecInletNode, &
HeatRecOutletNode, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum )
END IF
ELSE IF (RunFlag .AND. (.NOT. MTGenerator(GenNum)%InternalFlowControl)) THEN
CALL SetComponentFlowRate(MTGenerator(GenNum)%HeatRecMdot, &
HeatRecInletNode, &
HeatRecOutletNode, &
MTGenerator(GenNum)%HRLoopNum, &
MTGenerator(GenNum)%HRLoopSideNum, &
MTGenerator(GenNum)%HRBranchNum, &
MTGenerator(GenNum)%HRCompNum )
ENDIF
END IF
RETURN
END SUBROUTINE InitMTGenerators