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 | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in), | DIMENSION(:) | :: | SurfaceTemperatures | ||
integer, | intent(in), | optional | :: | ZoneToResimulate |
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 InitInteriorConvectionCoeffs(SurfaceTemperatures,ZoneToResimulate)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN March 1998
! MODIFIED Dan Fisher, Nov 2000
! Sep 2011 LKL/BG - resimulate only zones needing it for Radiant systems
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the arrays associated with interior
! surface convection. The main parameter which is initialized
! in this routine is HConvIn, the convection coefficient on the
! inside surface.
! METHODOLOGY EMPLOYED:
! Determine the temperature difference between the surface and the
! zone air for the last time step and then base the calculation
! of the convection coefficient on that value and the surface tilt.
! REFERENCES:
! (I)BLAST legacy routine VARTMP
! 1. Passive Solar Extension of the BLAST Program
! Appendix E. p. 17,18
! 2. ASHRAE
! Simple Algorithm: ASHRAE Handbook of Fundamentals 1985, p. 23.2, Table 1
! Detailed Algorithm: ASHRAE Handbook of Fundamentals 2001, p. 3.12, Table 5
! 3. Walton, G. N. 1983. Thermal Analysis Research Program (TARP) Reference Manual,
! NBSSIR 83-2655, National Bureau of Standards, "Surface Inside Heat Balances", pp 79-80
! 4. Fisher, D.E. and C.O. Pedersen, Convective Heat Transfer in Building Energy and
! Thermal Load Calculations, ASHRAE Transactions, vol. 103, Pt. 2, 1997, p.137
! 5. ISO Standard 15099:2003e
! USE STATEMENTS:
USE DataHeatBalFanSys, ONLY: MAT
USE DataHeatBalance, ONLY: Construct
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled, ZoneEquipSimulatedOnce
USE DataGlobals, ONLY: BeginEnvrnFlag
USE DataLoopNode, ONLY: Node, NumOfNodes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), DIMENSION(:), INTENT(IN) :: SurfaceTemperatures ! Temperature of surfaces for evaluation of HcIn
INTEGER, INTENT(IN), OPTIONAL :: ZoneToResimulate ! if passed in, then only calculate surfaces that have this zone
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum ! DO loop counter for zones
INTEGER :: SurfNum ! DO loop counter for surfaces in zone
LOGICAL,SAVE :: NodeCheck=.true. ! for CeilingDiffuser Zones
LOGICAL,SAVE :: ActiveSurfaceCheck=.TRUE. ! for radiant surfaces in zone
LOGICAL, SAVE :: MyEnvirnFlag = .TRUE.
! FLOW:
IF (GetUserSuppliedConvectionCoeffs) THEN
CALL GetUserConvectionCoefficients
GetUserSuppliedConvectionCoeffs=.false.
ENDIF
IF (NodeCheck) THEN ! done once when conditions are ready...
IF (.not. SysSizingCalc .AND. .not. ZoneSizingCalc .AND. ZoneEquipInputsFilled .and. ALLOCATED(Node)) THEN
NodeCheck=.false.
DO ZoneNum=1,NumOfZones
IF (Zone(ZoneNum)%InsideConvectionAlgo /= CeilingDiffuser) CYCLE
IF (Zone(ZoneNum)%SystemZoneNodeNumber /= 0) CYCLE
CALL ShowSevereError('InitInteriorConvectionCoeffs: Inside Convection=CeilingDiffuser, '// &
'but no system inlet node defined, Zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('Defaulting inside convection to TARP. Check ZoneHVAC:EquipmentConnections for Zone='// &
TRIM(Zone(ZoneNum)%Name))
Zone(ZoneNum)%InsideConvectionAlgo=ASHRAETARP
ENDDO
!insert one-time setup for adpative inside face
ENDIF
ENDIF
IF (ActiveSurfaceCheck .AND. .NOT. SysSizingCalc .AND. .NOT. ZoneSizingCalc .AND. ZoneEquipSimulatedOnce) THEN
CALL SetupAdaptiveConvectionRadiantSurfaceData
ActiveSurfaceCheck = .FALSE.
ENDIF
IF (BeginEnvrnFlag .AND. MyEnvirnFlag) THEN
IF (ANY(Surface%IntConvCoeff == AdaptiveConvectionAlgorithm) .OR. &
ANY(Zone%InsideConvectionAlgo== AdaptiveConvectionAlgorithm)) THEN
!need to clear out node conditions because dynamic assignments will be affected
IF (NumOfNodes > 0 .AND. ALLOCATED(Node)) THEN
Node%Temp = DefaultNodeValues%Temp
Node%TempMin = DefaultNodeValues%TempMin
Node%TempMax = DefaultNodeValues%TempMax
Node%TempSetPoint = DefaultNodeValues%TempSetPoint
Node%MassFlowRate = DefaultNodeValues%MassFlowRate
Node%MassFlowRateMin = DefaultNodeValues%MassFlowRateMin
Node%MassFlowRateMax = DefaultNodeValues%MassFlowRateMax
Node%MassFlowRateMinAvail = DefaultNodeValues%MassFlowRateMinAvail
Node%MassFlowRateMaxAvail = DefaultNodeValues%MassFlowRateMaxAvail
Node%MassFlowRateSetPoint = DefaultNodeValues%MassFlowRateSetPoint
Node%Quality = DefaultNodeValues%Quality
Node%Press = DefaultNodeValues%Press
Node%Enthalpy = DefaultNodeValues%Enthalpy
Node%HumRat = DefaultNodeValues%HumRat
Node%HumRatMin = DefaultNodeValues%HumRatMin
Node%HumRatMax = DefaultNodeValues%HumRatMax
Node%HumRatSetPoint = DefaultNodeValues%HumRatSetPoint
Node%TempSetPointHi = DefaultNodeValues%TempSetPointHi
Node%TempSetPointLo = DefaultNodeValues%TempSetPointLo
IF (ALLOCATED(MoreNodeInfo)) THEN
MoreNodeInfo%WetbulbTemp = DefaultNodeValues%Temp
MoreNodeInfo%RelHumidity = 0.0d0
MoreNodeInfo%ReportEnthalpy = DefaultNodeValues%Enthalpy
MoreNodeInfo%VolFlowRateStdRho = 0.0d0
MoreNodeInfo%VolFlowRateCrntRho= 0.0d0
MoreNodeInfo%Density = 0.0d0
ENDIF
ENDIF
ENDIF
MyEnvirnFlag = .FALSE.
ENDIF
IF (.NOT. BeginEnvrnFlag) MyEnvirnFlag = .TRUE.
ZoneLoop1: DO ZoneNum = 1, NumOfZones
SELECT CASE (Zone(ZoneNum)%InsideConvectionAlgo)
! Ceiling Diffuser and Trombe Wall only make sense at Zone Level
! Interior convection coeffs are first calculated here and then at surface level
CASE (CeilingDiffuser)
CALL CalcCeilingDiffuserIntConvCoeff(ZoneNum)
CASE (TrombeWall)
CALL CalcTrombeWallIntConvCoeff(ZoneNum,SurfaceTemperatures)
CASE DEFAULT
END SELECT
END DO ZoneLoop1
ZoneLoop2: DO ZoneNum = 1, NumOfZones
SurfLoop: DO SurfNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF (.NOT. Surface(SurfNum)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (PRESENT(ZoneToResimulate)) THEN
IF ((ZoneNum /= ZoneToResimulate) .AND. (AdjacentZoneToSurface(SurfNum) /= ZoneToResimulate)) THEN
CYCLE ! skip surfaces that are not associated with this zone
ENDIF
ENDIF
SELECT CASE(Surface(SurfNum)%IntConvCoeff)
CASE(:-1) ! Set by user using one of the standard algorithms...
SELECT CASE (ABS(Surface(SurfNum)%IntConvCoeff))
CASE (ASHRAESimple)
CALL CalcASHRAESimpleIntConvCoeff(SurfNum,SurfaceTemperatures(SurfNum),MAT(ZoneNum))
! Establish some lower limit to avoid a zero convection coefficient (and potential divide by zero problems)
IF (HConvIn(SurfNum) < LowHConvLimit) HConvIn(SurfNum) = LowHConvLimit
CASE (ASHRAETARP)
IF (.NOT. Construct(Surface(SurfNum)%Construction)%TypeIsWindow) THEN
CALL CalcASHRAEDetailedIntConvCoeff(SurfNum,SurfaceTemperatures(SurfNum),MAT(ZoneNum))
ELSE
CALL CalcISO15099WindowIntConvCoeff(SurfNum,SurfaceTemperatures(SurfNum),MAT(ZoneNum))
ENDIF
! Establish some lower limit to avoid a zero convection coefficient (and potential divide by zero problems)
IF (HConvIn(SurfNum) < LowHConvLimit) HConvIn(SurfNum) = LowHConvLimit
CASE (AdaptiveConvectionAlgorithm)
CALL ManageInsideAdaptiveConvectionAlgo(SurfNum)
CASE DEFAULT
CALL ShowFatalError('Unhandled convection coefficient algorithm.')
END SELECT
CASE(0) ! Not set by user, uses Zone Setting
SELECT CASE (Zone(ZoneNum)%InsideConvectionAlgo)
CASE (ASHRAESimple)
CALL CalcASHRAESimpleIntConvCoeff(SurfNum,SurfaceTemperatures(SurfNum),MAT(ZoneNum))
! Establish some lower limit to avoid a zero convection coefficient (and potential divide by zero problems)
IF (HConvIn(SurfNum) < LowHConvLimit) HConvIn(SurfNum) = LowHConvLimit
CASE (ASHRAETARP)
IF (.NOT. Construct(Surface(SurfNum)%Construction)%TypeIsWindow) THEN
CALL CalcASHRAEDetailedIntConvCoeff(SurfNum,SurfaceTemperatures(SurfNum),MAT(ZoneNum))
ELSE
CALL CalcISO15099WindowIntConvCoeff(SurfNum,SurfaceTemperatures(SurfNum),MAT(ZoneNum))
ENDIF
! Establish some lower limit to avoid a zero convection coefficient (and potential divide by zero problems)
IF (HConvIn(SurfNum) < LowHConvLimit) HConvIn(SurfNum) = LowHConvLimit
CASE (AdaptiveConvectionAlgorithm)
CALL ManageInsideAdaptiveConvectionAlgo(SurfNum)
CASE (CeilingDiffuser,TrombeWall)
! Already done above and can't be at individual surface
CASE DEFAULT
CALL ShowFatalError('Unhandled convection coefficient algorithm.')
END SELECT
CASE DEFAULT ! Interior convection has been set by the user with "value" or "schedule"
HConvIn(SurfNum)=SetIntConvectionCoeff(SurfNum)
! Establish some lower limit to avoid a zero convection coefficient (and potential divide by zero problems)
IF (HConvIn(SurfNum) < LowHConvLimit) HConvIn(SurfNum) = LowHConvLimit
END SELECT
IF (Surface(SurfNum)%EMSOverrideIntConvCoef) HConvIn(SurfNum) = Surface(SurfNum)%EMSValueForIntConvCoef
END DO SurfLoop
END DO ZoneLoop2
RETURN
END SUBROUTINE InitInteriorConvectionCoeffs