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.
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 GetCoolBeams
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN Feb 3, 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for cool beam units and stores it in the
! cool beam unit data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, GetObjectDefMaxArgs
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet, SetUpCompSets
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataSizing
USE DataDefineEquip, ONLY: AirDistUnit, NumAirDistUnits
USE WaterCoils, ONLY: GetCoilWaterInletNode
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER (len=*), PARAMETER :: RoutineName='GetCoolBeams ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
INTEGER :: CBIndex ! loop index
INTEGER :: CBNum ! current fan coil number
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas ! Alpha input items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers ! Numeric input items for object
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
INTEGER :: NumAlphas=0 ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers=0 ! Number of Numbers for each GetObjectItem call
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! certain object in the input file
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: CtrlZone ! controlled zome do loop index
INTEGER :: SupAirIn ! controlled zone supply air inlet index
LOGICAL :: AirNodeFound
INTEGER :: ADUNum
! find the number of cooled beam units
CurrentModuleObject = 'AirTerminal:SingleDuct:ConstantVolume:CooledBeam'
NumCB = GetNumObjectsFound(CurrentModuleObject)
! allocate the data structures
ALLOCATE(CoolBeam(NumCB))
ALLOCATE(CheckEquipName(NumCB))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
NumAlphas = 7
NumNumbers = 16
TotalArgs = 23
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(Numbers(NumNumbers))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.true.
! loop over cooled beam units; get and load the input data
DO CBIndex = 1,NumCB
CALL GetObjectItem(CurrentModuleObject,CBIndex,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
CBNum = CBIndex
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(Alphas(1),CoolBeam%Name,CBNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
CoolBeam(CBNum)%Name = Alphas(1)
CoolBeam(CBNum)%UnitType = CurrentModuleObject
CoolBeam(CBNum)%UnitType_Num = 1
CoolBeam(CBNum)%CBType = TRIM(Alphas(3))
IF (SameString(CoolBeam(CBNum)%CBType,'Passive')) THEN
CoolBeam(CBNum)%CBType_Num = Passive_Cooled_Beam
ELSE IF (SameString(CoolBeam(CBNum)%CBType,'Active')) THEN
CoolBeam(CBNum)%CBType_Num = Active_Cooled_Beam
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFields(3))//' = '//TRIM(CoolBeam(CBNum)%CBType)//'.')
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(CoolBeam(CBNum)%Name))
ErrorsFound=.true.
END IF
CoolBeam(CBNum)%Sched = Alphas(2)
IF (lAlphaBlanks(2)) THEN
CoolBeam(CBNum)%SchedPtr = ScheduleAlwaysOn
ELSE
CoolBeam(CBNum)%SchedPtr = GetScheduleIndex(Alphas(2)) ! convert schedule name to pointer
IF (CoolBeam(CBNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': invalid '//TRIM(cAlphaFields(2))// &
' entered ='//TRIM(Alphas(2))// &
' for '//TRIM(cAlphaFields(1))//'='//TRIM(Alphas(1)))
ErrorsFound=.TRUE.
END IF
END IF
CoolBeam(CBNum)%AirInNode = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent,cAlphaFields(4))
CoolBeam(CBNum)%AirOutNode = &
GetOnlySingleNode(Alphas(5),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent,cAlphaFields(5))
CoolBeam(CBNum)%CWInNode = &
GetOnlySingleNode(Alphas(6),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Water,NodeConnectionType_Inlet,2,ObjectIsNotParent,cAlphaFields(6))
CoolBeam(CBNum)%CWOutNode = &
GetOnlySingleNode(Alphas(7),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Water,NodeConnectionType_Outlet,2,ObjectIsNotParent,cAlphaFields(7))
CoolBeam(CBNum)%MaxAirVolFlow = Numbers(1)
CoolBeam(CBNum)%MaxCoolWaterVolFlow = Numbers(2)
CoolBeam(CBNum)%NumBeams = Numbers(3)
CoolBeam(CBNum)%BeamLength = Numbers(4)
CoolBeam(CBNum)%DesInletWaterTemp = Numbers(5)
CoolBeam(CBNum)%DesOutletWaterTemp = Numbers(6)
CoolBeam(CBNum)%CoilArea = Numbers(7)
CoolBeam(CBNum)%a = Numbers(8)
CoolBeam(CBNum)%n1 = Numbers(9)
CoolBeam(CBNum)%n2 = Numbers(10)
CoolBeam(CBNum)%n3 = Numbers(11)
CoolBeam(CBNum)%a0 = Numbers(12)
CoolBeam(CBNum)%K1 = Numbers(13)
CoolBeam(CBNum)%n = Numbers(14)
CoolBeam(CBNum)%Kin = Numbers(15)
CoolBeam(CBNum)%InDiam = Numbers(16)
! Register component set data
CALL TestCompSet(TRIM(CurrentModuleObject),CoolBeam(CBNum)%Name, &
NodeID(CoolBeam(CBNum)%AirInNode),NodeID(CoolBeam(CBNum)%AirOutNode),'Air Nodes')
CALL TestCompSet(TRIM(CurrentModuleObject),CoolBeam(CBNum)%Name, &
NodeID(CoolBeam(CBNum)%CWInNode),NodeID(CoolBeam(CBNum)%CWOutNode),'Water Nodes')
!Setup the Cooled Beam reporting variables
CALL SetupOutputVariable('Zone Air Terminal Beam Sensible Cooling Energy [J]', CoolBeam(CBNum)%BeamCoolingEnergy, &
'System','Sum',CoolBeam(CBNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='COOLINGCOILS',GroupKey='System')
CALL SetupOutputVariable('Zone Air Terminal Beam Chilled Water Energy [J]', CoolBeam(CBNum)%BeamCoolingEnergy, &
'System','Sum',CoolBeam(CBNum)%Name, &
ResourceTypeKey='PLANTLOOPCOOLINGDEMAND',EndUseKey='COOLINGCOILS',GroupKey='System')
CALL SetupOutputVariable('Zone Air Terminal Beam Sensible Cooling Rate [W]', CoolBeam(CBNum)%BeamCoolingRate, &
'System','Average',CoolBeam(CBNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Supply Air Sensible Cooling Energy [J]', CoolBeam(CBNum)%SupAirCoolingEnergy, &
'System','Sum',CoolBeam(CBNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Supply Air Sensible Cooling Rate [W]', CoolBeam(CBNum)%SupAirCoolingRate, &
'System','Average',CoolBeam(CBNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Supply Air Sensible Heating Energy [J]', CoolBeam(CBNum)%SupAirHeatingEnergy, &
'System','Sum',CoolBeam(CBNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Supply Air Sensible Heating Rate [W]', CoolBeam(CBNum)%SupAirHeatingRate, &
'System','Average',CoolBeam(CBNum)%Name)
! Fill the Zone Equipment data with the supply air inlet node number of this unit.
AirNodeFound=.false.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (CoolBeam(CBNum)%AirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(SupAirIn)) THEN
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = CoolBeam(CBNum)%AirInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = CoolBeam(CBNum)%AirOutNode
AirNodeFound=.true.
EXIT
END IF
END DO
END DO
IF (.not. AirNodeFound) THEN
CALL ShowSevereError('The outlet air node from the '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(CoolBeam(CBNum)%Name))
CALL ShowContinueError('did not have a matching Zone Equipment Inlet Node, Node ='//TRIM(Alphas(5)))
ErrorsFound=.true.
ENDIF
END DO
DO CBNum = 1,NumCB
DO ADUNum = 1,NumAirDistUnits
IF (CoolBeam(CBNum)%AirOutNode == AirDistUnit(ADUNum)%OutletNodeNum) THEN
CoolBeam(CBNum)%ADUNum = ADUNum
END IF
END DO
! one assumes if there isn't one assigned, it's an error?
IF (CoolBeam(CBNum)%ADUNum == 0) THEN
CALL ShowSevereError(RoutineName//'No matching Air Distribution Unit, for Unit = ['// &
TRIM(CurrentModuleObject)//','//TRIM(CoolBeam(CBNum)%Name)//'].')
CALL ShowContinueError('...should have outlet node='//TRIM(NodeID(CoolBeam(CBNum)%AirOutNode)))
! ErrorsFound=.true.
ENDIF
END DO
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting input. Preceding conditions cause termination.')
END IF
RETURN
END SUBROUTINE GetCoolBeams