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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | SurfNum | |||
real(kind=r64), | intent(in) | :: | XCoord | |||
real(kind=r64), | intent(in) | :: | YCoord | |||
real(kind=r64), | intent(in) | :: | ZCoord | |||
real(kind=r64), | intent(in) | :: | Length | |||
real(kind=r64), | intent(in) | :: | Height | |||
logical, | intent(in) | :: | SurfWorldCoordSystem |
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 MakeRectangularVertices(SurfNum,XCoord,YCoord,ZCoord,Length,Height,SurfWorldCoordSystem)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN December 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine creates world/3d coordinates for rectangular surfaces using azimuth, tilt, LLC (X,Y,Z), length & height.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE Vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SurfNum
REAL(r64), INTENT(IN) :: XCoord
REAL(r64), INTENT(IN) :: YCoord
REAL(r64), INTENT(IN) :: ZCoord
REAL(r64), INTENT(IN) :: Length
REAL(r64), INTENT(IN) :: Height
LOGICAL, INTENT(IN) :: SurfWorldCoordSystem
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: SurfAzimuth ! Surface Azimuth/Facing (same as Base Surface)
REAL(r64) :: SurfTilt ! Tilt (same as Base Surface)
REAL(r64) :: XLLC
REAL(r64) :: YLLC
REAL(r64) :: ZLLC
REAL(r64) :: CosSurfAzimuth
REAL(r64) :: SinSurfAzimuth
REAL(r64) :: CosSurfTilt
REAL(r64) :: SinSurfTilt
REAL(r64) :: XX(4),YY(4)
REAL(r64) :: Xb, Yb
REAL(r64) :: Perimeter
INTEGER :: N
INTEGER :: Vrt
IF (SurfaceTmp(SurfNum)%Zone == 0 .and. &
(SurfaceTmp(SurfNum)%Class /= SurfaceClass_Detached_F .and. &
SurfaceTmp(SurfNum)%Class /= SurfaceClass_Detached_B)) RETURN
SurfaceTmp(SurfNum)%Height=Height
SurfaceTmp(SurfNum)%Width=Length
SurfAzimuth = SurfaceTmp(SurfNum)%Azimuth
SurfTilt = SurfaceTmp(SurfNum)%Tilt
CosSurfAzimuth=COS(SurfAzimuth*DegToRadians)
SinSurfAzimuth=SIN(SurfAzimuth*DegToRadians)
CosSurfTilt=COS(SurfTilt*DegToRadians)
SinSurfTilt=SIN(SurfTilt*DegToRadians)
IF (.not. SurfWorldCoordSystem) THEN
IF (SurfaceTmp(SurfNum)%Zone > 0) THEN
Xb = XCoord*CosZoneRelNorth(SurfaceTmp(SurfNum)%Zone) &
-YCoord*SinZoneRelNorth(SurfaceTmp(SurfNum)%Zone) + Zone(SurfaceTmp(SurfNum)%Zone)%OriginX
Yb = XCoord*SinZoneRelNorth(SurfaceTmp(SurfNum)%Zone) &
+YCoord*CosZoneRelNorth(SurfaceTmp(SurfNum)%Zone) + Zone(SurfaceTmp(SurfNum)%Zone)%OriginY
XLLC = Xb*CosBldgRelNorth - Yb*SinBldgRelNorth
YLLC = Xb*SinBldgRelNorth + Yb*CosBldgRelNorth
ZLLC = ZCoord + Zone(SurfaceTmp(SurfNum)%Zone)%OriginZ
ELSE
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_B) THEN
Xb = XCoord
Yb = YCoord
XLLC = Xb*CosBldgRelNorth - Yb*SinBldgRelNorth
YLLC = Xb*SinBldgRelNorth + Yb*CosBldgRelNorth
ZLLC = ZCoord
ELSE
XLLC = XCoord
YLLC = YCoord
ZLLC = ZCoord
ENDIF
ENDIF
ELSE
! for world coordinates, only rotate for appendix G
Xb = XCoord
Yb = YCoord
ZLLC = ZCoord
IF (SurfaceTmp(SurfNum)%Class /= SurfaceClass_Detached_F) THEN
XLLC= Xb*CosBldgRotAppGonly - Yb*SinBldgRotAppGonly
YLLC= Xb*SinBldgRotAppGonly + Yb*CosBldgRotAppGonly
ELSE
XLLC = Xb
YLLC = Yb
ENDIF
ENDIF
XX(1)=0.0d0
XX(2)=0.0d0
XX(3)=Length
XX(4)=Length
YY(1)=Height
YY(4)=Height
YY(3)=0.0d0
YY(2)=0.0d0
DO N = 1, SurfaceTmp(SurfNum)%Sides
Vrt=N
SurfaceTmp(SurfNum)%Vertex(Vrt)%X=XLLC-XX(N)*CosSurfAzimuth-YY(N)*CosSurfTilt*SinSurfAzimuth
SurfaceTmp(SurfNum)%Vertex(Vrt)%Y=YLLC+XX(N)*SinSurfAzimuth-YY(N)*CosSurfTilt*CosSurfAzimuth
SurfaceTmp(SurfNum)%Vertex(Vrt)%Z=ZLLC+YY(N)*SinSurfTilt
END DO
CALL CreateNewellAreaVector(SurfaceTmp(SurfNum)%Vertex,SurfaceTmp(SurfNum)%Sides,SurfaceTmp(SurfNum)%NewellAreaVector)
SurfaceTmp(SurfNum)%GrossArea=VecLength(SurfaceTmp(SurfNum)%NewellAreaVector)
SurfaceTmp(SurfNum)%Area=SurfaceTmp(SurfNum)%GrossArea
SurfaceTmp(SurfNum)%NetAreaShadowCalc = SurfaceTmp(SurfNum)%Area
CALL CreateNewellSurfaceNormalVector(SurfaceTmp(SurfNum)%Vertex,SurfaceTmp(SurfNum)%Sides, &
SurfaceTmp(SurfNum)%NewellSurfaceNormalVector)
CALL DetermineAzimuthAndTilt(SurfaceTmp(SurfNum)%Vertex,SurfaceTmp(SurfNum)%Sides,SurfAzimuth,SurfTilt, &
SurfaceTmp(SurfNum)%lcsx,SurfaceTmp(SurfNum)%lcsy,SurfaceTmp(SurfNum)%lcsz, &
SurfaceTmp(SurfNum)%GrossArea,SurfaceTmp(SurfNum)%NewellSurfaceNormalVector)
SurfaceTmp(SurfNum)%Azimuth=SurfAzimuth
SurfaceTmp(SurfNum)%Tilt=SurfTilt
! Sine and cosine of azimuth and tilt
SurfaceTmp(SurfNum)%SinAzim = SinSurfAzimuth
SurfaceTmp(SurfNum)%CosAzim = CosSurfAzimuth
SurfaceTmp(SurfNum)%SinTilt = SinSurfTilt
SurfaceTmp(SurfNum)%CosTilt = CosSurfTilt
SurfaceTmp(SurfNum)%ViewFactorGround = 0.5d0 * (1.0d0 - SurfaceTmp(SurfNum)%CosTilt)
! Outward normal unit vector (pointing away from room)
SurfaceTmp(SurfNum)%OutNormVec = SurfaceTmp(SurfNum)%NewellSurfaceNormalVector
DO N=1,3
IF (ABS(SurfaceTmp(SurfNum)%OutNormVec(N)-1.0d0) < 1.d-06) SurfaceTmp(SurfNum)%OutNormVec(N) = +1.0d0
IF (ABS(SurfaceTmp(SurfNum)%OutNormVec(N)+1.0d0) < 1.d-06) SurfaceTmp(SurfNum)%OutNormVec(N) = -1.0d0
IF (ABS(SurfaceTmp(SurfNum)%OutNormVec(N)) < 1.d-06) SurfaceTmp(SurfNum)%OutNormVec(N) = 0.0d0
ENDDO
! IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Roof .and. SurfTilt > 80.) THEN
! WRITE(TiltString,'(F5.1)') SurfTilt
! TiltString=ADJUSTL(TiltString)
! CALL ShowWarningError('Roof/Ceiling Tilt='//TRIM(TiltString)//', much greater than expected tilt of 0,'// &
! ' for Surface='//TRIM(SurfaceTmp(SurfNum)%Name)// &
! ', in Zone='//TRIM(SurfaceTmp(SurfNum)%ZoneName))
! ENDIF
! IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and. SurfTilt < 170.) THEN
! WRITE(TiltString,'(F5.1)') SurfTilt
! TiltString=ADJUSTL(TiltString)
! CALL ShowWarningError('Floor Tilt='//TRIM(TiltString)//', much less than expected tilt of 180,'// &
! ' for Surface='//TRIM(SurfaceTmp(SurfNum)%Name)// &
! ', in Zone='//TRIM(SurfaceTmp(SurfNum)%ZoneName))
! ENDIF
! Can perform tests on this surface here
SurfaceTmp(SurfNum)%ViewFactorSky=0.5d0*(1.d0+SurfaceTmp(SurfNum)%CosTilt)
! The following IR view factors are modified in subr. SkyDifSolarShading if there are shadowing
! surfaces
SurfaceTmp(SurfNum)%ViewFactorSkyIR = SurfaceTmp(SurfNum)%ViewFactorSky
SurfaceTmp(SurfNum)%ViewFactorGroundIR = 0.5d0*(1.d0-SurfaceTmp(SurfNum)%CosTilt)
Perimeter=Distance(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides),SurfaceTmp(SurfNum)%Vertex(1))
DO Vrt=2,SurfaceTmp(SurfNum)%Sides
Perimeter = Perimeter+Distance(SurfaceTmp(SurfNum)%Vertex(Vrt),SurfaceTmp(SurfNum)%Vertex(Vrt-1))
ENDDO
SurfaceTmp(SurfNum)%Perimeter=Perimeter
! Call to transform vertices
Call TransformVertsByAspect(SurfNum,SurfaceTmp(SurfNum)%Sides)
RETURN
END SUBROUTINE MakeRectangularVertices