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) | :: | ChillNum | |||
| logical, | intent(in) | :: | RunFlag | |||
| real(kind=r64), | intent(in) | :: | MyLoad | 
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 InitBLASTAbsorberModel(ChillNum,RunFlag, MyLoad)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Raustad
          !       DATE WRITTEN   September 2009
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine is for initializations of the Electric Chiller components
          ! METHODOLOGY EMPLOYED:
          ! Uses the status flags to trigger initializations.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataGlobals,     ONLY : BeginEnvrnFlag, AnyEnergyManagementSystemInModel
  USE DataPlant,       ONLY : PlantLoop, TypeOf_Chiller_Absorption, ScanPlantLoopsForObject, &
                              PlantSizeNotComplete, PlantSizesOkayToFinalize, LoopFlowStatus_NeedyIfLoopOn
  USE InputProcessor,  ONLY : SameString
  USE PlantUtilities,  ONLY : InterConnectTwoPlantLoopSides, InitComponentNodes, SetComponentFlowRate
  Use FluidProperties, ONLY : GetDensityGlycol, GetSatEnthalpyRefrig, GetSatDensityRefrig
  USE EMSManager,      ONLY : iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT (IN) :: ChillNum     ! number of the current electric chiller being simulated
  LOGICAL, INTENT(IN)  :: RunFlag      ! TRUE when chiller operating
  REAL(r64), INTENT(IN):: MyLoad
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  LOGICAL,SAVE        :: MyOneTimeFlag = .true.
  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFlag
  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvrnFlag
  INTEGER   :: CondInletNode      ! node number of water inlet node to the condenser
  INTEGER   :: CondOutletNode     ! node number of water outlet node from the condenser
  INTEGER   :: LoopCtr            ! Plant loop counter
  INTEGER   :: LoopSideCtr        ! Loop side counter
  INTEGER   :: BranchCtr          ! Plant branch counter
  INTEGER   :: CompCtr            ! Component counter
  LOGICAL   :: errFlag
  LOGICAL   :: FatalError
  REAL(r64) :: rho ! local fluid density
  REAL(r64) :: CpWater ! local specific heat
  REAL(r64) :: SteamDensity        ! density of generator steam (when connected to a steam loop)
  REAL(r64) :: EnthSteamOutDry     ! dry enthalpy of steam (quality = 1)
  REAL(r64) :: EnthSteamOutWet     ! wet enthalpy of steam (quality = 0)
  REAL(r64) :: HfgSteam            ! latent heat of steam at constant pressure
  REAL(r64) :: SteamDeltaT         ! amount of sub-cooling of steam condensate
  INTEGER   :: GeneratorInletNode      ! generator inlet node number, steam/water side
  REAL(r64) :: SteamOutletTemp
  INTEGER   :: DummyWaterIndex = 1
  REAL(r64) :: mdotEvap ! local fluid mass flow rate thru evaporator
  REAL(r64) :: mdotCond ! local fluid mass flow rate thru condenser
  REAL(r64) :: mdotGen ! local fluid mass flow rate thru generator
          ! FLOW:
  ! Do the one time initializations
  IF (MyOneTimeFlag) THEN
    ALLOCATE(MyFlag(NumBLASTAbsorbers))
    ALLOCATE(MyEnvrnFlag(NumBLASTAbsorbers))
    MyFlag = .TRUE.
    MyEnvrnFlag = .TRUE.
    MyOneTimeFlag = .false.
  END IF
  ! Init more variables
  IF (MyFlag(ChillNum)) THEN
    ! Locate the chillers on the plant loops for later usage
    errFlag=.false.
    CALL ScanPlantLoopsForObject(BLASTAbsorber(ChillNum)%Name, &
                                 TypeOf_Chiller_Absorption, &
                                 BLASTAbsorber(ChillNum)%CWLoopNum, &
                                 BLASTAbsorber(ChillNum)%CWLoopSideNum, &
                                 BLASTAbsorber(ChillNum)%CWBranchNum, &
                                 BLASTAbsorber(ChillNum)%CWCompNum, &
                                 LowLimitTemp = BLASTAbsorber(ChillNum)%TempLowLimitEvapOut, &
                                 InletNodeNumber = BLASTAbsorber(ChillNum)%EvapInletNodeNum,  &
                                 errFlag=errFlag)
    IF (BLASTAbsorber(ChillNum)%CondInletNodeNum > 0) THEN
      CALL ScanPlantLoopsForObject(BLASTAbsorber(ChillNum)%Name, &
                                   TypeOf_Chiller_Absorption, &
                                   BLASTAbsorber(ChillNum)%CDLoopNum, &
                                   BLASTAbsorber(ChillNum)%CDLoopSideNum, &
                                   BLASTAbsorber(ChillNum)%CDBranchNum, &
                                   BLASTAbsorber(ChillNum)%CDCompNum, &
                                   InletNodeNumber = BLASTAbsorber(ChillNum)%CondInletNodeNum,  &
                                   errFlag=errFlag)
      CALL InterConnectTwoPlantLoopSides( BLASTAbsorber(ChillNum)%CWLoopNum,      &
                                          BLASTAbsorber(ChillNum)%CWLoopSideNum,  &
                                          BLASTAbsorber(ChillNum)%CDLoopNum,      &
                                          BLASTAbsorber(ChillNum)%CDLoopSideNum,  &
                                          TypeOf_Chiller_Absorption, .TRUE. )
    ENDIF
    IF (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
      CALL ScanPlantLoopsForObject(BLASTAbsorber(ChillNum)%Name,         &
                                   TypeOf_Chiller_Absorption,            &
                                   BLASTAbsorber(ChillNum)%GenLoopNum,   &
                                   BLASTAbsorber(ChillNum)%GenLoopSideNum, &
                                   BLASTAbsorber(ChillNum)%GenBranchNum,   &
                                   BLASTAbsorber(ChillNum)%GenCompNum,     &
                                   InletNodeNumber = BLASTAbsorber(ChillNum)%GeneratorInletNodeNum,  &
                                   errFlag=errFlag)
      CALL InterConnectTwoPlantLoopSides( BLASTAbsorber(ChillNum)%CWLoopNum,      &
                                          BLASTAbsorber(ChillNum)%CWLoopSideNum,  &
                                          BLASTAbsorber(ChillNum)%GenLoopNum,     &
                                          BLASTAbsorber(ChillNum)%GenCompNum,     &
                                          TypeOf_Chiller_Absorption, .TRUE. )
    ENDIF
    !Fill in connection data
    IF ( (BLASTAbsorber(ChillNum)%CondInletNodeNum > 0)  .AND. &
         (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) ) THEN
      CALL InterConnectTwoPlantLoopSides( BLASTAbsorber(ChillNum)%CDLoopNum,     &
                                          BLASTAbsorber(ChillNum)%CDLoopSideNum, &
                                          BLASTAbsorber(ChillNum)%GenLoopNum,    &
                                          BLASTAbsorber(ChillNum)%GenCompNum,     &
                                          TypeOf_Chiller_Absorption, .FALSE. )
    ENDIF
    IF (errFlag) THEN
      CALL ShowFatalError('InitBLASTAbsorberModel: Program terminated due to previous condition(s).')
    ENDIF
    IF (BLASTAbsorber(ChillNum)%FlowMode == ConstantFlow) THEN
      PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%LoopSide(BLASTAbsorber(ChillNum)%CWLoopSideNum)% &
          Branch(BLASTAbsorber(ChillNum)%CWBranchNum)%Comp(BLASTAbsorber(ChillNum)%CWCompNum)%FlowPriority &
              = LoopFlowStatus_NeedyIfLoopOn
    ENDIF
    IF (BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) THEN
      PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%LoopSide(BLASTAbsorber(ChillNum)%CWLoopSideNum)% &
          Branch(BLASTAbsorber(ChillNum)%CWBranchNum)%Comp(BLASTAbsorber(ChillNum)%CWCompNum)%FlowPriority &
              = LoopFlowStatus_NeedyIfLoopOn
      IF ((Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
          (Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
        IF (.NOT. AnyEnergyManagementSystemInModel) THEN
          IF (.NOT. BLASTAbsorber(ChillNum)%ModulatedFlowErrDone) THEN
            CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
                                          TRIM(BLASTAbsorber(ChillNum)%Name) )
            CALL ShowContinueError('  A temperature setpoint is needed at the outlet node of a chiller ' // &
                                             'in variable flow mode, use a SetpointManager')
            CALL ShowContinueError('  The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
            BLASTAbsorber(ChillNum)%ModulatedFlowErrDone = .TRUE.
          ENDIF
        ELSE
         ! need call to EMS to check node
          FatalError = .FALSE. ! but not really fatal yet, but should be.
          CALL CheckIfNodeSetpointManagedByEMS(BLASTAbsorber(ChillNum)%EvapOutletNodeNum,iTemperatureSetpoint, FatalError)
          IF (FatalError) THEN
            IF (.NOT. BLASTAbsorber(ChillNum)%ModulatedFlowErrDone) THEN
              CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
                                          TRIM(BLASTAbsorber(ChillNum)%Name) )
              CALL ShowContinueError('  A temperature setpoint is needed at the outlet node of a chiller evaporator ' // &
                                             'in variable flow mode')
              CALL ShowContinueError('  use a Setpoint Manager to establish a setpoint at the chiller evaporator outlet node ')
              CALL ShowContinueError('  or use an EMS actuator to establish a setpoint at the outlet node ')
              CALL ShowContinueError('  The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
              BLASTAbsorber(ChillNum)%ModulatedFlowErrDone = .TRUE.
            ENDIF
          ENDIF
        ENDIF
        BLASTAbsorber(ChillNum)%ModulatedFlowSetToLoop = .TRUE.
        Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint = &
           Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
        Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi = &
           Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
      ENDIF
    ENDIF
    MyFlag(ChillNum)=.FALSE.
  ENDIF
  CondInletNode  = BLASTAbsorber(ChillNum)%CondInletNodeNum
  CondOutletNode = BLASTAbsorber(ChillNum)%CondOutletNodeNum
          !Initialize critical Demand Side Variables
!  IF((MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag) &
!     .OR. (Node(CondInletNode)%MassFlowrate <= 0.0 .AND. RunFlag)) THEN
  IF (MyEnvrnFlag(ChillNum) .AND. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize)) THEN
    IF (PlantSizeNotComplete) CALL SizeAbsorpChiller(ChillNum)
    rho = GetDensityGlycol(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%FluidName, &
                             InitConvTemp, &
                             PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
                             'InitBLASTAbsorberModel')
    BLASTAbsorber(ChillNum)%EvapMassFlowRateMax = BLASTAbsorber(ChillNum)%EvapVolFlowRate * rho
    CALL InitComponentNodes(0.d0, BLASTAbsorber(ChillNum)%EvapMassFlowRateMax, &
                              BLASTAbsorber(ChillNum)%EvapInletNodeNum, &
                              BLASTAbsorber(ChillNum)%EvapOutletNodeNum, &
                              BLASTAbsorber(ChillNum)%CWLoopNum, &
                              BLASTAbsorber(ChillNum)%CWLoopSideNum, &
                              BLASTAbsorber(ChillNum)%CWBranchNum, &
                              BLASTAbsorber(ChillNum)%CWCompNum)
    rho = GetDensityGlycol(PlantLoop(BLASTAbsorber(ChillNum)%CDLoopNum)%FluidName, &
                           InitConvTemp, &
                           PlantLoop(BLASTAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
                           'InitBLASTAbsorberModel')
    BLASTAbsorber(ChillNum)%CondMassFlowRateMax = rho * BLASTAbsorber(ChillNum)%CondVolFlowRate
    CALL InitComponentNodes(0.d0, BLASTAbsorber(ChillNum)%CondMassFlowRateMax, &
                            CondInletNode, CondOutletNode, &
                            BLASTAbsorber(ChillNum)%CDLoopNum, &
                            BLASTAbsorber(ChillNum)%CDLoopSideNum, &
                            BLASTAbsorber(ChillNum)%CDBranchNum, &
                            BLASTAbsorber(ChillNum)%CDCompNum)
    Node(CondInletNode)%Temp = BLASTAbsorber(ChillNum)%TempDesCondIn
    IF (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
      IF(BLASTAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
        rho = GetDensityGlycol(PlantLoop(BLASTAbsorber(ChillNum)%GenLoopNum)%FluidName, &
                               InitConvTemp, &
                               PlantLoop(BLASTAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
                               'InitBLASTAbsorberModel')
        BLASTAbsorber(ChillNum)%GenMassFlowRateMax = rho * BLASTAbsorber(ChillNum)%GeneratorVolFlowRate
      ELSEIF (BLASTAbsorber(ChillNum)%GenHeatSourceType == NodeType_Steam ) THEN
        QGenerator = (BLASTAbsorber(ChillNum)%SteamLoadCoef(1) + BLASTAbsorber(ChillNum)%SteamLoadCoef(2) + &
                      BLASTAbsorber(ChillNum)%SteamLoadCoef(3)) * BLASTAbsorber(ChillNum)%NomCap
        GeneratorInletNode = BLASTAbsorber(ChillNum)%GeneratorInletNodeNum
        EnthSteamOutDry   = GetSatEnthalpyRefrig('STEAM',Node(GeneratorInletNode)%Temp,1.0d0, &
                                                 BLASTAbsorber(ChillNum)%SteamFluidIndex, &
                                                 'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
        EnthSteamOutWet   = GetSatEnthalpyRefrig('STEAM',Node(GeneratorInletNode)%Temp,0.0d0, &
                                                 BLASTAbsorber(ChillNum)%SteamFluidIndex, &
                                                 'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
        SteamDeltaT       = BLASTAbsorber(ChillNum)%GeneratorSubCool
        SteamOutletTemp   = Node(GeneratorInletNode)%Temp - SteamDeltaT
        HfgSteam          = EnthSteamOutDry - EnthSteamOutWet
        SteamDensity      = GetSatDensityRefrig('STEAM',Node(GeneratorInletNode)%Temp,1.0d0, &
                                                 BLASTAbsorber(ChillNum)%SteamFluidIndex, &
                                                'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
        CpWater           = GetDensityGlycol('WATER', SteamOutletTemp, DummyWaterIndex,  &
                            'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
        BLASTAbsorber(ChillNum)%GenMassFlowRateMax = QGenerator/(HfgSteam+CpWater*SteamDeltaT)
      ENDIF
      CALL InitComponentNodes(0.d0, BLASTAbsorber(ChillNum)%GenMassFlowRateMax, &
                              BLASTAbsorber(ChillNum)%GeneratorInletNodeNum, &
                              BLASTAbsorber(ChillNum)%GeneratorOutletNodeNum, &
                              BLASTAbsorber(ChillNum)%GenLoopNum, &
                              BLASTAbsorber(ChillNum)%GenLoopSideNum, &
                              BLASTAbsorber(ChillNum)%GenBranchNum, &
                              BLASTAbsorber(ChillNum)%GenCompNum)
    ENDIF
    MyEnvrnFlag(ChillNum) = .FALSE.
  END IF
  IF (.not. BeginEnvrnFlag) THEN
    MyEnvrnFlag(ChillNum)=.true.
  ENDIF
  ! every time inits
  IF ((BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated)  &
      .AND. BLASTAbsorber(ChillNum)%ModulatedFlowSetToLoop) THEN
  ! fix for clumsy old input that worked because loop setpoint was spread.
  !  could be removed with transition, testing , model change, period of being obsolete.
    Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint =                        &
         Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
    Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi =                        &
         Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
  ENDIF
  IF ((MyLoad < 0.d0) .AND. RunFlag)  THEN
    mdotEvap = BLASTAbsorber(ChillNum)%EvapMassFlowRateMax
    mdotCond = BLASTAbsorber(ChillNum)%CondMassFlowRateMax
    mdotGen  = BLASTAbsorber(ChillNum)%GenMassFlowRateMax
  ELSE
    mdotEvap = 0.d0
    mdotCond = 0.d0
    mdotGen  = 0.d0
  ENDIF
  CALL SetComponentFlowRate( mdotEvap, &
                              BLASTAbsorber(ChillNum)%EvapInletNodeNum, &
                              BLASTAbsorber(ChillNum)%EvapOutletNodeNum,&
                              BLASTAbsorber(ChillNum)%CWLoopNum,     &
                              BLASTAbsorber(ChillNum)%CWLoopSideNum, &
                              BLASTAbsorber(ChillNum)%CWBranchNum,   &
                              BLASTAbsorber(ChillNum)%CWCompNum)
  CALL SetComponentFlowRate( mdotCond, CondInletNode, CondOutletNode,  &
                                BLASTAbsorber(ChillNum)%CDLoopNum,     &
                                BLASTAbsorber(ChillNum)%CDLoopSideNum, &
                                BLASTAbsorber(ChillNum)%CDBranchNum,   &
                                BLASTAbsorber(ChillNum)%CDCompNum)
  IF (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
    CALL SetComponentFlowRate( mdotGen, &
                                BLASTAbsorber(ChillNum)%GeneratorInletNodeNum,  &
                                BLASTAbsorber(ChillNum)%GeneratorOutletNodeNum, &
                                BLASTAbsorber(ChillNum)%GenLoopNum,     &
                                BLASTAbsorber(ChillNum)%GenLoopSideNum, &
                                BLASTAbsorber(ChillNum)%GenBranchNum,   &
                                BLASTAbsorber(ChillNum)%GenCompNum)
  ENDIF
  RETURN
END SUBROUTINE InitBLASTAbsorberModel