SUBROUTINE SharedDVCVUFDataInit(ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2005
! MODIFIED Aug, 2013, Sam Brunswick -- for RoomAirCrossCrossVent modifications
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine allocates and initializes(?) the data that is shared between the
! UCSD models (DV and CV)
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataUCSDSharedData
USE DataEnvironment
USE DataHeatBalFanSys
USE DataSurfaces
USE DataGlobals, ONLY : NumOfZones, MaxNameLength
USE DataInterfaces, ONLY : ShowWarningError, ShowFatalerror, ShowSevereError, ShowContinueError
USE DataHeatBalance, ONLY : Zone
USE DataAirflowNetwork
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW
USE DataZoneEquipment, ONLY: ZoneEquipConfig
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: ZoneNum
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64),PARAMETER :: BaseDischargeCoef = 0.62d0
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SurfNum ! DO loop counter for surfaces
INTEGER :: ZNum ! DO loop counter for zones
INTEGER :: contFloorBegin = 0 ! counter
INTEGER :: contFloorLast = 0 ! counter
INTEGER :: contFloor = 0 ! counter
INTEGER :: contCeilingBegin = 0 ! counter
INTEGER :: contCeilingLast = 0 ! counter
INTEGER :: contCeiling = 0 ! counter
INTEGER :: contWallBegin = 0 ! counter
INTEGER :: contWallLast = 0 ! counter
INTEGER :: contWall = 0 ! counter
INTEGER :: contWindowBegin = 0 ! counter
INTEGER :: contWindowLast = 0 ! counter
INTEGER :: contWindow = 0 ! counter
INTEGER :: contInternalBegin = 0 ! counter
INTEGER :: contInternalLast = 0 ! counter
INTEGER :: contInternal = 0 ! counter
INTEGER :: contDoorBegin = 0 ! counter
INTEGER :: contDoorLast = 0 ! counter
INTEGER :: contDoor = 0 ! counter
INTEGER :: Loop = 0 ! counter
INTEGER :: Loop2 = 0 ! counter
INTEGER :: i = 0 ! counter
INTEGER :: N = 0 ! counter
REAL(r64) :: Z1ZoneAux = 0.0d0 ! Auxiliary variables
REAL(r64) :: Z2ZoneAux = 0.0d0 ! Auxiliary variables
REAL(r64) :: Z1Zone = 0.0d0 ! Auxiliary variables
REAL(r64) :: Z2Zone = 0.0d0 ! Auxiliary variables
REAL(r64) :: CeilingHeightDiffMax = 0.1d0 ! Maximum difference between wall height and ceiling height
LOGICAL :: SetZoneAux
INTEGER, ALLOCATABLE, DIMENSION (:) :: AuxSurf
INTEGER :: MaxSurf
INTEGER, ALLOCATABLE, DIMENSION (:,:) :: AuxAirflowNetworkSurf
REAL(r64) :: WidthFactMax
REAL(r64) :: HeightFactMax
REAL(r64) :: WidthFact
REAL(r64) :: HeightFact
INTEGER :: Loop3 = 0 ! counter
INTEGER :: ZoneEquipConfigNum ! counter
REAL(r64) :: AinCV
INTEGER :: AirflowNetworkSurfPtr
INTEGER :: NSides
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
INTEGER :: CompNum = 0 ! AirflowNetwork Component number
INTEGER :: TypeNum = 0 ! Airflownetwork Type Number within a component
INTEGER :: NodeNum1 = 0 ! The first node number in an AirflowNetwork linkage data
INTEGER :: NodeNum2 = 0 ! The Second node number in an AirflowNetwork linkage data
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumOfZones))
ALLOCATE (APos_Wall(TotSurfaces))
ALLOCATE (APos_Floor(TotSurfaces))
ALLOCATE (APos_Ceiling(TotSurfaces))
ALLOCATE (PosZ_Wall(NumOfZones*2))
ALLOCATE (PosZ_Floor(NumOfZones*2))
ALLOCATE (PosZ_Ceiling(NumOfZones*2))
ALLOCATE (APos_Window(TotSurfaces))
ALLOCATE (APos_Door(TotSurfaces))
ALLOCATE (APos_Internal(TotSurfaces))
ALLOCATE (PosZ_Window(NumOfZones*2))
ALLOCATE (PosZ_Door(NumOfZones*2))
ALLOCATE (PosZ_Internal(NumOfZones*2))
ALLOCATE (Hceiling(TotSurfaces))
ALLOCATE (HWall(TotSurfaces))
ALLOCATE (HFloor(TotSurfaces))
ALLOCATE (HInternal(TotSurfaces))
ALLOCATE (HWindow(TotSurfaces))
ALLOCATE (HDoor(TotSurfaces))
ALLOCATE (AuxSurf(NumOfZones))
ALLOCATE (ZoneCeilingHeight(NumOfZones*2))
ZoneCeilingHeight=0.0d0
! Arrays initializations
APos_Wall = 0
APos_Floor = 0
APos_Ceiling = 0
PosZ_Wall = 0
PosZ_Floor = 0
PosZ_Ceiling = 0
APos_Window = 0
APos_Door = 0
APos_Internal = 0
PosZ_Window = 0
PosZ_Door = 0
PosZ_Internal = 0
Hceiling = 0.0d0
HWall = 0.0d0
HFloor = 0.0d0
HInternal = 0.0d0
HWindow = 0.0d0
HDoor = 0.0d0
! Put the surface and zone information in Apos and PosZ arrays
DO ZNum = 1,NumOfZones
! advance ONE position in the arrays PosZ because this is a new zone
contWallBegin = contWall + 1
contFloorBegin = contFloor + 1
contCeilingBegin = contCeiling + 1
contWindowBegin = contWindow + 1
contInternalBegin = contInternal + 1
contDoorBegin = contDoor + 1
SetZoneAux = .true.
! cycle in this zone for all the surfaces
DO SurfNum = Zone(ZNum)%SurfaceFirst,Zone(ZNum)%SurfaceLast
IF (Surface(SurfNum)%Class /= SurfaceClass_IntMass) THEN
! Recalculate lowest and highest height for the zone
Z1Zone = MINVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
Z2Zone = MAXVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
ENDIF
IF (SetZoneAux) THEN
! lowest height for the zone (for the first surface of the zone)
Z1ZoneAux = Z1Zone
! highest height for the zone (for the first surface of the zone)
Z2ZoneAux = Z2Zone
SetZoneAux=.false.
ENDIF
IF(Z1Zone < Z1ZoneAux) THEN
Z1ZoneAux = Z1Zone
ENDIF
IF(Z2Zone > Z2ZoneAux) THEN
Z2ZoneAux = Z2Zone
ENDIF
Z1Zone = Z1ZoneAux
Z2Zone = Z2ZoneAux
! Put the reference to this surface in the appropriate array
IF (Surface(SurfNum)%Class .eq. SurfaceClass_Floor) THEN
contFloor = contFloor + 1
APos_Floor(contFloor) = SurfNum
ELSEIF (Surface(SurfNum)%Class .eq. SurfaceClass_Wall) THEN
contWall = contWall + 1
APos_Wall(contWall) = SurfNum
ELSEIF(Surface(SurfNum)%Class .eq. SurfaceClass_Window)THEN
contWindow = contWindow + 1
APos_Window(contWindow) = SurfNum
ELSEIF(Surface(SurfNum)%Class .eq. SurfaceClass_IntMass)THEN
contInternal = contInternal + 1
APos_Internal(contInternal) = SurfNum
ELSEIF(Surface(SurfNum)%Class .eq. SurfaceClass_Door)THEN
contDoor = contDoor + 1
APos_Door(contDoor) = SurfNum
ELSE
contCeiling = contCeiling + 1
APos_Ceiling(contCeiling) = SurfNum
END IF
END DO ! Surfaces
contWallLast = contWall
contFloorLast = contFloor
contCeilingLast = contCeiling
contWindowLast = contWindow
contDoorLast = contDoor
contInternalLast = contInternal
! PosZ_Wall (... + 1) has the Begin Wall reference in Apos_Wall for the ZNum
! PosZ_Wall (... + 2) has the End Wall reference in Apos_Wall for the ZNum
PosZ_Wall((ZNum-1)*2 + 1) = contWallBegin
PosZ_Wall((ZNum-1)*2 + 2) = contWallLast
PosZ_Floor((ZNum-1)*2 + 1) = contFloorBegin
PosZ_Floor((ZNum-1)*2 + 2) = contFloorLast
PosZ_Ceiling((ZNum-1)*2 + 1) = contCeilingBegin
PosZ_Ceiling((ZNum-1)*2 + 2) = contCeilingLast
PosZ_Window((ZNum-1)*2 + 1) = contWindowBegin
PosZ_Window((ZNum-1)*2 + 2) = contWindowLast
PosZ_Door((ZNum-1)*2 + 1) = contDoorBegin
PosZ_Door((ZNum-1)*2 + 2) = contDoorLast
PosZ_Internal((ZNum-1)*2 + 1) = contInternalBegin
PosZ_Internal((ZNum-1)*2 + 2) = contInternalLast
! Save the highest and lowest height for this zone
ZoneCeilingHeight((ZNum-1)*2 + 1) = Z1Zone
ZoneCeilingHeight((ZNum-1)*2 + 2) = Z2Zone
IF (ABS((Z2Zone-Z1Zone) - Zone(ZNum)%CeilingHeight) > CeilingHeightDiffMax) THEN
CALL ShowWarningError ('RoomAirManager: Inconsistent ceiling heights in Zone: '//TRIM(Zone(ZNum)%Name))
CALL ShowContinueError('Lowest height=['//trim(RoundSigDigits(Z1Zone,3))//'].')
CALL ShowContinueError('Highest height=['//trim(RoundSigDigits(Z2Zone,3))//'].')
CALL ShowContinueError('Ceiling height=['//trim(RoundSigDigits(Zone(ZNum)%CeilingHeight,3))//'].')
ENDIF
END DO ! Zones
AuxSurf=0
CVNumAirflowNetworkSurfaces=0
! calculate maximum number of airflow network surfaces in each zone
DO Loop=1, NumOfLinksMultizone
AuxSurf(Surface(MultizoneSurfaceData(Loop)%SurfNum)%Zone)=AuxSurf(Surface(MultizoneSurfaceData(Loop)%SurfNum)%Zone)+1
CVNumAirflowNetworkSurfaces=CVNumAirflowNetworkSurfaces+1
! Check if this is an interzone airflow network surface
IF (Surface(MultizoneSurfaceData(Loop)%SurfNum)%ExtBoundCond > 0 .and. (MultizoneSurfaceData(Loop)%SurfNum /= &
Surface(MultizoneSurfaceData(Loop)%SurfNum)%ExtBoundCond) ) THEN
AuxSurf(Surface(Surface(MultizoneSurfaceData(Loop)%SurfNum)%ExtBoundCond)%Zone)= &
AuxSurf(Surface(Surface(MultizoneSurfaceData(Loop)%SurfNum)%ExtBoundCond)%Zone)+1
CVNumAirflowNetworkSurfaces=CVNumAirflowNetworkSurfaces+1
END IF
END DO
! calculate maximum number of airflow network surfaces in a single zone
MaxSurf=AuxSurf(1)
DO Loop=2, NumOfZones
IF (AuxSurf(Loop)> MaxSurf) MaxSurf=AuxSurf(Loop)
END DO
IF (.NOT. allocated(AirflowNetworkSurfaceUCSDCV)) THEN
ALLOCATE (AirflowNetworkSurfaceUCSDCV(NumofZones, 0:MaxSurf))
ENDIF
IF (.NOT. allocated(CVJetRecFlows)) THEN
ALLOCATE (CVJetRecFlows(NumofZones, 0:MaxSurf))
ENDIF
ALLOCATE (AuxAirflowNetworkSurf(NumofZones, 0:MaxSurf))
! Width and Height for airflow network surfaces
IF (.NOT. allocated(SurfParametersCVDV)) THEN
ALLOCATE (SurfParametersCVDV(NumOfLinksMultizone))
ENDIF
AirflowNetworkSurfaceUCSDCV=0
! Organize surfaces in vector AirflowNetworkSurfaceUCSDCV(Zone, surface indexes)
DO Loop=1, NumOfZones
! the 0 component of the array has the number of relevant AirflowNetwork surfaces for the zone
AirflowNetworkSurfaceUCSDCV(Loop,0)=AuxSurf(Loop)
IF (AuxSurf(Loop)/=0) THEN
SurfNum=1
DO Loop2=1, NumOfLinksMultizone
IF (Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Zone ==Loop) THEN
! SurfNum has the reference surface number relative to AirflowNetworkSurfaceData
AirflowNetworkSurfaceUCSDCV(Loop,SurfNum)= Loop2
! calculate the surface width and height
CompNum = AirflowNetworkLinkageData(Loop2)%CompNum
TypeNum = AirflowNetworkCompData(CompNum)%TypeNum
IF (AirflowNetworkCompData(CompNum)%CompTypeNum == CompTypeNum_DOP) then
WidthFactMax=0.0d0
HeightFactMax=0.0d0
DO Loop3=1,MultizoneCompDetOpeningData(TypeNum)%NumFac
If (Loop3 .eq. 1) then
WidthFact=MultizoneCompDetOpeningData(TypeNum)%WidthFac1
HeightFact=MultizoneCompDetOpeningData(TypeNum)%HeightFac1
end if
If (Loop3 .eq. 2) then
WidthFact=MultizoneCompDetOpeningData(TypeNum)%WidthFac2
HeightFact=MultizoneCompDetOpeningData(TypeNum)%HeightFac2
end if
If (Loop3 .eq. 3) then
WidthFact=MultizoneCompDetOpeningData(TypeNum)%WidthFac3
HeightFact=MultizoneCompDetOpeningData(TypeNum)%HeightFac3
end if
If (Loop3 .eq. 4) then
WidthFact=MultizoneCompDetOpeningData(TypeNum)%WidthFac4
HeightFact=MultizoneCompDetOpeningData(TypeNum)%HeightFac4
end if
IF (WidthFact > WidthFactMax) THEN
WidthFactMax = WidthFact
END IF
IF (HeightFact>HeightFactMax )THEN
HeightFactMax = HeightFact
END IF
END DO
SurfParametersCVDV(Loop2)%Width=WidthFactMax*Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Width
SurfParametersCVDV(Loop2)%Height=HeightFactMax*Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Height
ELSE IF (AirflowNetworkCompData(CompNum)%CompTypeNum == CompTypeNum_SCR) then ! surface type = CRACK
SurfParametersCVDV(Loop2)%Width=Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Width/2
AinCV= MultizoneSurfaceCrackData(TypeNum)%FlowCoef / &
(BaseDischargeCoef*SQRT(2.0d0/PsyRhoAirFnPbTdbW(OutBaroPress,MAT(Loop),ZoneAirHumRat(Loop)) ))
SurfParametersCVDV(Loop2)%Height=AinCV/SurfParametersCVDV(Loop2)%Width
END IF
! calculate the surface Zmin and Zmax
IF (AirflowNetworkCompData(CompNum)%CompTypeNum == CompTypeNum_DOP) THEN
AirflowNetworkSurfPtr=MultizoneSurfaceData(Loop2)%SurfNum
NSides=Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Sides
SurfParametersCVDV(Loop2)%zmin = &
MINVAL(Surface(AirflowNetworkSurfPtr)%Vertex(1:NSides)%Z)-ZoneCeilingHeight((loop-1)*2 + 1)
SurfParametersCVDV(Loop2)%zmax = &
MAXVAL(Surface(AirflowNetworkSurfPtr)%Vertex(1:NSides)%Z)-ZoneCeilingHeight((loop-1)*2 + 1)
ELSE IF (AirflowNetworkCompData(CompNum)%CompTypeNum == CompTypeNum_SCR) then ! surface type = CRACK
AirflowNetworkSurfPtr=MultizoneSurfaceData(Loop2)%SurfNum
NSides=Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Sides
SurfParametersCVDV(Loop2)%zmin = &
MINVAL(Surface(AirflowNetworkSurfPtr)%Vertex(1:NSides)%Z)-ZoneCeilingHeight((loop-1)*2 + 1)
SurfParametersCVDV(Loop2)%zmax = &
MAXVAL(Surface(AirflowNetworkSurfPtr)%Vertex(1:NSides)%Z)-ZoneCeilingHeight((loop-1)*2 + 1)
END IF
SurfNum=SurfNum+1
! Check if airflow network Surface is an interzone surface:
ELSE
NodeNum1 = MultizoneSurfaceData(Loop2)%NodeNums(1)
NodeNum2 = MultizoneSurfaceData(Loop2)%NodeNums(2)
IF ((AirflowNetworkNodeData(NodeNum2)%EPlusZoneNum==Loop .and. AirflowNetworkNodeData(NodeNum1)%EPlusZoneNum > 0) &
.or. &
(AirflowNetworkNodeData(NodeNum2)%EPlusZoneNum>0 .and. AirflowNetworkNodeData(NodeNum1)%EPlusZoneNum==Loop) ) THEN
AirflowNetworkSurfaceUCSDCV(Loop,SurfNum)= Loop2
SurfNum=SurfNum+1
END IF
END IF
END DO
END IF
END DO
DEALLOCATE(AuxSurf)
IF (Any(IsZoneDV) .OR. Any(IsZoneUI)) THEN
ALLOCATE (MaxTempGrad(NumOfZones))
ALLOCATE (AvgTempGrad(NumOfZones))
ALLOCATE (TCMF(NumOfZones))
ALLOCATE (FracMinFlow(NumOfZones))
ALLOCATE (ZoneAirSystemON(NumOfZones))
! Allocate histories of displacement ventilation temperatures PH 3/5/04
ALLOCATE(MATFloor(NumOfZones))
ALLOCATE(XMATFloor(NumOfZones))
ALLOCATE(XM2TFloor(NumOfZones))
ALLOCATE(XM3TFloor(NumOfZones))
ALLOCATE(XM4TFloor(NumOfZones))
ALLOCATE(DSXMATFloor(NumOfZones))
ALLOCATE(DSXM2TFloor(NumOfZones))
ALLOCATE(DSXM3TFloor(NumOfZones))
ALLOCATE(DSXM4TFloor(NumOfZones))
ALLOCATE(MATOC(NumOfZones))
ALLOCATE(XMATOC(NumOfZones))
ALLOCATE(XM2TOC(NumOfZones))
ALLOCATE(XM3TOC(NumOfZones))
ALLOCATE(XM4TOC(NumOfZones))
ALLOCATE(DSXMATOC(NumOfZones))
ALLOCATE(DSXM2TOC(NumOfZones))
ALLOCATE(DSXM3TOC(NumOfZones))
ALLOCATE(DSXM4TOC(NumOfZones))
ALLOCATE(MATMX(NumOfZones))
ALLOCATE(XMATMX(NumOfZones))
ALLOCATE(XM2TMX(NumOfZones))
ALLOCATE(XM3TMX(NumOfZones))
ALLOCATE(XM4TMX(NumOfZones))
ALLOCATE(DSXMATMX(NumOfZones))
ALLOCATE(DSXM2TMX(NumOfZones))
ALLOCATE(DSXM3TMX(NumOfZones))
ALLOCATE(DSXM4TMX(NumOfZones))
ALLOCATE(ZTM1Floor(NumOfZones))
ALLOCATE(ZTM2Floor(NumOfZones))
ALLOCATE(ZTM3Floor(NumOfZones))
ALLOCATE(ZTM1OC(NumOfZones))
ALLOCATE(ZTM2OC(NumOfZones))
ALLOCATE(ZTM3OC(NumOfZones))
ALLOCATE(ZTM1MX(NumOfZones))
ALLOCATE(ZTM2MX(NumOfZones))
ALLOCATE(ZTM3MX(NumOfZones))
ALLOCATE(AIRRATFloor(NumOfZones))
ALLOCATE(AIRRATOC(NumOfZones))
ALLOCATE(AIRRATMX(NumOfZones))
ALLOCATE (ZTOC(NumOfZones))
ALLOCATE (ZTMX(NumOfZones))
ALLOCATE (ZTFLOOR(NumOfZones))
ALLOCATE (HeightTransition(NumOfZones))
ALLOCATE (Phi(NumOfZones))
ALLOCATE (Zone1Floor(NumOfZones))
ALLOCATE (ZoneMXFloor(NumOfZones))
ALLOCATE (ZoneM2Floor(NumOfZones))
ALLOCATE (Zone1OC(NumOfZones))
ALLOCATE (ZoneMXOC(NumOfZones))
ALLOCATE (ZoneM2OC(NumOfZones))
ALLOCATE (Zone1MX(NumOfZones))
ALLOCATE (ZoneMXMX(NumOfZones))
ALLOCATE (ZoneM2MX(NumOfZones))
MaxTempGrad = 0.0d0
AvgTempGrad = 0.0d0
TCMF=23.0d0
FracMinFlow = 0.0d0
! ZoneDVMixedFlagRep = 0.0
ZoneAirSystemON = .FALSE.
! ZoneDVMixedFlag=0
MATFloor = 23.0d0
XMATFloor = 23.0d0
XM2TFloor = 23.0d0
XM3TFloor = 23.0d0
XM4TFloor = 23.0d0
DSXMATFloor = 23.0d0
DSXM2TFloor = 23.0d0
DSXM3TFloor = 23.0d0
DSXM4TFloor = 23.0d0
MATOC = 23.0d0
XMATOC = 23.0d0
XM2TOC = 23.0d0
XM3TOC = 23.0d0
XM4TOC = 23.0d0
DSXMATOC = 23.0d0
DSXM2TOC = 23.0d0
DSXM3TOC = 23.0d0
DSXM4TOC = 23.0d0
MATMX = 23.0d0
XMATMX = 23.0d0
XM2TMX = 23.0d0
XM3TMX = 23.0d0
XM4TMX = 23.0d0
DSXMATMX = 23.0d0
DSXM2TMX = 23.0d0
DSXM3TMX = 23.0d0
DSXM4TMX = 23.0d0
ZTM1Floor = 23.0d0
ZTM2Floor = 23.0d0
ZTM3Floor = 23.0d0
ZTM1OC = 23.0d0
ZTM2OC = 23.0d0
ZTM3OC = 23.0d0
ZTM1MX = 23.0d0
ZTM2MX = 23.0d0
ZTM3MX = 23.0d0
Zone1Floor = 23.0d0
ZoneMXFloor = 23.0d0
ZoneM2Floor = 23.0d0
Zone1OC = 23.0d0
ZoneMXOC = 23.0d0
ZoneM2OC = 23.0d0
Zone1MX = 23.0d0
ZoneMXMX = 23.0d0
ZoneM2MX = 23.0d0
AIRRATFloor=0.0d0
AIRRATOC=0.0d0
AIRRATMX=0.0d0
ZTOC = 23.0d0
ZTMX = 23.0d0
ZTFLOOR = 23.0d0
HeightTransition = 0.0d0
Phi = 0.0d0
Hceiling = 0.0d0
HWall = 0.0d0
HFloor = 0.0d0
HInternal = 0.0d0
HWindow = 0.0d0
HDoor = 0.0d0
ENDIF
IF (Any(IsZoneDV)) THEN
ALLOCATE (DVHcIn(TotSurfaces))
ALLOCATE (ZoneDVMixedFlagRep(NumOfZones))
ALLOCATE (ZoneDVMixedFlag(NumOfZones))
DVHcIn = 0.0d0
ZoneDVMixedFlagRep = 0.0d0
ZoneDVMixedFlag = 0
! Output variables and DV zone flag
DO Loop=1,NumOfZones
If (AirModel(loop)%AirModelType /= RoomAirModel_UCSDDV) cycle !don't set these up if they don't make sense
!CurrentModuleObject='RoomAirSettings:ThreeNodeDisplacementVentilation'
CALL SetupOutputVariable('Room Air Zone Mixed Subzone Temperature [C]',ZTMX(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Occupied Subzone Temperature [C]',ZTOC(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Floor Subzone Temperature [C]',ZTFLOOR(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Transition Height [m]',HeightTransition(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Recommended Minimum Flow Fraction []', &
FracMinFlow(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Is Mixed Status []',ZoneDVMixedFlagRep(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Average Temperature Gradient [K/m]', &
AvgTempGrad(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Maximum Temperature Gradient [K/m]', &
MaxTempGrad(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Thermal Comfort Effective Air Temperature [C]', &
TCMF(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Thermostat Temperature [C]',TempTstatAir(Loop),'HVAC','State',Zone(Loop)%Name)
ENDDO
END IF
IF (Any(IsZoneUI)) THEN
ALLOCATE (ZoneUFMixedFlag(NumOfZones))
ALLOCATE (ZoneUFMixedFlagRep(NumOfZones))
ALLOCATE (UFHcIn(TotSurfaces))
ALLOCATE (ZoneUFGamma(NumOfZones))
ALLOCATE (ZoneUFPowInPlumes(NumOfZones))
ALLOCATE (ZoneUFPowInPlumesfromWindows(NumOfZones))
ZoneUFMixedFlag = 0
ZoneUFMixedFlagRep = 0.0d0
UFHcIn = 0.0d0
ZoneUFGamma = 0.0d0
ZoneUFPowInPlumes = 0.0d0
ZoneUFPowInPlumesfromWindows = 0.0d0
! Output variables and UF zone flag
DO Loop=1,NumOfZones
If (AirModel(loop)%AirModelType /= RoomAirModel_UCSDUFI) cycle !don't set these up if they don't make sense
!CurrentModuleObject='RoomAirSettings:UnderFloorAirDistributionInterior'
CALL SetupOutputVariable('Room Air Zone Mixed Subzone Temperature [C]',ZTMX(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Occupied Subzone Temperature [C]',ZTOC(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Transition Height [m]',HeightTransition(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Is Mixed Status []',ZoneUFMixedFlagRep(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Average Temperature Gradient [K/m]', &
AvgTempGrad(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Effective Comfort Air Temperature [C]',TCMF(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Thermostat Temperature [C]',TempTstatAir(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Transition Height Gamma Value []',ZoneUFGamma(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Plume Heat Transfer Rate [W]', &
ZoneUFPowInPlumes(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Temperature Stratification Fraction []',Phi(Loop),'HVAC','State',Zone(Loop)%Name)
! set zone equip pointer in the UCSDUI data structure
DO ZoneEquipConfigNum = 1, NumOfZones
IF (ZoneEquipConfig(ZoneEquipConfigNum)%ActualZoneNum == Loop) THEN
ZoneUCSDUI(ZoneUFPtr(Loop))%ZoneEquipPtr = ZoneEquipConfigNum
EXIT
END IF
END DO ! ZoneEquipConfigNum
ENDDO
DO Loop=1,NumOfZones
If (AirModel(loop)%AirModelType /= RoomAirModel_UCSDUFE) cycle !don't set these up if they don't make sense
!CurrentModuleObject='RoomAirSettings:UnderFloorAirDistributionExterior'
CALL SetupOutputVariable('Room Air Zone Mixed Subzone Temperature [C]',ZTMX(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Occupied Subzone Temperature [C]',ZTOC(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Transition Height [m]',HeightTransition(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Is Mixed Status []',ZoneUFMixedFlagRep(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Average Temperature Gradient [K/m]', &
AvgTempGrad(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Effective Comfort Air Temperature [C]',TCMF(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Thermostat Temperature [C]',TempTstatAir(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Transition Height Gamma Value []',ZoneUFGamma(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Plume Heat Transfer Rate [W]', &
ZoneUFPowInPlumes(Loop),'HVAC','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Window Plume Heat Transfer Rate [W]',ZoneUFPowInPlumesfromWindows(Loop),'HVAC',&
'State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Temperature Stratification Fraction []',Phi(Loop),'HVAC','State',Zone(Loop)%Name)
! set zone equip pointer in the UCSDUE data structure
DO ZoneEquipConfigNum = 1, NumOfZones
IF (ZoneEquipConfig(ZoneEquipConfigNum)%ActualZoneNum == Loop) THEN
ZoneUCSDUE(ZoneUFPtr(Loop))%ZoneEquipPtr = ZoneEquipConfigNum
EXIT
END IF
END DO ! ZoneEquipConfigNum
ENDDO
END IF
IF (Any(IsZoneCV)) THEN
ALLOCATE (CVHcIn(TotSurfaces))
ALLOCATE (ZTJET(NumOfZones))
! Most ZTJet takes defaults
ALLOCATE (ZTREC(NumOfZones))
ALLOCATE (RoomOutflowTemp(NumOfZones))
! Most ZTrec takes defaults
ALLOCATE (JetRecAreaRatio(NumOfZones))
ALLOCATE (Urec(NumOfZones))
ALLOCATE (Ujet(NumOfZones))
ALLOCATE (Qrec(NumOfZones))
ALLOCATE (Qtot(NumOfZones))
ALLOCATE (RecInflowRatio(NumOfZones))
ALLOCATE (Uhc(NumOfZones))
ALLOCATE (Ain(NumOfZones))
ALLOCATE (Tin(NumOfZones))
ALLOCATE (Droom(NumOfZones))
ALLOCATE (Dstar(NumOfZones))
ALLOCATE (ZoneCVisMixing(NumOfZones))
ALLOCATE (Rfr(NumOfZones))
ALLOCATE (ZoneCVhasREC(NumofZones))
ZTJET = 23.0d0
RoomOutflowTemp = 23.0d0
ZTREC = 23.0d0
CVHcIn = 0.0d0
JetRecAreaRatio = 0.2d0
Urec=0.2d0
Ujet=0.2d0
Qrec=0.2d0
Uhc = 0.2d0
Ain=1.0d0
Tin = 23.0d0
Droom=6.0d0
ZoneCVisMixing=0.0d0
Rfr=10.0d0
ZoneCVhasREC=1.0d0
Hceiling = 0.0d0
HWall = 0.0d0
HFloor = 0.0d0
HInternal = 0.0d0
HWindow = 0.0d0
HDoor = 0.0d0
DO Loop=1,NumOfZones
IF (AirModel(loop)%AirModelType /= RoomAirModel_UCSDCV) cycle !don't set these up if they don't make sense
ZoneEquipConfigNum = ZoneNum
! check whether this zone is a controlled zone or not
IF (ZoneEquipConfig(ZoneEquipConfigNum)%IsControlled) THEN
IsZoneCV(Loop) = .FALSE.
AirModel(Loop)%SimAirModel= .FALSE.
CALL ShowSevereError('Unmixed Flow: Cross Ventilation cannot be applied for Zone='//TRIM(zone(loop)%Name))
CALL ShowContinueError('An HVAC system is present in the zone. Fully mixed airflow model will be used for Zone='// &
TRIM(zone(loop)%Name))
cycle
ENDIF
!CurrentModuleObject='RoomAirSettings:CrossVentilation'
CALL SetupOutputVariable('Room Air Zone Jet Region Temperature [C]',ZTjet(Loop),'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Recirculation Region Temperature [C]', &
ZTrec(Loop),'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Jet Region Average Air Velocity [m/s]',Ujet(Loop),'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Recirculation Region Average Air Velocity [m/s]', &
Urec(Loop),'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Recirculation and Inflow Rate Ratio []',RecInflowRatio(Loop),'Zone','Average', &
Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Inflow Opening Area [m2]',Ain(Loop),'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Room Length [m]',Dstar(Loop),'Zone','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Is Mixing Status []',ZoneCVisMixing(Loop),'Zone','State',Zone(Loop)%Name)
CALL SetupOutputVariable('Room Air Zone Is Recirculating Status []',ZoneCVhasREC(Loop), &
'Zone','State',Zone(Loop)%Name)
DO i=1,AirflowNetworkSurfaceUCSDCV(ZoneNum,0)
N = AirflowNetworkLinkageData(i)%CompNum
IF (AirflowNetworkCompData(N)%CompTypeNum==CompTypeNum_DOP) THEN
SurfNum = MultizoneSurfaceData(i)%SurfNum
CALL SetupOutputVariable('Room Air Window Jet Region Average Air Velocity [m/s]', &
CVJetRecFlows(Loop,i)%Ujet,'Zone','Average', &
MultizoneSurfaceData(i)%SurfName)
END IF
END DO
ENDDO
ENDIF
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(ZoneNum)) THEN
IF (IsZoneDV(ZoneNum) .OR. IsZoneUI(ZoneNum)) THEN
MaxTempGrad(ZoneNum) = 0.0d0
AvgTempGrad(ZoneNum) = 0.0d0
TCMF(ZoneNum)=23.0d0
FracMinFlow(ZoneNum) = 0.0d0
ZoneAirSystemON(ZoneNum) = .FALSE.
MATFloor(ZoneNum) = 23.0d0
XMATFloor(ZoneNum) = 23.0d0
XM2TFloor(ZoneNum) = 23.0d0
XM3TFloor(ZoneNum) = 23.0d0
XM4TFloor(ZoneNum) = 23.0d0
DSXMATFloor(ZoneNum) = 23.0d0
DSXM2TFloor(ZoneNum) = 23.0d0
DSXM3TFloor(ZoneNum) = 23.0d0
DSXM4TFloor(ZoneNum) = 23.0d0
MATOC(ZoneNum) = 23.0d0
XMATOC(ZoneNum) = 23.0d0
XM2TOC(ZoneNum) = 23.0d0
XM3TOC(ZoneNum) = 23.0d0
XM4TOC(ZoneNum) = 23.0d0
DSXMATOC(ZoneNum) = 23.0d0
DSXM2TOC(ZoneNum) = 23.0d0
DSXM3TOC(ZoneNum) = 23.0d0
DSXM4TOC(ZoneNum) = 23.0d0
MATMX(ZoneNum) = 23.0d0
XMATMX(ZoneNum) = 23.0d0
XM2TMX(ZoneNum) = 23.0d0
XM3TMX(ZoneNum) = 23.0d0
XM4TMX(ZoneNum) = 23.0d0
DSXMATMX(ZoneNum) = 23.0d0
DSXM2TMX(ZoneNum) = 23.0d0
DSXM3TMX(ZoneNum) = 23.0d0
DSXM4TMX(ZoneNum) = 23.0d0
ZTM1Floor(ZoneNum) = 23.0d0
ZTM2Floor(ZoneNum) = 23.0d0
ZTM3Floor(ZoneNum) = 23.0d0
Zone1Floor(ZoneNum) = 23.0d0
ZoneMXFloor(ZoneNum) = 23.0d0
ZoneM2Floor(ZoneNum) = 23.0d0
ZTM1OC(ZoneNum) = 23.0d0
ZTM2OC(ZoneNum) = 23.0d0
ZTM3OC(ZoneNum) = 23.0d0
Zone1OC(ZoneNum) = 23.0d0
ZoneMXOC(ZoneNum) = 23.0d0
ZoneM2OC(ZoneNum) = 23.0d0
ZTM1MX(ZoneNum) = 23.0d0
ZTM2MX(ZoneNum) = 23.0d0
ZTM3MX(ZoneNum) = 23.0d0
Zone1MX(ZoneNum) = 23.0d0
ZoneMXMX(ZoneNum) = 23.0d0
ZoneM2MX(ZoneNum) = 23.0d0
AIRRATFloor(ZoneNum)=0.0d0
AIRRATOC(ZoneNum)=0.0d0
AIRRATMX(ZoneNum)=0.0d0
ZTOC(ZoneNum) = 23.0d0
ZTMX(ZoneNum) = 23.0d0
ZTFLOOR(ZoneNum) = 23.0d0
HeightTransition(ZoneNum) = 0.0d0
Phi(ZoneNum) = 0.0d0
Hceiling = 0.0d0
HWall = 0.0d0
HFloor = 0.0d0
HInternal = 0.0d0
HWindow = 0.0d0
HDoor = 0.0d0
END IF
IF (IsZoneDV(ZoneNum)) THEN
DVHcIn = 0.0d0
ZoneDVMixedFlagRep(ZoneNum) = 0.0d0
ZoneDVMixedFlag(ZoneNum)=0
END IF
IF (IsZoneUI(ZoneNum)) THEN
UFHcIn = 0.0d0
ZoneUFMixedFlag(ZoneNum) = 0
ZoneUFMixedFlagRep(ZoneNum) = 0.0d0
ZoneUFGamma(ZoneNum) = 0.0d0
ZoneUFPowInPlumes(ZoneNum) = 0.0d0
ZoneUFPowInPlumesfromWindows(ZoneNum) = 0.0d0
END IF
IF (ISZoneCV(ZoneNum)) THEN
ZTjet(ZoneNum) = 23.0d0
RoomOutflowTemp(ZoneNum) = 23.0d0
ZTrec(ZoneNum) = 23.0d0
CVHcIn = 0.0d0
JetRecAreaRatio(ZoneNum) = 0.2d0
Urec(ZoneNum)=0.2d0
Ujet(ZoneNum)=0.2d0
Uhc(ZoneNum) = 0.2d0
Ain(ZoneNum)=1.0d0
Tin(ZoneNum) = 23.0d0
Droom(ZoneNum)=6.0d0
Dstar(ZoneNum)=6.0d0
ZoneCVisMixing(ZoneNum)=0.0d0
Rfr(ZoneNum)=10.0d0
ZoneCVhasREC(ZoneNum)=1.0d0
Hceiling = 0.0d0
HWall = 0.0d0
HFloor = 0.0d0
HInternal = 0.0d0
HWindow = 0.0d0
HDoor = 0.0d0
END IF
MyEnvrnFlag(ZoneNum) = .FALSE.
END IF ! end one time inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(ZoneNum) = .true.
ENDIF
RETURN
END SUBROUTINE SharedDVCVUFDataInit