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 AllocateAirflowNetworkData
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Aug. 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine allocates dynamic arrays for AirflowNetworkSolver.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
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,j,N
INTEGER, EXTERNAL :: GetNewUnitNumber ! External function to "get" a unit number
! Assume a network to simulate multizone airflow is a subset of the network to simulate air distribution system.
! Network array size is allocated based on the network of air distribution system.
! If multizone airflow is simulated only, the array size is allocated based on the multizone network.
! FLOW:
NetworkNumOfLinks = AirflowNetworkNumOfLinks
NetworkNumOfNodes = AirflowNetworkNumOfNodes
ALLOCATE(AFECTL(NetworkNumOfLinks))
ALLOCATE(AFLOW2(NetworkNumOfLinks))
ALLOCATE(AFLOW(NetworkNumOfLinks))
ALLOCATE(PW(NetworkNumOfLinks))
ALLOCATE(PS(NetworkNumOfLinks))
ALLOCATE(TZ(NetworkNumOfNodes))
ALLOCATE(WZ(NetworkNumOfNodes))
ALLOCATE(PZ(NetworkNumOfNodes))
ALLOCATE(RHOZ(NetworkNumOfNodes))
ALLOCATE(SQRTDZ(NetworkNumOfNodes))
ALLOCATE(VISCZ(NetworkNumOfNodes))
ALLOCATE(SUMAF(NetworkNumOfNodes))
ALLOCATE(ID(NetworkNumOfNodes))
ALLOCATE(IK(NetworkNumOfNodes+1))
#ifdef SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS
ALLOCATE(newIK(NetworkNumOfNodes+1))
#endif
ALLOCATE(AD(NetworkNumOfNodes))
ALLOCATE(SUMF(NetworkNumOfNodes))
N = 0
Do i=1,AirflowNetworkNumOfLinks
j = AirflowNetworkCompData(AirflowNetworkLinkageData(i)%CompNum)%CompTypeNum
if (j .EQ. CompTypeNum_DOP) then
n = n+1
end if
End do
ALLOCATE(DpProf(N*(NrInt+2)))
ALLOCATE(RhoProfF(N*(NrInt+2)))
ALLOCATE(RhoProfT(N*(NrInt+2)))
ALLOCATE(DpL(2,AirflowNetworkNumOfLinks))
PB = 101325.0d0
! LIST = 5
LIST = 0
If (LIST .GE. 1) then
Unit21 = GetNewUnitNumber()
open(Unit21,file='eplusADS.out')
end if
DO N=1,NetworkNumOfNodes
ID(N) = N
END DO
DO I=1,NetworkNumOfLinks
AFECTL(I) = 1.0d0
AFLOW(I) = 0.0d0
AFLOW2(I) = 0.0d0
END DO
DO I=1,NetworkNumOfNodes
TZ(I) = AirflowNetworkNodeSimu(I)%TZ
WZ(I) = AirflowNetworkNodeSimu(I)%WZ
PZ(I) = AirflowNetworkNodeSimu(I)%PZ
END DO
! Assign linkage values
DO I=1,NetworkNumOfLinks
PW(I) = 0.0d0
END DO
! Write an ouput file used for AIRNET input
if (LIST .GE. 5) then
Unit11 = GetNewUnitNumber()
open(Unit11,file='eplusADS.inp')
DO i=1,NetworkNumOfNodes
write(Unit11,901) i,AirflowNetworkNodeData(I)%NodeTypeNum,AirflowNetworkNodeData(I)%NodeHeight,TZ(I),PZ(I)
end do
write(Unit11,900) 0
DO i=1,AirflowNetworkNumOfComps
j = AirflowNetworkCompData(i)%TypeNum
select case (AirflowNetworkCompData(i)%CompTypeNum)
CASE (CompTypeNum_PLR) !'PLR' Power law component
! WRITE(Unit11,902) AirflowNetworkCompData(i)%CompNum,1,DisSysCompLeakData(j)%FlowCoef, &
! DisSysCompLeakData(j)%FlowCoef,DisSysCompLeakData(j)%FlowCoef,DisSysCompLeakData(j)%FlowExpo
CASE (CompTypeNum_SCR) !'SCR' Surface crack component
WRITE(Unit11,902) AirflowNetworkCompData(i)%CompNum,1,MultizoneSurfaceCrackData(j)%FlowCoef, &
MultizoneSurfaceCrackData(j)%FlowCoef,MultizoneSurfaceCrackData(j)%FlowCoef,MultizoneSurfaceCrackData(j)%FlowExpo
CASE (CompTypeNum_DWC) !'DWC' Duct component
! WRITE(Unit11,902) AirflowNetworkCompData(i)%CompNum,2,DisSysCompDuctData(j)%L,DisSysCompDuctData(j)%D, &
! DisSysCompDuctData(j)%A,DisSysCompDuctData(j)%Rough
! WRITE(Unit11,903) DisSysCompDuctData(i)%TurDynCoef,DisSysCompDuctData(j)%LamFriCoef, &
! DisSysCompDuctData(j)%LamFriCoef,DisSysCompDuctData(j)%InitLamCoef
! CASE (CompTypeNum_CVF) ! 'CVF' Constant volume fan component
! WRITE(Unit11,904) AirflowNetworkCompData(i)%CompNum,4,DisSysCompCVFData(j)%FlowRate
CASE (CompTypeNum_EXF) ! 'EXF' Zone exhaust fan
WRITE(Unit11,904) AirflowNetworkCompData(i)%CompNum,4,MultizoneCompExhaustFanData(j)%FlowRate
CASE Default
END SELECT
end do
write(Unit11,900) 0
DO i=1,NetworkNumOfLinks
write(Unit11,910) i,AirflowNetworkLinkageData(I)%NodeNums(1),AirflowNetworkLinkageData(I)%NodeHeights(1), &
AirflowNetworkLinkageData(I)%NodeNums(2),AirflowNetworkLinkageData(I)%NodeHeights(2), &
AirflowNetworkLinkageData(I)%CompNum,0,0
end do
write(Unit11,900) 0
end if
CALL SETSKY
!SETSKY figures out the IK stuff -- which is why E+ doesn't allocate AU until here
#ifdef SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS
! ! only printing to screen, can be commented
! print*, "SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS is defined"
!
! write(*,'(2(a,i8))') "AllocateAirflowNetworkData: after SETSKY, allocating AU. NetworkNumOfNodes=", &
! NetworkNumOfNodes, " IK(NetworkNumOfNodes+1)= NNZE=", IK(NetworkNumOfNodes+1)
! print*, " NetworkNumOfLinks=", NetworkNumOfLinks
!
! allocate same size as others -- this will be maximum !noel
ALLOCATE(newAU(IK(NetworkNumOfNodes+1)))
#endif
! noel, GNU says the AU is indexed above its upper bound
!ALLOCATE(AU(IK(NetworkNumOfNodes+1)-1))
ALLOCATE(AU(IK(NetworkNumOfNodes+1)))
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 AllocateAirflowNetworkData