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 AllocateAndInitData
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Aug. 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes variables and allocates dynamic arrays.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE DataInterfaces, ONLY: SetupEMSActuator
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER i, ZoneNum, N, SurfNum
INTEGER, EXTERNAL :: GetNewUnitNumber ! External function to "get" a unit number
ALLOCATE(AirflowNetworkNodeSimu(AirflowNetworkNumOfNodes)) ! Node simulation variable in air distribution system
ALLOCATE(AirflowNetworkLinkSimu(AirflowNetworkNumOfLinks)) ! Link simulation variable in air distribution system
ALLOCATE(AirflowNetworkLinkReport(AirflowNetworkNumOfLinks)) ! Report link simulation variable in air distribution system
If (SupplyFanType .EQ. FanType_SimpleOnOff) then
ALLOCATE(AirflowNetworkNodeReport(AirflowNetworkNumOfZones))
ALLOCATE(AirflowNetworkLinkReport1(AirflowNetworkNumOfSurfaces))
End If
ALLOCATE(MA(AirflowNetworkNumOfNodes*AirflowNetworkNumOfNodes))
ALLOCATE(MV(AirflowNetworkNumOfNodes))
ALLOCATE(IVEC(AirflowNetworkNumOfNodes+20))
ALLOCATE(AirflowNetworkReportData(NumOfZones)) ! Report variables
ALLOCATE(AirflowNetworkZnRpt(NumOfZones)) ! Report variables
ALLOCATE(ANZT(NumOfZones)) ! Local zone air temperature for rollback use
ALLOCATE(ANZW(NumOfZones)) ! Local zone humidity ratio for rollback use
IF (Contaminant%CO2Simulation) ALLOCATE(ANCO(NumOfZones)) ! Local zone CO2 for rollback use
IF (Contaminant%GenericContamSimulation) ALLOCATE(ANGC(NumOfZones)) ! Local zone generic contaminant for rollback use
CALL AllocateAirflowNetworkData
! CurrentModuleObject='AirflowNetwork Simulations'
DO I=1,AirflowNetworkNumOfNodes
CALL SetupOutputVariable('AFN Node Temperature [C]',AirflowNetworkNodeSimu(I)%TZ,'System','Average', &
AirflowNetworkNodeData(i)%Name)
CALL SetupOutputVariable('AFN Node Humidity Ratio [kgWater/kgDryAir]',AirflowNetworkNodeSimu(I)%WZ, &
'System','Average',AirflowNetworkNodeData(i)%Name)
IF (Contaminant%CO2Simulation) CALL SetupOutputVariable('AFN Node CO2 Concentration [ppm]' &
,AirflowNetworkNodeSimu(I)%CO2Z,'System','Average', AirflowNetworkNodeData(i)%Name)
IF (Contaminant%GenericContamSimulation) CALL SetupOutputVariable('AFN Node Generic Air Contaminant Concentration [ppm]' &
,AirflowNetworkNodeSimu(I)%GCZ,'System','Average', AirflowNetworkNodeData(i)%Name)
If (.NOT. (SupplyFanType .EQ. FanType_SimpleOnOff .AND. i .LE. AirflowNetworkNumOfZones)) &
CALL SetupOutputVariable('AFN Node Total Pressure [Pa]',AirflowNetworkNodeSimu(I)%PZ,'System','Average', &
AirflowNetworkNodeData(i)%Name)
If (AirflowNetworkNodeData(i)%ExtNodeNum > 0) then
CALL SetupOutputVariable('AFN Node Wind Pressure [Pa]',AirflowNetworkNodeSimu(I)%PZ,'System','Average', &
AirflowNetworkNodeData(i)%Name)
End If
END DO
DO i=1,AirflowNetworkNumOfLinks
If (.NOT. (SupplyFanType .EQ. FanType_SimpleOnOff .AND. i .LE. AirflowNetworkNumOfSurfaces)) Then
CALL SetupOutputVariable('AFN Linkage Node 1 to Node 2 Mass Flow Rate [kg/s]',AirflowNetworkLinkReport(I)%FLOW, &
'System','Average',AirflowNetworkLinkageData(i)%Name)
CALL SetupOutputVariable('AFN Linkage Node 2 to Node 1 Mass Flow Rate [kg/s]',AirflowNetworkLinkReport(I)%FLOW2, &
'System','Average',AirflowNetworkLinkageData(i)%Name)
CALL SetupOutputVariable('AFN Linkage Node 1 to Node 2 Volume Flow Rate [m3/s]',AirflowNetworkLinkReport(I)%VolFLOW, &
'System','Average',AirflowNetworkLinkageData(i)%Name)
CALL SetupOutputVariable('AFN Linkage Node 2 to Node 1 Volume Flow Rate [m3/s]',AirflowNetworkLinkReport(I)%VolFLOW2, &
'System','Average',AirflowNetworkLinkageData(i)%Name)
CALL SetupOutputVariable('AFN Linkage Node 1 to Node 2 Pressure Difference [Pa]',AirflowNetworkLinkSimu(I)%DP, &
'System','Average',AirflowNetworkLinkageData(i)%Name)
End If
END DO
DO i=1,AirflowNetworkNumOfSurfaces
N = AirflowNetworkLinkageData(i)%CompNum
IF (AirflowNetworkCompData(N)%CompTypeNum==CompTypeNum_DOP .OR. &
AirflowNetworkCompData(N)%CompTypeNum==CompTypeNum_SOP .OR. &
AirflowNetworkCompData(N)%CompTypeNum==CompTypeNum_HOP) THEN
SurfNum = MultizoneSurfaceData(i)%SurfNum
CALL SetupOutputVariable('AFN Surface Venting Window or Door Opening Factor []', &
MultizoneSurfaceData(I)%OpenFactor,'System','Average', &
MultizoneSurfaceData(I)%SurfName)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('AirFlow Network Window/Door Opening', MultizoneSurfaceData(I)%SurfName, &
'Venting Opening Factor' , '[Fraction]', &
MultizoneSurfaceData(I)%EMSOpenFactorActuated, MultizoneSurfaceData(I)%EMSOpenFactor )
ENDIF
CALL SetupOutputVariable('AFN Surface Venting Window or Door Opening Modulation Multiplier []', &
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep,'System','Average',Surface(SurfNum)%Name)
CALL SetupOutputVariable('AFN Surface Venting Inside Setpoint Temperature [C]', &
SurfaceWindow(SurfNum)%InsideTempForVentingRep,'System','Average',Surface(SurfNum)%Name)
CALL SetupOutputVariable('AFN Surface Venting Availability Status []', &
SurfaceWindow(SurfNum)%VentingAvailabilityRep,'System','Average',Surface(SurfNum)%Name)
END IF
END DO
DO I=1, NumOfZones
! Multizone losses due to force air systems
CALL SetupOutputVariable('AFN Zone Infiltration Sensible Heat Gain Rate [W]', &
AirflowNetworkReportData(i)%MultiZoneInfiSenGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Sensible Heat Gain Energy [J]', &
AirflowNEtworkReportData(i)%MultiZoneInfiSenGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Sensible Heat Gain Rate [W]',AirflowNetworkReportData(i)%MultiZoneMixSenGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Sensible Heat Gain Energy [J]',AirflowNEtworkReportData(i)%MultiZoneMixSenGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Sensible Heat Loss Rate [W]', &
AirflowNEtworkReportData(i)%MultiZoneInfiSenLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Sensible Heat Loss Energy [J]', &
AirflowNEtworkReportData(i)%MultiZoneInfiSenLossJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Sensible Heat Loss Rate [W]',AirflowNEtworkReportData(i)%MultiZoneMixSenLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Sensible Heat Loss Energy [J]',AirflowNEtworkReportData(i)%MultiZoneMixSenLossJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Latent Heat Gain Rate [W]', &
AirflowNEtworkReportData(i)%MultiZoneInfiLatGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Latent Heat Gain Energy [J]', &
AirflowNEtworkReportData(i)%MultiZoneInfiLatGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Latent Heat Loss Rate [W]', &
AirflowNEtworkReportData(i)%MultiZoneInfiLatLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Latent Heat Loss Energy [J]', &
AirflowNEtworkReportData(i)%MultiZoneInfiLatLossJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Latent Heat Gain Rate [W]',AirflowNEtworkReportData(i)%MultiZoneMixLatGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Latent Heat Gain Energy [J]',AirflowNEtworkReportData(i)%MultiZoneMixLatGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Latent Heat Loss Rate [W]',AirflowNEtworkReportData(i)%MultiZoneMixLatLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Latent Heat Loss Energy [J]',AirflowNEtworkReportData(i)%MultiZoneInfiLatLossJ, &
'System','Sum',Zone(i)%Name)
! Supply leak losses due to force air systems
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Sensible Heat Gain Rate [W]',AirflowNEtworkReportData(i)%LeakSenGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Sensible Heat Gain Energy [J]',AirflowNEtworkReportData(i)%LeakSenGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Sensible Heat Loss Rate [W]',AirflowNEtworkReportData(i)%LeakSenLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Sensible Heat Loss Energy [J]',AirflowNEtworkReportData(i)%LeakSenLossJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Latent Heat Gain Rate [W]',AirflowNEtworkReportData(i)%LeakLatGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Latent Heat Gain Energy [J]',AirflowNEtworkReportData(i)%LeakLatGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Latent Heat Loss Rate [W]',AirflowNEtworkReportData(i)%LeakLatLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Leaked Air Latent Heat Loss Energy [J]',AirflowNEtworkReportData(i)%LeakLatLossJ, &
'System','Sum',Zone(i)%Name)
! Conduction losses due to force air systems
CALL SetupOutputVariable('AFN Zone Duct Conduction Sensible Heat Gain Rate [W]',AirflowNEtworkReportData(i)%CondSenGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Conduction Sensible Heat Gain Energy [J]',AirflowNEtworkReportData(i)%CondSenGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Conduction Sensible Heat Loss Rate [W]',AirflowNEtworkReportData(i)%CondSenLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Conduction Sensible Heat Loss Energy [J]',AirflowNEtworkReportData(i)%CondSenLossJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Diffusion Latent Heat Gain Rate [W]',AirflowNEtworkReportData(i)%DiffLatGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Diffusion Latent Heat Gain Energy [J]',AirflowNEtworkReportData(i)%DiffLatGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Diffusion Latent Heat Loss Rate [W]',AirflowNEtworkReportData(i)%DiffLatLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Duct Diffusion Latent Heat Loss Energy [J]',AirflowNEtworkReportData(i)%DiffLatLossJ, &
'System','Sum',Zone(i)%Name)
! Total losses due to force air systems
CALL SetupOutputVariable('AFN Distribution Sensible Heat Gain Rate [W]',AirflowNetworkReportData(i)%TotalSenGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Sensible Heat Gain Energy [J]',AirflowNEtworkReportData(i)%TotalSenGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Sensible Heat Loss Rate [W]',AirflowNEtworkReportData(i)%TotalSenLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Sensible Heat Loss Energy [J]',AirflowNEtworkReportData(i)%TotalSenLossJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Latent Heat Gain Rate [W]',AirflowNEtworkReportData(i)%TotalLatGainW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Latent Heat Gain Energy [J]',AirflowNEtworkReportData(i)%TotalLatGainJ, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Latent Heat Loss Rate [W]',AirflowNEtworkReportData(i)%TotalLatLossW, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Distribution Latent Heat Loss Energy [J]',AirflowNEtworkReportData(i)%TotalLatLossJ, &
'System','Sum',Zone(i)%Name)
END DO
DO i=1,NumOfZones
CALL SetupOutputVariable('AFN Zone Infiltration Volume [m3]',AirflowNetworkZnRpt(i)%InfilVolume, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Mass [kg]',AirflowNetworkZnRpt(i)%InfilMass, &
'System','Sum',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Infiltration Air Change Rate [ach]', &
AirflowNetworkZnRpt(i)%InfilAirChangeRate, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Volume [m3]',AirflowNetworkZnRpt(i)%MixVolume,'System','Sum', &
Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Mixing Mass [kg]',AirflowNetworkZnRpt(i)%MixMass,'System','Sum',Zone(i)%Name)
ENDDO
If (SupplyFanType .EQ. FanType_SimpleOnOff) then
DO i=1,AirflowNetworkNumOfZones
CALL SetupOutputVariable('AFN Zone Average Pressure [Pa]',AirflowNetworkNodeReport(i)%PZ, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone On Cycle Pressure [Pa]',AirflowNetworkNodeReport(i)%PZON, &
'System','Average',Zone(i)%Name)
CALL SetupOutputVariable('AFN Zone Off Cycle Pressure [Pa]',AirflowNetworkNodeReport(i)%PZOFF, &
'System','Average',Zone(i)%Name)
ENDDO
Do I=1,AirflowNetworkNumOfSurfaces
CALL SetupOutputVariable('AFN Linkage Node 1 to 2 Average Mass Flow Rate [kg/s]', &
AirflowNetworkLinkReport1(I)%FLOW, 'System','Average',MultizoneSurfaceData(I)%SurfName)
CALL SetupOutputVariable('AFN Linkage Node 2 to 1 Average Mass Flow Rate [kg/s]', &
AirflowNetworkLinkReport1(I)%FLOW2, 'System','Average',MultizoneSurfaceData(I)%SurfName)
CALL SetupOutputVariable('AFN Linkage Node 1 to 2 Average Volume Flow Rate [m3/s]', &
AirflowNetworkLinkReport1(I)%VolFLOW, 'System','Average',MultizoneSurfaceData(I)%SurfName)
CALL SetupOutputVariable('AFN Linkage Node 2 to 1 Average Volume Flow Rate [m3/s]', &
AirflowNetworkLinkReport1(I)%VolFLOW2, 'System','Average',MultizoneSurfaceData(I)%SurfName)
CALL SetupOutputVariable('AFN Surface Average Pressure Difference [Pa]',AirflowNetworkLinkReport1(I)%DP, &
'System','Average',MultizoneSurfaceData(I)%SurfName)
CALL SetupOutputVariable('AFN Surface On Cycle Pressure Difference [Pa]', &
AirflowNetworkLinkReport1(I)%DPON, &
'System','Average',MultizoneSurfaceData(I)%SurfName)
CALL SetupOutputVariable('AFN Surface Off Cycle Pressure Difference [Pa]', &
AirflowNetworkLinkReport1(I)%DPOFF, &
'System','Average',MultizoneSurfaceData(I)%SurfName)
End Do
End If
! Assign node reference height
Do i=1,AirflowNetworkNumOfNodes
AirflowNetworkNodeData(i)%NodeHeight = 0.0d0
ZoneNum = AirflowNetworkNodeData(i)%EPlusZoneNum
If (ZoneNum > 0) then
If (WorldCoordSystem) then
AirflowNetworkNodeData(i)%NodeHeight = 0.0d0
Else
AirflowNetworkNodeData(i)%NodeHeight = Zone(ZoneNum)%OriginZ
End If
end if
end do
900 Format(1X,i2)
901 Format(1X,2I4,4F9.4)
902 Format(1X,2I4,4F9.4)
903 Format(9X,4F9.4)
904 Format(1X,2I4,1F9.4)
910 Format(1X,I4,2(I4,F9.4),I4,2F4.1)
RETURN
END SUBROUTINE AllocateAndInitData