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) | :: | NRS | |||
integer, | intent(in) | :: | NSS | |||
real(kind=r64), | intent(in) | :: | ZMIN | |||
logical, | intent(out) | :: | CannotShade |
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 CHKGSS(NRS,NSS,ZMIN,CannotShade)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED na
! RE-ENGINEERED Lawrie, Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! Determines the possible shadowing combinations. The
! routine checks detached shadowing or base heat transfer surfaces
! for the possibility that they cannot shade a given base heat transfer surface.
! METHODOLOGY EMPLOYED:
! Shadowing is not possible if:
! 1. The lowest point of the shadow receiving surface (receiving surface)
! Is higher than the highest point of the shadow casting surface (s.s.)
! 2. The shadow casting surface Faces up (e.g. A flat roof)
! 3. The shadow casting surface Is behind the receiving surface
! 4. The receiving surface is behind the shadow casting surface
! REFERENCES:
! BLAST/IBLAST code, original author George Walton
! USE STATEMENTS:
USE Vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: ZMIN ! Lowest point of the receiving surface
INTEGER, INTENT(IN) :: NRS ! Surface number of the potential shadow receiving surface
INTEGER, INTENT(IN) :: NSS ! Surface number of the potential shadow casting surface
LOGICAL, INTENT(OUT) :: CannotShade ! TRUE if shadow casting surface cannot shade receiving surface.
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(KIND=r64) :: TolValue=0.0003d0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER I ! Loop Control (vertex counter)
INTEGER NVRS ! Number of vertices of the receiving surface
INTEGER NVSS ! Number of vertices of the shadow casting surface
TYPE (Vector) AVec ! Vector from vertex 2 to vertex 1, both same surface
TYPE (Vector) BVec ! Vector from vertex 2 to vertex 3, both same surface
TYPE (Vector) CVec ! Vector perpendicular to surface at vertex 2
TYPE (Vector) DVec ! Vector from vertex 2 of first surface to vertex 'n' of second surface
REAL(r64) ZMAX ! Highest point of the shadow casting surface
REAL(r64) DOTP ! Dot Product
CannotShade=.TRUE.
NVRS=Surface(NRS)%Sides
NVSS=Surface(NSS)%Sides
! see if no point of shadow casting surface is above low point of receiving surface
ZMAX=MAXVAL(Surface(NSS)%Vertex(1:Surface(NSS)%Sides)%Z)
IF (ZMAX <= ZMIN) RETURN
! SEE IF Shadow Casting Surface IS HORIZONTAL AND FACING UPWARD.
IF (Surface(NSS)%OutNormVec(3) > 0.9999d0) RETURN
! SEE IF ANY VERTICES OF THE Shadow Casting Surface ARE ABOVE THE PLANE OF THE receiving surface
AVec=Surface(NRS)%Vertex(1)-Surface(NRS)%Vertex(2)
BVec=Surface(NRS)%Vertex(3)-Surface(NRS)%Vertex(2)
CVec=BVec*AVec
DO I = 1, NVSS
DVec=Surface(NSS)%Vertex(I)-Surface(NRS)%Vertex(2)
DOTP=CVec.dot.DVec
IF (DOTP > TolValue) EXIT ! DO loop
END DO
! SEE IF ANY VERTICES OF THE receiving surface ARE ABOVE THE PLANE OF THE S.S.
IF (DOTP > TolValue) THEN
AVec=Surface(NSS)%Vertex(1)-Surface(NSS)%Vertex(2)
BVec=Surface(NSS)%Vertex(3)-Surface(NSS)%Vertex(2)
CVec=BVec*AVec
DO I = 1, NVRS
DVec=Surface(NRS)%Vertex(I)-Surface(NSS)%Vertex(2)
DOTP=CVec.dot.DVec
IF (DOTP > TolValue) THEN
CannotShade=.false.
EXIT ! DO loop
ENDIF
END DO
END IF
RETURN
END SUBROUTINE CHKGSS