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) | :: | ZoneNum | |||
integer, | intent(in) | :: | ZoneModelType |
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 SizeUCSDUF(ZoneNum,ZoneModelType)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN August 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! set some smart defaults for UFAD systems
! METHODOLOGY EMPLOYED:
! use data from Center for Built Environment
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing, ONLY: AutoSize
USE ReportSizingManager, ONLY: ReportSizingOutput
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER,INTENT (IN) :: ZoneNum
INTEGER, INTENT(IN) :: ZoneModelType ! type of zone model; UCSDUFI = 6
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: UINum ! index to underfloor interior zone model data
INTEGER :: Ctd=0 ! DO loop index
INTEGER :: SurfNum = 0 ! surface data structure index
REAL(r64) :: NumberOfOccupants = 0.0d0 ! design number of occupants in the zone
REAL(r64) :: NumberOfPlumes = 0.0d0 ! design number of plumes in the zone
REAL(r64) :: ZoneElecConv = 0.0d0 ! zone elec equip design convective gain [W]
REAL(r64) :: ZoneGasConv = 0.0d0 ! zone gas equip design convective gain [W]
REAL(r64) :: ZoneOthEqConv = 0.0d0 ! zone other equip design convective gain [W]
REAL(r64) :: ZoneHWEqConv = 0.0d0 ! zone hot water equip design convective gain [W]
REAL(r64) :: ZoneSteamEqConv = 0.0d0 ! zone steam equip design convective gain [W]
IF (ZoneModelType == RoomAirModel_UCSDUFI) THEN
UINum = ZoneUFPtr(ZoneNum)
NumberOfOccupants = 0.0d0
DO Ctd = 1,TotPeople
IF(People(Ctd)%ZonePtr == ZoneNum) THEN
NumberOfOccupants = NumberOfOccupants + People(Ctd)%NumberOfPeople
ENDIF
END DO
IF (ZoneUCSDUI(UINum)%DiffArea == AutoSize) THEN
IF (ZoneUCSDUI(UINum)%DiffuserType == Swirl) THEN
ZoneUCSDUI(UINum)%DiffArea = 0.0075d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == VarArea) THEN
ZoneUCSDUI(UINum)%DiffArea = .035d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == DisplVent) THEN
ZoneUCSDUI(UINum)%DiffArea = 0.0060d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == LinBarGrille) THEN
! 4 ft x 4 inches; 75 cfm per linear foot; area is .025 m2/m
ZoneUCSDUI(UINum)%DiffArea = .03d0
ELSE
ZoneUCSDUI(UINum)%DiffArea = 0.0075d0
END IF
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionInterior', ZoneUCSDUI(UINum)%ZoneName, &
'Design effective area of diffuser', ZoneUCSDUI(UINum)%DiffArea)
END IF
IF (ZoneUCSDUI(UINum)%DiffAngle == AutoSize) THEN
IF (ZoneUCSDUI(UINum)%DiffuserType == Swirl) THEN
ZoneUCSDUI(UINum)%DiffAngle = 28.d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == VarArea) THEN
ZoneUCSDUI(UINum)%DiffAngle = 45.d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == DisplVent) THEN
ZoneUCSDUI(UINum)%DiffAngle = 73.d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == LinBarGrille) THEN
ZoneUCSDUI(UINum)%DiffAngle = 15.d0
ELSE
ZoneUCSDUI(UINum)%DiffAngle = 28.d0
END IF
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionInterior', ZoneUCSDUI(UINum)%ZoneName, &
'Angle between diffuser slots and the vertical', ZoneUCSDUI(UINum)%DiffAngle)
END IF
IF (ZoneUCSDUI(UINum)%TransHeight == AutoSize) THEN
ZoneUCSDUI(UINum)%CalcTransHeight = .TRUE.
ZoneUCSDUI(UINum)%TransHeight = 0.0d0
ELSE
ZoneUCSDUI(UINum)%CalcTransHeight = .FALSE.
END IF
IF (ZoneUCSDUI(UINum)%DiffuserType == Swirl) THEN
IF (ZoneUCSDUI(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionInterior for Zone ' // &
TRIM(ZoneUCSDUI(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = Swirl.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUI(UINum)%A_Kc = 0.0d0
ZoneUCSDUI(UINum)%B_Kc = 0.0d0
ZoneUCSDUI(UINum)%C_Kc = 0.6531d0
ZoneUCSDUI(UINum)%D_Kc = 0.0069d0
ZoneUCSDUI(UINum)%E_Kc = -0.00004d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == VarArea) THEN
IF (ZoneUCSDUI(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionInterior for Zone ' // &
TRIM(ZoneUCSDUI(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = VariableArea.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUI(UINum)%A_Kc = 0.0d0
ZoneUCSDUI(UINum)%B_Kc = 0.0d0
ZoneUCSDUI(UINum)%C_Kc = 0.88d0
ZoneUCSDUI(UINum)%D_Kc = 0.0d0
ZoneUCSDUI(UINum)%E_Kc = 0.0d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == DisplVent) THEN
IF (ZoneUCSDUI(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionInterior for Zone ' // &
TRIM(ZoneUCSDUI(UINum)%ZoneName) // &
', input for ' // 'Coefficients A - E will be ignored when Floor Diffuser Type = HorizontalDisplacement.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUI(UINum)%A_Kc = 0.0d0
ZoneUCSDUI(UINum)%B_Kc = 0.0d0
ZoneUCSDUI(UINum)%C_Kc = 0.67d0
ZoneUCSDUI(UINum)%D_Kc = 0.0d0
ZoneUCSDUI(UINum)%E_Kc = 0.0d0
ELSE IF (ZoneUCSDUI(UINum)%DiffuserType == LinBarGrille) THEN
IF (ZoneUCSDUI(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUI(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionInterior for Zone ' // &
TRIM(ZoneUCSDUI(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = LinearBarGrille.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUI(UINum)%A_Kc = 0.0d0
ZoneUCSDUI(UINum)%B_Kc = 0.0d0
ZoneUCSDUI(UINum)%C_Kc = 0.8d0
ZoneUCSDUI(UINum)%D_Kc = 0.0d0
ZoneUCSDUI(UINum)%E_Kc = 0.0d0
ELSE
IF (ZoneUCSDUI(UINum)%A_Kc .EQ. AutoCalculate .OR. ZoneUCSDUI(UINum)%B_Kc .EQ. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%C_Kc .EQ. AutoCalculate .OR. ZoneUCSDUI(UINum)%D_Kc .EQ. AutoCalculate .OR. &
ZoneUCSDUI(UINum)%E_Kc .EQ. AutoCalculate) THEN
CALL ShowFatalError('For RoomAirSettings:UnderFloorAirDistributionInterior for Zone ' // &
TRIM(ZoneUCSDUI(UINum)%ZoneName) // &
', input for Coefficients A - E must be specified when Floor Diffuser Type = Custom.')
END IF
END IF
IF (ZoneUCSDUI(UINum)%PowerPerPlume == AutoCalculate) THEN
NumberOfPlumes = 0.0d0
IF (NumberOfOccupants > 0.0d0) THEN
NumberOfPlumes = NumberOfOccupants
ELSE
NumberOfPlumes = 1.0d0
END IF
ZoneElecConv = 0.0d0
DO Ctd=1,TotElecEquip
IF(ZoneElectric(Ctd)%ZonePtr == ZoneNum) THEN
ZoneElecConv = ZoneElecConv + ZoneElectric(Ctd)%DesignLevel * ZoneElectric(Ctd)%FractionConvected
ENDIF
END DO
ZoneGasConv = 0.0d0
DO Ctd=1,TotGasEquip
IF(ZoneGas(Ctd)%ZonePtr == ZoneNum) THEN
ZoneGasConv = ZoneGasConv + ZoneGas(Ctd)%DesignLevel * ZoneGas(Ctd)%FractionConvected
ENDIF
END DO
ZoneOthEqConv = 0.0d0
DO Ctd=1,TotOthEquip
IF(ZoneOtherEq(Ctd)%ZonePtr == ZoneNum) THEN
ZoneOthEqConv = ZoneOthEqConv + ZoneOtherEq(Ctd)%DesignLevel * ZoneOtherEq(Ctd)%FractionConvected
ENDIF
END DO
ZoneHWEqConv = 0.0d0
DO Ctd=1,TotHWEquip
IF(ZoneHWEq(Ctd)%ZonePtr == ZoneNum) THEN
ZoneHWEqConv = ZoneHWEqConv + ZoneHWEq(Ctd)%DesignLevel * ZoneHWEq(Ctd)%FractionConvected
ENDIF
END DO
DO Ctd=1,TotStmEquip
ZoneSteamEqConv = 0.0d0
IF(ZoneSteamEq(Ctd)%ZonePtr == ZoneNum) THEN
ZoneSteamEqConv = ZoneSteamEqConv + ZoneSteamEq(Ctd)%DesignLevel * ZoneSteamEq(Ctd)%FractionConvected
ENDIF
END DO
ZoneUCSDUI(UINum)%PowerPerPlume = (NumberOfOccupants*73.0d0 + ZoneElecConv + ZoneGasConv + ZoneOthEqConv + ZoneHWEqConv + &
ZoneSteamEqConv) / NumberOfPlumes
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionInterior', ZoneUCSDUI(UINum)%ZoneName, &
'Power per plume [W]', ZoneUCSDUI(UINum)%PowerPerPlume)
END IF
IF (ZoneUCSDUI(UINum)%DiffusersPerZone == AutoSize) THEN
IF (NumberOfOccupants > 0.0d0) THEN
ZoneUCSDUI(UINum)%DiffusersPerZone = NumberOfOccupants
ELSE
ZoneUCSDUI(UINum)%DiffusersPerZone = 1.0d0
END IF
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionInterior', ZoneUCSDUI(UINum)%ZoneName, &
'Number of diffusers per zone', ZoneUCSDUI(UINum)%DiffusersPerZone)
END IF
END IF
IF (ZoneModelType == RoomAirModel_UCSDUFE) THEN
UINum = ZoneUFPtr(ZoneNum)
! calculate total window width in zone
DO Ctd = PosZ_Window((ZoneNum-1)*2+1),PosZ_Window((ZoneNum-1)*2+2)
SurfNum = APos_Window(ctd)
If (SurfNum == 0) CYCLE
IF (Surface(SurfNum)%ExtBoundCond == ExternalEnvironment .or. Surface(SurfNum)%ExtBoundCond == OtherSideCoefNoCalcExt .or. &
Surface(SurfNum)%ExtBoundCond == OtherSideCoefCalcExt .or. Surface(SurfNum)%ExtBoundCond == OtherSideCondModeledExt) THEN
ZoneUCSDUE(UINum)%WinWidth = ZoneUCSDUE(UINum)%WinWidth + Surface(SurfNum)%Width
ZoneUCSDUE(UINum)%NumExtWin = ZoneUCSDUE(UINum)%NumExtWin + 1
END IF
END DO
IF (ZoneUCSDUE(UINum)%WinWidth <= 0.0d0) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionExterior for Zone ' // &
TRIM(ZoneUCSDUE(UINum)%ZoneName) // &
' there are no exterior windows.')
CALL ShowContinueError(' The zone will be treated as a UFAD interior zone')
END IF
NumberOfOccupants = 0.0d0
DO Ctd = 1,TotPeople
IF(People(Ctd)%ZonePtr == ZoneNum) THEN
NumberOfOccupants = NumberOfOccupants + People(Ctd)%NumberOfPeople
ENDIF
END DO
IF (ZoneUCSDUE(UINum)%DiffArea == AutoSize) THEN
IF (ZoneUCSDUE(UINum)%DiffuserType == Swirl) THEN
ZoneUCSDUE(UINum)%DiffArea = 0.0075d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == VarArea) THEN
ZoneUCSDUE(UINum)%DiffArea = 0.035d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == DisplVent) THEN
ZoneUCSDUE(UINum)%DiffArea = 0.0060d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == LinBarGrille) THEN
! 4 ft x 4 inches; eff area is 50% of total area; 75 cfm per linear foot.
ZoneUCSDUE(UINum)%DiffArea = 0.03d0
ELSE
ZoneUCSDUE(UINum)%DiffArea = 0.0075d0
END IF
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionExterior', ZoneUCSDUE(UINum)%ZoneName, &
'Design effective area of diffuser', ZoneUCSDUE(UINum)%DiffArea)
END IF
IF (ZoneUCSDUE(UINum)%DiffAngle == AutoSize) THEN
IF (ZoneUCSDUE(UINum)%DiffuserType == Swirl) THEN
ZoneUCSDUE(UINum)%DiffAngle = 28.d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == VarArea) THEN
ZoneUCSDUE(UINum)%DiffAngle = 45.d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == DisplVent) THEN
ZoneUCSDUE(UINum)%DiffAngle = 73.d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == LinBarGrille) THEN
ZoneUCSDUE(UINum)%DiffAngle = 15.d0
ELSE
ZoneUCSDUE(UINum)%DiffAngle = 28.d0
END IF
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionExterior', ZoneUCSDUE(UINum)%ZoneName, &
'Angle between diffuser slots and the vertical', ZoneUCSDUE(UINum)%DiffAngle)
END IF
IF (ZoneUCSDUE(UINum)%TransHeight == AutoSize) THEN
ZoneUCSDUE(UINum)%CalcTransHeight = .TRUE.
ZoneUCSDUE(UINum)%TransHeight = 0.0d0
ELSE
ZoneUCSDUE(UINum)%CalcTransHeight = .FALSE.
END IF
IF (ZoneUCSDUE(UINum)%DiffuserType == Swirl) THEN
IF (ZoneUCSDUE(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionExterior for Zone ' // &
TRIM(ZoneUCSDUE(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = Swirl.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUE(UINum)%A_Kc = 0.0d0
ZoneUCSDUE(UINum)%B_Kc = 0.0d0
ZoneUCSDUE(UINum)%C_Kc = 0.6531d0
ZoneUCSDUE(UINum)%D_Kc = 0.0069d0
ZoneUCSDUE(UINum)%E_Kc = -0.00004d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == VarArea) THEN
IF (ZoneUCSDUE(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionExterior for Zone ' // &
TRIM(ZoneUCSDUE(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = VariableArea.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUE(UINum)%A_Kc = 0.0d0
ZoneUCSDUE(UINum)%B_Kc = 0.0d0
ZoneUCSDUE(UINum)%C_Kc = 0.83d0
ZoneUCSDUE(UINum)%D_Kc = 0.0d0
ZoneUCSDUE(UINum)%E_Kc = 0.0d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == DisplVent) THEN
IF (ZoneUCSDUE(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionExterior for Zone ' // &
TRIM(ZoneUCSDUE(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = HorizontalDisplacement.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUE(UINum)%A_Kc = 0.0d0
ZoneUCSDUE(UINum)%B_Kc = 0.0d0
ZoneUCSDUE(UINum)%C_Kc = 0.67d0
ZoneUCSDUE(UINum)%D_Kc = 0.0d0
ZoneUCSDUE(UINum)%E_Kc = 0.0d0
ELSE IF (ZoneUCSDUE(UINum)%DiffuserType == LinBarGrille) THEN
IF (ZoneUCSDUE(UINum)%A_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%B_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%C_Kc .NE. AutoCalculate .OR. ZoneUCSDUE(UINum)%D_Kc .NE. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%E_Kc .NE. AutoCalculate) THEN
CALL ShowWarningError('For RoomAirSettings:UnderFloorAirDistributionExterior for Zone ' // &
TRIM(ZoneUCSDUE(UINum)%ZoneName) // &
', input for Coefficients A - E will be ignored when Floor Diffuser Type = LinearBarGrille.')
CALL ShowContinueError(' To input these Coefficients, use Floor Diffuser Type = Custom.')
END IF
ZoneUCSDUE(UINum)%A_Kc = 0.0d0
ZoneUCSDUE(UINum)%B_Kc = 0.0d0
ZoneUCSDUE(UINum)%C_Kc = 0.8214d0
ZoneUCSDUE(UINum)%D_Kc = -0.0263d0
ZoneUCSDUE(UINum)%E_Kc = 0.0014d0
ELSE
IF (ZoneUCSDUE(UINum)%A_Kc .EQ. AutoCalculate .OR. ZoneUCSDUE(UINum)%B_Kc .EQ. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%C_Kc .EQ. AutoCalculate .OR. ZoneUCSDUE(UINum)%D_Kc .EQ. AutoCalculate .OR. &
ZoneUCSDUE(UINum)%E_Kc .EQ. AutoCalculate) THEN
CALL ShowFatalError('For RoomAirSettings:UnderFloorAirDistributionExterior for Zone ' // &
TRIM(ZoneUCSDUE(UINum)%ZoneName) // &
', input for Coefficients A - E must be specified when Floor Diffuser Type = Custom.')
END IF
END IF
IF (ZoneUCSDUE(UINum)%PowerPerPlume == AutoCalculate) THEN
IF (NumberOfOccupants > 0) THEN
NumberOfPlumes = NumberOfOccupants
ELSE
NumberOfPlumes = 1.0d0
END IF
ZoneElecConv = 0.0d0
DO Ctd=1,TotElecEquip
IF(ZoneElectric(Ctd)%ZonePtr == ZoneNum) THEN
ZoneElecConv = ZoneElecConv + ZoneElectric(Ctd)%DesignLevel
ENDIF
END DO
ZoneGasConv = 0.0d0
DO Ctd=1,TotGasEquip
IF(ZoneGas(Ctd)%ZonePtr == ZoneNum) THEN
ZoneGasConv = ZoneGasConv + ZoneGas(Ctd)%DesignLevel
ENDIF
END DO
ZoneOthEqConv = 0.0d0
DO Ctd=1,TotOthEquip
IF(ZoneOtherEq(Ctd)%ZonePtr == ZoneNum) THEN
ZoneOthEqConv = ZoneOthEqConv + ZoneOtherEq(Ctd)%DesignLevel
ENDIF
END DO
ZoneHWEqConv = 0.0d0
DO Ctd=1,TotHWEquip
IF(ZoneHWEq(Ctd)%ZonePtr == ZoneNum) THEN
ZoneHWEqConv = ZoneHWEqConv + ZoneHWEq(Ctd)%DesignLevel
ENDIF
END DO
DO Ctd=1,TotStmEquip
ZoneSteamEqConv = 0.0d0
IF(ZoneSteamEq(Ctd)%ZonePtr == ZoneNum) THEN
ZoneSteamEqConv = ZoneSteamEqConv + ZoneSteamEq(Ctd)%DesignLevel
ENDIF
END DO
ZoneUCSDUE(UINum)%PowerPerPlume = (NumberOfOccupants*73.0d0 + ZoneElecConv + ZoneGasConv + ZoneOthEqConv + ZoneHWEqConv + &
ZoneSteamEqConv) / NumberOfPlumes
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionExterior', ZoneUCSDUE(UINum)%ZoneName, &
'Power per plume [W]', ZoneUCSDUE(UINum)%PowerPerPlume)
END IF
IF (ZoneUCSDUE(UINum)%DiffusersPerZone == AutoSize) THEN
IF (NumberOfOccupants > 0.0d0) THEN
ZoneUCSDUE(UINum)%DiffusersPerZone = NumberOfOccupants
ELSE
ZoneUCSDUE(UINum)%DiffusersPerZone = 1.0d0
END IF
CALL ReportSizingOutput('RoomAirSettings:UnderFloorAirDistributionExterior', ZoneUCSDUE(UINum)%ZoneName, &
'Number of diffusers per zone', ZoneUCSDUE(UINum)%DiffusersPerZone)
END IF
END IF
RETURN
END SUBROUTINE SizeUCSDUF