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 PStack
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Oct. 2005
! MODIFIED na
! RE-ENGINEERED This subroutine is revised based on PresProfile subroutine from COMIS
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the stack pressures for a link between two zones
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Helmut E. Feustel and Alison Rayner-Hooson, "COMIS Fundamentals," LBL-28560,
! Lawrence Berkeley National Laboratory, Berkeley, CA, May 1990
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: PI = 3.14159265358979323846d0
REAL(r64), PARAMETER :: PSea=101325.0d0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! REAL(r64) RhoOut ! air density outside [kg/m3]
REAL(r64) G ! gravity field strength [N/kg]
REAL(r64) RhoL1,RhoL2 ! Air density [kg/m3]
REAL(r64) Pbz ! Pbarom at entrance level [Pa]
REAL(r64) RhoDrL(2,NumOfLinksMultiZone) ! dry air density on both sides of the link [kg/m3]
REAL(r64) TempL1,TempL2 ! Temp in From and To zone at link level [C]
! REAL(r64) Tout ! outside temperature [C]
REAL(r64) Xhl1,Xhl2 ! Humidity in From and To zone at link level [kg/kg]
! REAL(r64) Xhout ! outside humidity [kg/kg]
REAL(r64) Hfl(NumOfLinksMultiZone) ! Own height factor for large (slanted) openings
INTEGER Nl ! number of links
REAL(r64) DpF(2),DpP,DpT(2)
REAL(r64) H
REAL(r64) RhoStF(2),RhoStT(2),RhoDrDummi
REAL(r64) BetaStF(2),BetaStT(2)
REAL(r64) T,X,HSt(2)
REAL(r64) TzFrom,XhzFrom
REAL(r64) TzTo, XhzTo
REAL(r64) ActLh,ActLOwnh
REAL(r64) Pref
REAL(r64) PzFrom,PzTo
REAL(r64) RhoLd(2),RhoStd
INTEGER From,To,Fromz,Toz,Ltyp
INTEGER I,ll,j,k,Pprof
INTEGER ilayptr,OpenNum
REAL(r64) RhoREF, CONV
! FLOW:
RhoREF = PsyRhoAirFnPbTdbW(Psea,OutDryBulbTemp,OutHumRat)
CONV=Latitude*2.d0*PI/360.d0
G=9.780373d0*(1.d0+.0052891d0*(SIN(CONV))**2-.0000059d0*(SIN(2.d0*CONV))**2)
Hfl = 1.0d0
Pbz = OutBaroPress
Nl = NumOfLinksMultiZone
OpenNum=0
RhoLd(1)=1.2d0
RhoLd(2)=1.2d0
RhoStd=1.2d0
DO I=1,Nl
! Check surface tilt
If (AirflowNetworkLinkageData(i)%DetOpenNum > 0 .and. &
Surface(MultizoneSurfaceData(I)%SurfNum)%Tilt .LT. 90) then
Hfl(i) = Surface(MultizoneSurfaceData(I)%SurfNum)%SinTilt
End If
! Initialisation
From=AirflowNetworkLinkageData(i)%NodeNums(1)
To=AirflowNetworkLinkageData(i)%NodeNums(2)
if (AirflowNetworkNodeData(From)%EPlusZoneNum > 0 .and.AirflowNetworkNodeData(To)%EPlusZoneNum > 0) then
LL=0
else if(AirflowNetworkNodeData(From)%EPlusZoneNum == 0 .and.AirflowNetworkNodeData(To)%EPlusZoneNum > 0) then
LL=1
else
LL=3
End if
Ltyp=AirflowNetworkCompData(AirflowNetworkLinkageData(i)%CompNum)%CompTypeNum
IF (Ltyp.EQ.CompTypeNum_DOP) THEN
ActLh=MultizoneSurfaceData(i)%Height
ActLOwnh=ActLh*1.0d0
ELSE
ActLh=0.0d0
ActLOwnh=0.0d0
ENDIF
TempL1=Tz(From)
XhL1=Wz(From)
TzFrom=Tz(From)
XhzFrom=Wz(From)
RhoL1=RhoZ(From)
IF (LL.eq.0 .OR. LL.EQ.3) THEN
PzFrom=Pz(From)
ELSE
PzFrom=0.0d0
From=0
ENDIF
ilayptr = 0
if (from .eq. 0) ilayptr = 1
IF (ilayptr.EQ.0) THEN
Fromz=0
ELSE
Fromz=From
ENDIF
TempL2=Tz(To)
XhL2=Wz(To)
TzTo=Tz(To)
XhzTo=Wz(To)
RhoL2=RhoZ(To)
IF (LL.LT.3) THEN
PzTo=Pz(To)
ELSE
PzTo=0.0d0
To=0
ENDIF
ilayptr = 0
if (To .eq. 0) ilayptr = 1
IF (ilayptr.EQ.0) THEN
Toz=0
ELSE
Toz=To
ENDIF
! RhoDrL is Rho at link level without pollutant but with humidity
RhoDrL(1,i) = PsyRhoAirFnPbTdbW(OutBaroPress+PzFrom,TempL1,XhL1)
RhoDrL(2,i) = PsyRhoAirFnPbTdbW(OutBaroPress+PzTo,TempL2,XhL2)
! End initialisation
! calculate DpF the difference between Pz and P at Node 1 height
ilayptr = 0
If (fromz .eq. 0) ilayptr = 1
J=ilayptr
k=1
CALL LClimb(G,Rhold(1),AirflowNetworkLinkageData(i)%NodeHeights(1),TempL1,XhL1, &
DpF(k),Toz,PzTo,Pbz,RhoDrL(1,I))
RhoL1=Rhold(1)
! For large openings calculate the stack pressure difference profile and the
! density profile within the the top- and the bottom- height of the large opening
IF (ActLOwnh.GT.0.0d0) THEN
HSt(k)=AirflowNetworkLinkageData(i)%NodeHeights(1)
RhoStF(k)=RhoL1
k=k+1
Hst(k)=0.0d0
If (Hst(k-1) .LT. 0.0d0) Hst(k) = Hst(k-1)
! Search for the first startheight of a layer which is within the top- and the
! bottom- height of the large opening.
Do
ilayptr = 0
If (Fromz .eq. 0) ilayptr = 9
IF ((J.GT.ilayptr).OR.(Hst(k).GT.AirflowNetworkLinkageData(i)%NodeHeights(1))) Exit
J=J+9
Hst(k)=0.0d0
If (Hst(k-1) .LT. 0.0d0) Hst(k) = Hst(k-1)
End Do
! Calculate Rho and stack pressure for every StartHeight of a layer which is
! within the top- and the bottom-height of the large opening.
Do
ilayptr = 0
If (Fromz .eq. 0) ilayptr = 9
IF ((J.GT.ilayptr).OR. &
(Hst(k).GE.(AirflowNetworkLinkageData(i)%NodeHeights(1)+ActLOwnh))) Exit !Objexx:BoundsViolation HSt(k) @ k>2
T=TzFrom
X=XhzFrom
CALL LClimb(G,RhoStd,HSt(k),T,X,DpF(k),Fromz,PzFrom,Pbz,RhoDrDummi) !Objexx:BoundsViolation HSt(k) and DpF(k) @ k>2
RhoStF(k)=Rhostd !Objexx:BoundsViolation RhoStF(k) @ k>2
J=J+9
k=k+1 !Objexx k>2 now
Hst(k)=0.0d0 !Objexx:BoundsViolation @ k>2
If (Hst(k-1) .LT. 0.0d0) Hst(k) = Hst(k-1) !Objexx:BoundsViolation @ k>2
End Do
! Stack pressure difference and rho for top-height of the large opening
HSt(k)=AirflowNetworkLinkageData(i)%NodeHeights(1)+ActLOwnh !Objexx:BoundsViolation k>2 poss
T=TzFrom
X=XhzFrom
CALL LClimb(G,RhoStd,HSt(k),T,X,DpF(k),Fromz,PzFrom,Pbz,RhoDrDummi) !Objexx:BoundsViolation k>2 poss
RhoStF(k)=RhoStd !Objexx:BoundsViolation k >= 3 poss
DO J=1,(k-1)
BetaStF(J)=(RhoStF(J+1)-RhoStF(J))/(HSt(J+1)-HSt(J))
END DO
ENDIF
! repeat procedure for the "To" node, DpT
ilayptr = 0
if (Toz .eq. 0) ilayptr = 1
J = ilayptr
! Calculate Rho at link height only if we have large openings or layered zones.
k=1
CALL LClimb(G,RhoLd(2),AirflowNetworkLinkageData(i)%NodeHeights(2),TempL2,XhL2, &
DpT(k),Toz,PzTo,Pbz,RhoDrL(2,I))
RhoL2=RhoLd(2)
! For large openings calculate the stack pressure difference profile and the
! density profile within the the top- and the bottom- height of the large opening
IF (ActLOwnh.GT.0.0d0) THEN
HSt(k)=AirflowNetworkLinkageData(i)%NodeHeights(2)
RhoStT(k)=RhoL2
k=k+1
Hst(k)=0.0d0
If (Hst(k-1) .LT. 0.0d0) Hst(k) = Hst(k-1)
Do
ilayptr = 0
if (Toz .eq. 0) ilayptr = 9
IF ((J.GT.ilayptr).OR.(Hst(k).GT.AirflowNetworkLinkageData(i)%NodeHeights(2))) Exit
J=J+9
Hst(k)=0.0d0
If (Hst(k-1) .LT. 0.0d0) Hst(k) = Hst(k-1)
End Do
! Calculate Rho and stack pressure for every StartHeight of a layer which is
! within the top- and the bottom-height of the large opening.
Do
ilayptr = 0
if (Toz .eq. 0) ilayptr = 9
IF ((J.GT.ilayptr).OR. (Hst(k).GE.(AirflowNetworkLinkageData(i)%NodeHeights(2)+ActLOwnh))) Exit !Objexx:BoundsViolation Hst(k) @ k>2
T=TzTo
X=XhzTo
CALL LClimb(G,RhoStd,HSt(k),T,X,DpT(k),Toz,PzTo,Pbz,RhoDrDummi) !Objexx:BoundsViolation HSt(k) and DpT(k) @ k>2
RhoStT(k)=RhoStd !Objexx:BoundsViolation RhoStT(k) @ k>2
J=J+9
k=k+1 !Objexx k>2 now
Hst(k)=0.0d0 !Objexx:BoundsViolation @ k>2
If (Hst(k-1) .LT. 0.0d0) Hst(k) = Hst(k-1) !Objexx:BoundsViolation @ k>2
End Do
! Stack pressure difference and rho for top-height of the large opening
HSt(k)=AirflowNetworkLinkageData(i)%NodeHeights(2)+ActLOwnh !Objexx:BoundsViolation k>2 poss
T=TzTo
X=XhzTo
CALL LClimb(G,RhoStd,HSt(k),T,X,DpT(k),Toz,PzTo,Pbz,RhoDrDummi) !Objexx:BoundsViolation k>2 poss
RhoStT(k)=RhoStd !Objexx:BoundsViolation k>2 poss
DO J=1,(k-1)
BetaStT(J)=(RhoStT(J+1)-RhoStT(J))/(HSt(J+1)-HSt(J))
END DO
ENDIF
! CALCULATE STACK PRESSURE FOR THE PATH ITSELF for different flow directions
H=REAL(AirflowNetworkLinkageData(i)%NodeHeights(2),r64) - &
REAL(AirflowNetworkLinkageData(i)%NodeHeights(1),r64)
IF (LL.eq.0 .OR. LL.EQ.3 .OR. LL.EQ.6) THEN
H=H-AirflowNetworkNodeData(From)%NodeHeight
ENDIF
IF (LL.LT.3) THEN
H=H+AirflowNetworkNodeData(To)%NodeHeight
ENDIF
! IF AIR FLOWS from "From" to "To"
Pref=Pbz+Pzfrom+DpF(1)
DpP=psz(Pref,RhoLd(1),0.0d0,0.0d0,H,G)
DpL(1,I)=(DpF(1)-DpT(1)+DpP)
! IF AIR FLOWS from "To" to "From"
Pref=Pbz+Pzto+DpT(1)
DpP=-psz(Pref,RhoLd(2),0.0d0,0.0d0,-H,G)
DpL(2,I)=(DpF(1)-DpT(1)+DpP)
IF (Ltyp.EQ.CompTypeNum_DOP) THEN
Pprof=OpenNum*(NrInt+2)
CALL PresProfile(i,Pprof,G,DpF,DpT,BetaStF,BetaStT,RhoStF,RhoStT,from,To,ActLh,Hfl(I))
OpenNum = OpenNum+1
ENDIF
END DO
RETURN
END SUBROUTINE PStack