Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(CFSLAYER), | intent(inout) | :: | L | |||
real(kind=r64), | intent(in) | :: | THETA | |||
real(kind=r64), | intent(in) | :: | OMEGA_V | |||
real(kind=r64), | intent(in) | :: | OMEGA_H |
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.
LOGICAL FUNCTION DoShadeControl(L, THETA, OMEGA_V, OMEGA_H)
!
! FUNCTION INFORMATION:
! AUTHOR JOHN L. WRIGHT, University of Waterloo, Mechanical Engineering
! Advanced Glazing System Laboratory
! DATE WRITTEN unknown
! MODIFIED na
!
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! Returns .TRUE. if L is modified for shade control.
!
! METHODOLOGY EMPLOYED:
! na
!
! REFERENCES:
! na
!
! USE STATEMENTS:
! na
!
IMPLICIT NONE
! FUNCTION ARGUMENT DEFINITIONS:
TYPE( CFSLAYER), INTENT(INOUT):: L ! layer (returned updated)
REAL(r64), INTENT(IN):: THETA ! solar beam angle of incidence, from normal, (radians)
! 0 <= THETA <= PI/2
REAL(r64), INTENT(IN):: OMEGA_V ! solar beam vertical profile angle, +=above horizontal (radians)
! = solar elevation angle for a vertical wall with
! wall-solar azimuth angle equal to zero
REAL(r64), INTENT(IN):: OMEGA_H ! solar beam horizontal profile angle, +=clockwise when viewed
! from above (radians)
! = wall-solar azimuth angle for a vertical wall
! Used for PD and vertical VB
!
! FUNCTION PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: OMEGA_DEG ! controlling profile angel, degrees
! Flow
DoShadeControl = .FALSE. ! default: no shade controls implemented
! must be consistent with IsControlledShade()
IF (IsVBLayer( L) .AND. L%CNTRL /= lscNONE) THEN
IF (THETA < 0.0d0 .OR. THETA >= PiOvr2) THEN
OMEGA_DEG = -1. ! diffuse only
ELSE IF (L%LTYPE == ltyVBHOR) THEN
! horiz VB
OMEGA_DEG = RadiansToDeg * OMEGA_V
ELSE
! vert VB
OMEGA_DEG = RadiansToDeg * OMEGA_H
ENDIF
IF (VB_ShadeControl( L, OMEGA_DEG) ) THEN
CALL FinalizeCFSLAYER( L)
DoShadeControl = .TRUE.
END IF
END IF
RETURN
END FUNCTION DoShadeControl