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 CalcWindPressureCoeffs
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN May 2003
! MODIFIED Revised by L. Gu, Nov. 2005, to meet requirements of AirflowNetwork
! MODIFIED Revised by L. Gu, Dec. 2008, to set the number of external nodes based on
! the number of external surfaces
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates surface-average wind pressure coefficients for
! the walls and roof of a rectangular building.
! METHODOLOGY EMPLOYED:
! Interpolates correlations between surface-average wind pressure coefficient and wind direction based on
! measurements (see REFERENCES). Applicable only to rectangular buildings.
! REFERENCES:
! For low-rise buildings: M.V. Swami and S. Chandra, Correlations for Pressure Distribution
! on Buildings and Calculation of Natural-Ventilation Airflow. ASHRAE Transactions 94 (1): 243-266.
! For high-rise buildings: 2001 ASHRAE Fundamentals Handbook, p. 16.5, Fig. 7, "Surface Averaged
! Wall Pressure Coefficients for Tall Buildings" and p.16.6, Fig. 9, "Surface Averaged Roof Pressure
! Coefficients for Tall Buildings; from R.E. Akins, J.A. Peterka, and J.E. Cermak. 1979.
! Averaged Pressure Coefficients for Rectangular Buildings. Wind Engineering. Proc. Fifth
! International Conference 7:369-80, Fort Collins, CO. Pergamon Press, NY.
! USE STATEMENTS:
USE DataSurfaces
USE InputProcessor, ONLY: SameString
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 :: FacadeNum ! Facade number
INTEGER :: ExtNum ! External number
REAL(r64) :: FacadeAng(5) ! Facade azimuth angle (for walls, angle of outward normal
! to facade measured clockwise from North) (deg)
REAL(r64) :: SideRatio ! For vertical facades, width of facade / width of adjacent facade
REAL(r64) :: SR ! SideRatio restricted to 0.25 to 4.0 range
REAL(r64) :: SideRatioFac ! Log(SideRatio)
INTEGER :: WindDirNum ! Wind direction number
REAL(r64) :: WindAng ! Wind direction angle (degrees clockwise from North)
REAL(r64) :: IncAng ! Wind incidence angle relative to facade normal (deg)
REAL(r64) :: IncRad ! IncAng in radians
INTEGER :: IAng ! Incidence angle index; used in interpolation
REAL(r64) :: DelAng ! Incidence angle difference; used in interpolation
REAL(r64) :: WtAng ! Incidence angle weighting factor; used in interpolation
INTEGER :: ISR ! Side ratio index, for interpolation
REAL(r64) :: WtSR ! Side ratio weighting factor; used in interpolation
INTEGER :: SurfNum ! Surface number
INTEGER :: SurfDatNum ! Surface data number
REAL(r64) :: SurfAng ! Azimuth angle of surface normal (degrees clockwise from North)
INTEGER :: FacadeNumThisSurf ! Facade number for a particular surface
REAL(r64) :: AngDiff ! Angle difference between wind and surface direction (deg)
REAL(r64) :: AngDiffMin ! Minimum angle difference between wind and surface direction (deg)
REAL(r64) :: CPHighRiseWall(12,3) ! Surface-averaged wind-pressure coefficient array for walls;
! index 1 is wind incidence angle (0,30,60,...,300,330 deg)
! index 2 is side ratio (0.25,1.0,4.0),
REAL(r64) :: CPHighRiseRoof(12,3) ! Surface-averaged wind-pressure coefficient array for roof;
! index 1 is wind incidence angle (0,30,60,...,300,330 deg)
! index 2 is side ratio (0.25,0.5,1.0),
CHARACTER(15) :: Name ! External node name
DATA CPHighRiseWall / 0.60d0, 0.54d0, 0.23d0,-0.25d0,-0.61d0,-0.55d0,-0.51d0,-0.55d0,-0.61d0,-0.25d0, 0.23d0, 0.54d0, &
0.60d0, 0.48d0, 0.04d0,-0.56d0,-0.56d0,-0.42d0,-0.37d0,-0.42d0,-0.56d0,-0.56d0, 0.04d0, 0.48d0, &
0.60d0, 0.44d0,-0.26d0,-0.70d0,-0.53d0,-0.32d0,-0.22d0,-0.32d0,-0.53d0,-0.70d0,-0.26d0, 0.44d0 /
DATA CPHighRiseRoof /-0.28d0,-0.69d0,-0.72d0,-0.76d0,-0.72d0,-0.69d0,-0.28d0,-0.69d0,-0.72d0,-0.76d0,-0.72d0,-0.69d0, &
-0.47d0,-0.52d0,-0.70d0,-0.76d0,-0.70d0,-0.52d0,-0.47d0,-0.52d0,-0.70d0,-0.76d0,-0.70d0,-0.52d0, &
-0.70d0,-0.55d0,-0.55d0,-0.70d0,-0.55d0,-0.55d0,-0.70d0,-0.55d0,-0.55d0,-0.70d0,-0.55d0,-0.55d0 /
! Create five AirflowNetwork external node objects -- one for each of the four facades and one for the roof
ALLOCATE(MultizoneExternalNodeData(AirflowNetworkNumOfExtSurfaces))
AirflowNetworkNumOfExtNode = AirflowNetworkNumOfExtSurfaces
NumOfExtNodes = AirflowNetworkNumOfExtSurfaces
DO ExtNum = 1,NumOfExtNodes
MultizoneExternalNodeData(ExtNum)%ExtNum = AirflowNetworkNumOfZones+ExtNum
Write(Name,'("ExtNode",I4)') ExtNum
MultizoneExternalNodeData(ExtNum)%Name = ADJUSTL(Name)
END DO
! Facade azimuth angle
DO FacadeNum = 1,4
FacadeAng(FacadeNum) = AirflowNetworkSimu%Azimuth + (FacadeNum-1)*90.0d0
IF(FacadeAng(FacadeNum) .GE. 360.0d0) FacadeAng(FacadeNum) = FacadeAng(FacadeNum) - 360.0d0
END DO
FacadeAng(5) = AirflowNetworkSimu%Azimuth + 90.0d0
! Associate each SurfaceData with an external node
ExtNum = 0
DO SurfDatNum = 1,AirflowNetworkNumOfSurfaces
SurfNum = MultizoneSurfaceData(SurfDatNum)%SurfNum
IF (SurfNum == 0) CYCLE ! Error caught earlier
IF(Surface(SurfNum)%ExtBoundCond == ExternalEnvironment) THEN
ExtNum = ExtNum + 1
IF(Surface(SurfNum)%Tilt >= 45.0d0) THEN ! "Vertical" surface
SurfAng = Surface(SurfNum)%Azimuth
FacadeNumThisSurf = 1
AngDiffMin = ABS(SurfAng - FacadeAng(1))
If (AngDiffMin .GT. 359.d0) AngDiffMin = ABS(AngDiffMin - 360.d0)
DO FacadeNum = 2,4
AngDiff = ABS(SurfAng-FacadeAng(FacadeNum))
If (AngDiff .GT. 359.d0) AngDiff = ABS(AngDiff - 360.d0)
IF(AngDiff < AngDiffMin) THEN
AngDiffMin = AngDiff
FacadeNumThisSurf = FacadeNum
END IF
END DO
Write(Name,'("FacadeNum",I1)') FacadeNumThisSurf
MultizoneExternalNodeData(ExtNum)%CPVNum = FacadeNumThisSurf
ELSE ! "Roof" surface
Write(Name,'("FacadeNum",I1)') 5
MultizoneExternalNodeData(ExtNum)%CPVNum = 5
END IF
MultizoneExternalNodeData(ExtNum)%WPCName = ADJUSTL(Name)
MultizoneSurfaceData(SurfDatNum)%NodeNums(2) = MultizoneExternalNodeData(ExtNum)%ExtNum
MultizoneSurfaceData(SurfDatNum)%ExternalNodeName = MultizoneExternalNodeData(ExtNum)%Name
ELSE ! Not an exterior surface
! MultizoneSurfaceData(SurfDatNum)%ExternalNodeName = ' '
END IF
END DO
! Create the CP Array of wind directions
ALLOCATE(MultizoneCPArrayData(1))
AirflowNetworkNumOfCPArray = 1
MultizoneCPArrayData(1)%Name='EVERY30DEGREES'
AirflowNetworkSimu%CpArrayName = 'EVERY30DEGREESNAME'
MultizoneCPArrayData(1)%NumWindDir = 12
AirflowNetworkSimu%NWind = 12
ALLOCATE(MultizoneCPArrayData(1)%WindDir(MultizoneCPArrayData(1)%NumWindDir))
MultizoneCPArrayData(1)%WindDir = 0.0d0
DO WindDirNum = 1,12
MultizoneCPArrayData(1)%WindDir(WindDirNum) = (WindDirNum-1)*30.0d0
END DO
! Calculate the wind pressure coefficients vs. wind direction for each external node
ALLOCATE(MultizoneCpValueData(5))
AirflowNetworkNumOfCPValue = 5
DO FacadeNum = 1,5
Write(Name,'("FacadeNum",I1)') FacadeNum
MultizoneCpValueData(FacadeNum)%Name = ADJUSTL(Name)
MultizoneCpValueData(FacadeNum)%CPArrayName = 'EVERY30DEGREES'
ALLOCATE(MultizoneCpValueData(FacadeNum)%CpValue(MultizoneCPArrayData(1)%NumWindDir))
MultizoneCpValueData(FacadeNum)%CpValue = 0.0d0
END DO
DO FacadeNum = 1,5
IF(FacadeNum == 1 .OR. FacadeNum == 3 .OR. FacadeNum == 5) THEN
SideRatio = AirflowNetworkSimu%AspectRatio
ELSE ! FacadeNum = 2 or 4
SideRatio = 1.0/AirflowNetworkSimu%AspectRatio
END IF
If (SameString(AirflowNetworkSimu%BldgType,'HighRise') .AND. FacadeNum .NE. 5) SideRatio = 1.d0/SideRatio
SideRatioFac = LOG(SideRatio)
DO WindDirNum = 1,12
WindAng = (WindDirNum-1)*30.0d0
IncAng = ABS(WindAng - FacadeAng(FacadeNum))
IF(IncAng > 180.0d0) IncAng = 360.0d0 - IncAng
IAng = INT(IncAng/30.0d0) + 1
DelAng = MOD(IncAng,30.0d0)
WtAng = 1.0d0 - DelAng/30.0d0
! Wind-pressure coefficients for vertical facades, low-rise building
IF(SameString(AirflowNetworkSimu%BldgType,'LowRise') .AND. FacadeNum <= 4) THEN
IncRad = IncAng*DegToRadians
MultizoneCpValueData(FacadeNum)%CpValue(WindDirNum) = 0.6d0 * LOG( &
1.248d0 - 0.703d0*SIN(IncRad/2.d0) - 1.175d0*SIN(IncRad)**2 + 0.131d0*SIN(2.d0*IncRad*SideRatioFac)**3 + &
0.769d0*COS(IncRad/2.d0) + 0.07d0*(SideRatioFac*SIN(IncRad/2.d0))**2 + 0.717d0*COS(IncRad/2.d0)**2 )
END IF
! Wind-pressure coefficients for vertical facades, high-rise building
IF(SameString(AirflowNetworkSimu%BldgType,'HighRise') .AND. FacadeNum <=4) THEN
SR = MIN(MAX(SideRatio,0.25d0),4.0d0)
IF(SR >= 0.25d0 .AND. SR < 1.0d0) THEN
ISR = 1
WtSR = (1.0d0 - SR)/0.75d0
ELSE ! 1.0 <= SR <= 4.0
ISR = 2
WtSR = (4.0d0 - SR)/3.0d0
END IF
MultizoneCpValueData(FacadeNum)%CpValue(WindDirNum) = &
WtSR * (WtAng*CPHighRiseWall(IAng,ISR) + (1.0d0-WtAng)*CPHighRiseWall(IAng+1,ISR)) + &
(1.0d0-WtSR)* (WtAng*CPHighRiseWall(IAng,ISR+1) + (1.0d0-WtAng)*CPHighRiseWall(IAng+1,ISR+1))
END IF
! Wind-pressure coefficients for roof (assumed same for low-rise and high-rise buildings)
IF( (SameString(AirflowNetworkSimu%BldgType,'HighRise') .OR. SameString(AirflowNetworkSimu%BldgType,'LowRise')) &
.AND. FacadeNum == 5) THEN
SR = MIN(MAX(SideRatio,0.25d0),1.0d0)
IF(SR >= 0.25d0 .AND. SR < 0.5d0) THEN
ISR = 1
WtSR = (0.5d0 - SR)/0.25d0
ELSE ! 0.5 <= SR <= 1.0
ISR = 2
WtSR = (1.0d0 - SR)/0.5d0
END IF
MultizoneCpValueData(FacadeNum)%CpValue(WindDirNum) = &
WtSR * (WtAng*CPHighRiseRoof(IAng,ISR) + (1.0d0-WtAng)*CPHighRiseRoof(IAng+1,ISR)) + &
(1.0d0-WtSR)* (WtAng*CPHighRiseRoof(IAng,ISR+1) + (1.0d0-WtAng)*CPHighRiseRoof(IAng+1,ISR+1))
END IF
END DO ! End of wind direction loop
END DO ! End of facade number loop
END SUBROUTINE CalcWindPressureCoeffs