Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | NL | |||
type(CFSSWP), | intent(in) | :: | LSWP_ON(:) | |||
type(CFSSWP), | intent(in) | :: | SWP_ROOM | |||
real(kind=r64), | intent(in) | :: | IBEAM | |||
real(kind=r64), | intent(in) | :: | IDIFF | |||
real(kind=r64), | intent(in) | :: | ILIGHTS | |||
real(kind=r64), | intent(out) | :: | SOURCE(NL+1) | |||
real(kind=r64), | intent(out), | optional | :: | SourceBD(NL+1) |
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 ASHWAT_Solar(NL, LSWP_ON, SWP_ROOM, IBEAM, IDIFF, ILIGHTS, SOURCE, SourceBD)
!
! SUBROUTINE INFORMATION:
! AUTHOR JOHN L. WRIGHT and NATHAN KOTEY,
! DATE WRITTEN June, 2006
! MODIFIED Bereket Nigusse, JUNE 2013
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Returns the optical properties of multi-layer fenestration system model given optical
! properties of the layers
!
! METHODOLOGY EMPLOYED:
! Ues combination net radiation method and TDMA solver
!
! REFERENCES:
! JOHN L. WRIGHT and NATHAN KOTEY (2006). Solar Absorption By each Element in a Glazing/Shading
! Layer Array, ASHRAE Transactions, Vol. 112, Pt. 2. pp. 3-12.
! University of Waterloo, Mechanical Engineering
! Advanced Glazing System Laboratory
!
! USE STATEMENTS:
! na
!
!
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: NL ! # of layers
TYPE (CFSSWP), INTENT(IN) :: LSWP_ON(:) ! layer SW (solar) properties (off-normal adjusted)
! 1=outside .. NL=inside
TYPE (CFSSWP), INTENT(IN) :: SWP_ROOM ! effective SW (solar) properties of room
! generally black or minimally reflective
REAL(r64), INTENT(IN) :: IBEAM ! incident beam insolation (W/m2 aperture)
REAL(r64), INTENT(IN) :: IDIFF ! incident diffuse insolation (W/m2 aperture)
REAL(r64), INTENT(IN) :: ILIGHTS ! incident diffuse insolation (W/m2 aperture)
! on inside surface (e.g., from lights)
REAL(r64), INTENT(OUT):: SOURCE( NL+1) ! returned: layer-by-layer flux of absorbed
! solar radiation (beam-beam + beam-diffuse) (W/m2)
! SOURCE(NL+1) is the flux of solar radiation
! absorbed in conditioned space (W/m2 aperture area)
REAL(r64),OPTIONAL,INTENT(OUT):: SourceBD(NL+1) ! returned: layer-by-layer flux of absorbed
! beam-diffuse solar radiation (W/m2)
! SOURCE_BD(NL+1) is the flux of beam-diffuse solar radiation
! absorbed in conditioned space (W/m2 aperture area)
! or this beam-diffuse solar transmittance of the system
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS
!
REAL(r64) :: BPLUS(0:NL),BMINUS(0:NL) ! beam solar fluxes flowing in outward and inward directions
! correspond to Edwards QPLUS and QMINUS (except note
! reverse layer numbering)
REAL(r64) :: CPLUS(0:NL),CMINUS(0:NL) ! diffuse solar fluxes caused by BPLUS and BMINUS;
! appear as sources in diffuse calculation
REAL(r64) :: DPLUS(0:NL),DMINUS(0:NL) ! diffuse solar fluxes flowing in outward and inward
! directions (W/m2)
REAL(r64) :: AP(2*NL)
REAL(r64) :: AE(2*NL)
REAL(r64) :: AW(2*NL)
REAL(r64) :: BP(2*NL)
REAL(r64) :: X(2*NL)
REAL(r64) :: CHKSUM
REAL(r64) :: BeamDiffuseAbs(NL+1) ! beam-diffuse absorbed fraction of beam radiation (W/m2)
INTEGER :: N_TDMA
INTEGER :: I
INTEGER :: LINE
! Flow
IF (NL < 1) RETURN
! STEP ONE: THE BEAM-BEAM ANALYSIS TO FIND BPLUS AND BMINUS
CALL NETRAD( NL, LSWP_ON%RHOSFBB,LSWP_ON%RHOSBBB, &
LSWP_ON%TAUSFBB, LSWP_ON%TAUSBBB, &
SWP_ROOM%RHOSFBB, IBEAM, BPLUS, BMINUS)
! STEP TWO: CALCULATE THE DIFFUSE-CAUSED-BY-BEAM SOURCES CPLUS AND CMINUS
CPLUS( NL) = SWP_ROOM%RHOSFBD * BMINUS( NL)
DO I=NL,1,-1 ! March through layers, indoor to outdoor
CPLUS(I-1) = LSWP_ON(I)%RHOSFBD*BMINUS(I-1) &
+ LSWP_ON(I)%TAUSBBD*BPLUS(I)
CMINUS(I) = LSWP_ON(I)%RHOSBBD*BPLUS(I) &
+ LSWP_ON(I)%TAUSFBD*BMINUS(I-1)
END DO
CMINUS(0) = 0.0d0
! STEP THREE: DIFFUSE FLUXES, DPLUS AND DMINUS,
! CAUSED BY DIFFUSE INCIDENT, IDIFF ON THE OUTDOOR SIDE
! AND BY ILIGHTS ON THE INDOOR SIDE, AND BY
! DIFFUSE SOURCE (FROM BEAM) FLUXES, CPLUS AND CMINUS
N_TDMA = 2*NL
DO I=1,NL
LINE = (2*I)-1
AP(LINE) = LSWP_ON(I)%RHOSBDD
AE(LINE) = 1.0d0
IF(LINE .NE. 1) THEN ! default
AW(LINE) = -1.0d0 * LSWP_ON(I)%TAUS_DD
BP(LINE) = -1.0d0 * CMINUS(I)
ELSE ! special case at west-most node
AW(1) = 0.0d0
BP(1) = -1.0d0*LSWP_ON(1)%TAUS_DD*IDIFF - CMINUS(1)
ENDIF
LINE = (2*I)
AW(LINE) = 1.0d0
IF(LINE.NE.N_TDMA) THEN ! default
AP(LINE) = LSWP_ON(I+1)%RHOSFDD
AE(LINE) = -1.0d0 * LSWP_ON(I+1)%TAUS_DD
BP(LINE) = -1.0d0 * CPLUS(I)
ELSE ! special case at east-most node
AP(LINE) = SWP_ROOM%RHOSFDD
BP( N_TDMA) = -1.0d0 * (CPLUS(NL)+ILIGHTS)
AE( N_TDMA) = 0.0d0
ENDIF
END DO
CALL AUTOTDMA( X, AP, AE, AW, BP , N_TDMA)
! UNPACK TDMA SOLUTION VECTOR
DO I=1,NL
LINE = (2*I)-1
DPLUS(I) = X(LINE)
LINE = (2*I)
DMINUS(I) = X(LINE)
END DO
! Finish up diffuse calculations
DMINUS(0) = IDIFF
DPLUS(0) = LSWP_ON(1)%RHOSFDD*DMINUS(0) &
+ LSWP_ON(1)%TAUS_DD*DPLUS(1) &
+ CPLUS(0)
! STEP FOUR: ABSORBED SOLAR RADIATION AT EACH LAYER/NODE
SOURCE = 0.0d0
SOURCE(NL+1) = BMINUS(NL)-BPLUS(NL)+ & ! SOLAR FLUX
DMINUS(NL)-DPLUS(NL)+ & ! TRANSMITTED TO
ILIGHTS ! ROOM
! NOTE: In calculating SOURCE(room) there is a trick included in the
! previous line: ILIGHTS is added because it is included
! in DPLUS(NL) but ILIGHTS should not be included in this
! type of calculation of SOURCE(i). No similar adjustment
! is needed for any of the other values of SOURCE(i)
! As an alternative get the same result using:
! SOURCE(NL+1) = BMINUS(NL)*(1.0 - SWP_ROOM%RHOSFBB - SWP_ROOM%RHOSFBD) +
! & DMINUS(NL)*(1.0 - SWP_ROOM%RHOSFDD)
! Take your pick
! Added by BAN, June 7, 2013 to extract the beam-diffuse component for use
! in the EnergyPLus heat balance. EnergyPlus requires the beam-beam and
! Beam-diffuse components separately.
BeamDiffuseAbs = 0.0d0
BeamDiffuseAbs(NL+1) = DMINUS(NL)- DPLUS(NL) ! beam-diffuse transmitted to the room
DO I=1,NL
SOURCE(I) = BPLUS(I) - BMINUS(I) - BPLUS(I-1) + BMINUS(I-1) + &
DPLUS(I) - DMINUS(I) - DPLUS(I-1) + DMINUS(I-1)
! Added by BAN June 7, 2013
BeamDiffuseAbs(I) = 0.0d0
END DO
IF ( PRESENT(SourceBD) )THEN
SourceBD = BeamDiffuseAbs
ENDIF
! CHECKSUM - ALL INCOMING SOLAR FLUX MUST GO SOMEWHERE, SHOULD EQUAL ZERO
CHKSUM=IBEAM+IDIFF+ILIGHTS-BPLUS(0)-DPLUS(0)
DO I=1,NL+1
CHKSUM=CHKSUM-SOURCE(I)
END DO
RETURN
END SUBROUTINE ASHWAT_Solar