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 |
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 CalcUCSDCV(ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR G. Carrilho da Graca
! DATE WRITTEN October 2004
! MODIFIED 8/2013 - Sam Brunswick
! To incorporate improved temperature calculations
! RE-ENGINEERED -
! PURPOSE OF THIS SUBROUTINE:
! Subroutine for cross ventilation modelling.
!
! METHODOLOGY EMPLOYED:
! -
! -
! -
! -
! REFERENCES:
! Model developed by Paul Linden (UCSD), G. Carrilho da Graca (UCSD) and P. Haves (LBL).
! Work funded by the California Energy Comission. More information on the model can found in:
! "Simplified Models for Heat Transfer in Rooms" G. Carrilho da Graça, Ph.D. thesis UCSD. December 2003.
! USE STATEMENTS:
USE DataHeatBalFanSys
USE DataEnvironment
USE DataHeatBalance
USE InputProcessor
USE ScheduleManager, ONLY: GetScheduleIndex, GetCurrentScheduleValue
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW, PsyCpAirFnWTdb
USE DataHVACGlobals, ONLY: TimestepSys
USE InternalHeatGains, ONLY: SumAllInternalConvectionGains, SumAllReturnAirConvectionGains
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ZoneNum ! Which Zonenum
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: Sigma=10.0d0
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: GainsFrac ! Fraction of lower subzone internal gains that mix as opposed to forming plumes
REAL(r64) :: ConvGains ! Total convective gains in the room
REAL(r64) :: ConvGainsJet ! Total convective gains released in jet subzone
REAL(r64) :: ConvGainsRec ! Total convective gains released in recirculation subzone
REAL(r64) :: MCP_Total ! Total capacity rate into the zone - assumed to enter at low level
REAL(r64) :: ZTAveraged
INTEGER :: CTD
REAL(r64) :: VolOverAin
REAL(r64) :: MCpT_Total
REAL(r64) :: L
REAL(r64) :: ZoneMult ! total zone multiplier
REAL(r64) :: RetAirConvGain
GainsFrac=0.0d0
ZoneMult = Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier
DO Ctd=1,TotUCSDCV
IF(ZoneNum == ZoneUCSDCV(Ctd)%ZonePtr) THEN
GainsFrac = GetCurrentScheduleValue(ZoneUCSDCV(Ctd)%SchedGainsPtr)
ENDIF
ENDDO
CALL SumAllInternalConvectionGains(ZoneNum, ConvGains)
ConvGains = ConvGains &
+ SumConvHTRadSys(ZoneNum) &
+ SysDepZoneLoadsLagged(ZoneNum) + NonAirSystemResponse(ZoneNum)/ZoneMult
! Add heat to return air if zonal system (no return air) or cycling system (return air frequently very
! low or zero)
IF (Zone(ZoneNum)%NoHeatToReturnAir) THEN
CALL SumAllReturnAirConvectionGains(ZoneNum, RetAirConvGain )
ConvGains = ConvGains + RetAirConvGain
END IF
ConvGainsJet = ConvGains*GainsFrac
ConvGainsRec = ConvGains*(1.d0-GainsFrac)
MCP_Total = MCPI(ZoneNum) + MCPV(ZoneNum) + MCPM(ZoneNum) + MCPE(ZoneNum) + MCPC(ZoneNum) + MdotCPOA(ZoneNum)
MCpT_Total = MCPTI(ZoneNum) + MCPTV(ZoneNum) + MCPTM(ZoneNum) + MCPTE(ZoneNum) + MCPTC(ZoneNum) + &
MdotCPOA(ZoneNum)*Zone(ZoneNum)%OutDryBulbTemp
IF (SimulateAirflowNetwork == AirflowNetworkControlMultizone) THEN
MCP_Total = AirflowNetworkExchangeData(ZoneNum)%SumMCp+AirflowNetworkExchangeData(ZoneNum)%SumMMCp
MCpT_Total = AirflowNetworkExchangeData(ZoneNum)%SumMCpT+AirflowNetworkExchangeData(ZoneNum)%SumMMCpT
END IF
CALL EvolveParaUCSDCV(ZoneNum)
L=Droom(ZoneNum)
IF (AirModel(ZoneNum)%SimAirModel) THEN
!=============================== CROSS VENTILATION Calculation ==============================================
ZoneCVisMixing(ZoneNum)=0.0d0
ZoneCVhasREC(ZoneNum)=1.0d0
DO Ctd = 1,4
CALL HcUCSDCV(ZoneNum)
IF (JetRecAreaRatio(ZoneNum)/=1.0d0) THEN
ZTREC(ZoneNum) =(ConvGainsRec*CrecTemp + CrecTemp*HAT_R + Tin(ZoneNum)*MCp_Total)/(CrecTemp*HA_R + MCp_Total)
ENDIF
ZTJET(ZoneNum) = (ConvGainsJet*CjetTemp + ConvGainsRec*CjetTemp +CjetTemp*HAT_J + CjetTemp*HAT_R + Tin(ZoneNum)*MCp_Total &
- CjetTemp*HA_R*ZTREC(ZoneNum)) / (CjetTemp*HA_J + MCp_Total)
RoomOutflowTemp(ZoneNum) = (ConvGainsJet + ConvGainsRec + HAT_J + HAT_R + Tin(ZoneNum)*MCp_Total - &
HA_J*ZTJET(ZoneNum) - HA_R*ZTREC(ZoneNum))/ MCp_Total
END DO
IF (JetRecAreaRatio(ZoneNum)==1.0d0) THEN
ZoneCVhasREC(ZoneNum)=0.0d0
ZTREC(ZoneNum)=RoomOutflowTemp(ZoneNum)
ZTREC(ZoneNum)=ZTJET(ZoneNum)
ZTREC(ZoneNum)=ZTJET(ZoneNum)
ENDIF
! If temperature increase is above 1.5C then go to mixing
IF (RoomOutflowTemp(ZoneNum) - Tin(ZoneNum) > 1.5d0) THEN
ZoneCVisMixing(ZoneNum)=1.0d0
ZoneCVhasREC(ZoneNum)=0.0d0
AirModel(ZoneNum)%SimAirModel = .FALSE.
Ujet(ZoneNum)=0.0d0
Urec(ZoneNum)=0.0d0
Qrec(ZoneNum)=0.0d0
RecInflowRatio(ZoneNum)=0.0d0
CVJetRecFlows%Ujet=0.0d0
CVJetRecFlows%Urec=0.0d0
DO Ctd = 1,3
ZTAveraged=mat(zonenum)
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
CALL HcUCSDCV(ZoneNum)
ZTAveraged=mat(zonenum)
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
END DO
END IF
ELSE
!=============================== M I X E D Calculation ======================================================
ZoneCVisMixing(ZoneNum)=1.0d0
ZoneCVhasREC(ZoneNum)=0.0d0
Ujet(ZoneNum)=0.0d0
Urec(ZoneNum)=0.0d0
Qrec(ZoneNum)=0.0d0
RecInflowRatio(ZoneNum)=0.0d0
CVJetRecFlows%Ujet=0.0d0
CVJetRecFlows%Urec=0.0d0
DO Ctd = 1,3
ZTAveraged=mat(zonenum)
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
CALL HcUCSDCV(ZoneNum)
ZTAveraged=mat(zonenum)
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
RoomOutflowTemp(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
ZTJET(ZoneNum) = ZTAveraged
ZTREC(ZoneNum) = ZTAveraged
END DO
END IF
!============================================================================================================
RETURN
END SUBROUTINE CalcUCSDCV