PD_BEAM_CASE_III Subroutine

private subroutine PD_BEAM_CASE_III(S, W, OMEGA_H, DE, RHOFF_BT_PARL, TAUFF_BB_PARL, TAUFF_BD_PARL, RHOBF_BT_PARL, TAUBF_BB_PARL, TAUBF_BD_PARL, RHOFF_BT_PERP, TAUFF_BB_PERP, TAUFF_BD_PERP, RHOBF_BT_PERP, TAUBF_BB_PERP, TAUBF_BD_PERP, RHOBF_DD, RHOFF_DD, TAUFF_DD, TAUBF_DD, RHO_BD, TAU_BD, TAU_BB)

Arguments

Type	Intent		Name
real(kind=r64),	intent(in)	::	S
real(kind=r64),	intent(in)	::	W
real(kind=r64),	intent(in)	::	OMEGA_H
real(kind=r64),	intent(in)	::	DE
real(kind=r64),	intent(in)	::	RHOFF_BT_PARL
real(kind=r64),	intent(in)	::	TAUFF_BB_PARL
real(kind=r64),	intent(in)	::	TAUFF_BD_PARL
real(kind=r64),	intent(in)	::	RHOBF_BT_PARL
real(kind=r64),	intent(in)	::	TAUBF_BB_PARL
real(kind=r64),	intent(in)	::	TAUBF_BD_PARL
real(kind=r64),	intent(in)	::	RHOFF_BT_PERP
real(kind=r64),	intent(in)	::	TAUFF_BB_PERP
real(kind=r64),	intent(in)	::	TAUFF_BD_PERP
real(kind=r64),	intent(in)	::	RHOBF_BT_PERP
real(kind=r64),	intent(in)	::	TAUBF_BB_PERP
real(kind=r64),	intent(in)	::	TAUBF_BD_PERP
real(kind=r64),	intent(in)	::	RHOBF_DD
real(kind=r64),	intent(in)	::	RHOFF_DD
real(kind=r64),	intent(in)	::	TAUFF_DD
real(kind=r64),	intent(in)	::	TAUBF_DD
real(kind=r64),	intent(out)	::	RHO_BD
real(kind=r64),	intent(out)	::	TAU_BD
real(kind=r64),	intent(out)	::	TAU_BB

Source Code

SUBROUTINE PD_BEAM_CASE_III(S, W, OMEGA_H, DE, &
                            RHOFF_BT_PARL, TAUFF_BB_PARL, TAUFF_BD_PARL, &
                            RHOBF_BT_PARL, TAUBF_BB_PARL, TAUBF_BD_PARL, &
                            RHOFF_BT_PERP, TAUFF_BB_PERP, TAUFF_BD_PERP, &
                            RHOBF_BT_PERP, TAUBF_BB_PERP, TAUBF_BD_PERP, &
                            RHOBF_DD, RHOFF_DD, TAUFF_DD, TAUBF_DD, &
                            RHO_BD, TAU_BD, TAU_BB)

          ! SUBROUTINE 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 SUBROUTINE:
          !  calculates the effective front-side solar optical properties of a drapery layer.
          !
          ! METHODOLOGY EMPLOYED:
          ! TWELVE SURFACE FLAT-FABRIC MODEL WITH RECTANGULAR ENCLOSURE
          !
          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
          ! na
          !
    IMPLICIT NONE   ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
    REAL(r64), INTENT( IN) :: S              ! pleat spacing (> 0)
    REAL(r64), INTENT( IN) :: W              ! pleat depth (>=0, same units as S)
    REAL(r64), INTENT (IN) :: OMEGA_H        ! horizontal profile angle, radians
    REAL(r64), INTENT (IN) :: DE             ! width of illumination on pleat bottom (same units as S)

    ! fabric properties at current (off-normal) incidence
    !   _PARL = surface parallel to window (pleat top/bot)
    !   _PERP = surface perpendicular to window (pleat side)
    REAL(r64), INTENT (IN) :: RHOFF_BT_PARL, TAUFF_BB_PARL, TAUFF_BD_PARL
    REAL(r64), INTENT (IN) :: RHOBF_BT_PARL, TAUBF_BB_PARL, TAUBF_BD_PARL
    REAL(r64), INTENT (IN) :: RHOFF_BT_PERP, TAUFF_BB_PERP, TAUFF_BD_PERP
    REAL(r64), INTENT (IN) :: RHOBF_BT_PERP, TAUBF_BB_PERP, TAUBF_BD_PERP

    REAL(r64), INTENT (IN) :: RHOFF_DD       ! fabric front diffuse-diffuse reflectance
    REAL(r64), INTENT (IN) :: RHOBF_DD       ! fabric back diffuse-diffuse reflectance
    REAL(r64), INTENT (IN) :: TAUFF_DD       ! fabric front diffuse-diffuse transmittance
    REAL(r64), INTENT (IN) :: TAUBF_DD       ! fabric back diffuse-diffuse transmittance
    REAL(r64), INTENT (OUT) :: RHO_BD        ! returned: drape front beam-diffuse reflectance
    REAL(r64), INTENT (OUT) :: TAU_BD        ! returned: drape front beam-diffuse transmittance
    REAL(r64), INTENT (OUT) :: TAU_BB        ! returned: drape front beam-beam transmittance
          !
          ! SUBROUTINE PARAMETER DEFINITIONS:
    INTEGER,      PARAMETER :: N = 10

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
    REAL(r64) :: TAUBF_BT_PERP
    REAL(r64) :: AB, GN, NK, BC, AN, AK, BG, CG, BK, CN      ! lengths for surfaces and diagonal strings
    REAL(r64) :: Z1_BB, Z6_BB                                ! beam source terms
    REAL(r64) :: Z1_BD, Z2_BD, Z6_BD, Z3_BD, Z8_BD, Z11_BD, Z12_BD    ! diffuse source terms
    ! shape factors
    REAL(r64) :: F12, F13, F15, F16, F21, F25, F26, F31, F35, F36, F41, F42, F43, F45, F46, F51, F52, F53, F54, F61, F62, F63
    REAL(r64) :: F78, F79, F710, F711, F712, F810, F811, F812, F910, F911, F912, F108, F109, F1011, F1012, F118, F119, F1110
    REAL(r64) :: F128, F129, F1210
    REAL(r64) :: J1, J2, J3, J5, J6, J8, J9, J10, J11, J12    ! radiosity, surface i
    REAL(r64) :: G1, G4, G7, G10                              ! irradiance, surface i

    REAL(r64) :: A( N, N+2)    ! coefficients of the radiosity equations matrix
    REAL(r64) :: XSOL( N)      ! solution vector (obtained after solving the radiosity equations matrix)
          ! Flow

    TAUBF_BT_PERP = TAUBF_BD_PERP + TAUBF_BB_PERP

    AB = DE
    GN = DE
    NK = W-DE
    BC = NK
    AN = SQRT(S*S+DE*DE)
    AK = SQRT(W*W+S*S)
    BG = AN
    CG = AK
    BK = SQRT(S*S+BC*BC)
    CN = SQRT(S*S+NK*NK)

    Z1_BB = TAUFF_BB_PARL
    Z1_BD = TAUFF_BD_PARL
    Z2_BD = Z1_BB*RHOBF_BT_PERP*S/GN
    Z6_BB = TAUFF_BB_PERP*S/DE
    Z6_BD = TAUFF_BD_PERP*S/DE
    Z3_BD = Z6_BB*RHOBF_BT_PERP
    Z8_BD = RHOFF_BT_PERP*S/DE
    Z11_BD = Z6_BB*TAUBF_BT_PERP
    Z12_BD = Z1_BB*TAUBF_BT_PERP*S/GN

    F12 = (S+GN-AN)/(2.d0*S)
    F13 = (W+AN-(GN+AK))/(2.d0*S)
    F15 = (W+BG-(AB+CG))/(2.d0*S)
    F16 = (S+AB-BG)/(2.d0*S)
    F21 = (S+GN-AN)/(2.d0*GN)
    F25 = (S+CG-(BG+CN))/(2.d0*GN)
    F26 = (AN+BG-2.d0*S)/(2.d0*GN)
    F31 = (W+AN-(GN+AK))/(2.d0*NK)
    F35 = (BK+CN-2.d0*S)/(2.d0*NK)
    F36 = (S+AK-(AN+BK))/(2.d0*NK)
    F41 = (AK+CG-2.d0*W)/(2.d0*S)
    F42 = (W+CN-(CG+NK))/(2.d0*S)
    F43 = (S+NK-CN)/(2.d0*S)
    F45 = (S+BC-BK)/(2.d0*S)
    F46 = (W+BK-(AK+BC))/(2.d0*S)
    F51 = (W+BG-(AB+CG))/(2.d0*BC)
    F52 = (S+CG-(BG+CN))/(2.d0*BC)
    F53 = (BK+CN-2.d0*S)/(2.d0*BC)
    F54 = (S+BC-BK)/(2.d0*BC)
    F61 = (S+AB-BG)/(2.d0*AB)
    F62 = (AN+BG-2.d0*S)/(2.d0*AB)
    F63 = (S+AK-(AN+BK))/(2.d0*AB)
    F78 = F12
    F79 = F13
    F710 = (AK+CG-2.d0*W)/(2.d0*S)
    F711 = F15
    F712 = F16
    F810 = (W+CN-(CG+NK))/(2.d0*S)
    F811 = F25
    F812 = F26
    F910 = (S+NK-CN)/(2.d0*NK)
    F911 = F35
    F912 = F36
    F108 = F42
    F109 = F43
    F1011 = F45
    F1012 = F46
    F118 = F52
    F119 = F53
    F1110 = (S+BC-BK)/(2.d0*NK)
    F128 = F62
    F129 = F63
    F1210 = (W+BK-(AK+BC))/(2.d0*GN)

    A = 0.0d0            ! INITIALIZE RADIOSITY MATRIX COEFFICIENTS
    XSOL = 0.0d0         ! INITIALIZE SOLUTION VECTOR COEFFICIENTS

    ! POPULATE THE COEFFICIENTS OF THE RADIOSITY MATRIX

    A(1,1)    = 1.0d0
    A(1,2)    = -RHOBF_DD*F12
    A(1,3)    = -RHOBF_DD*F13
    A(1,4)    = -RHOBF_DD*F15
    A(1,5)    = -RHOBF_DD*F16
    A(1,6)    = 0.0d0
    A(1,7)    = 0.0d0
    A(1,8)    = 0.0d0
    A(1,9)    = 0.0d0
    A(1,10)   = 0.0d0
    A(1,11)   = Z1_BD
    A(2,1)    = -RHOBF_DD*F21
    A(2,2)    = 1.0d0
    A(2,3)    = 0.0d0
    A(2,4)    = -RHOBF_DD*F25
    A(2,5)    = -RHOBF_DD*F26
    A(2,6)    = -TAUFF_DD*F128
    A(2,7)    = -TAUFF_DD*F129
    A(2,8)    = -TAUFF_DD*F1210
    A(2,9)    = 0.0d0
    A(2,10)   = 0.0d0
    A(2,11)   = Z2_BD
    A(3,1)    = -RHOBF_DD*F31
    A(3,2)    = 0.0d0
    A(3,3)    = 1.0d0
    A(3,4)    = -RHOBF_DD*F35
    A(3,5)    = -RHOBF_DD*F36
    A(3,6)    = -TAUFF_DD*F118
    A(3,7)    = -TAUFF_DD*F119
    A(3,8)    = -TAUFF_DD*F1110
    A(3,9)    = 0.0d0
    A(3,10)   = 0.0d0
    A(3,11)   = Z3_BD
    A(4,1)    = -RHOBF_DD*F51
    A(4,2)    = -RHOBF_DD*F52
    A(4,3)    = -RHOBF_DD*F53
    A(4,4)    = 1.0d0
    A(4,5)    = 0.0d0
    A(4,6)    = 0.0d0
    A(4,7)    = 0.0d0
    A(4,8)    = -TAUFF_DD*F910
    A(4,9)    = -TAUFF_DD*F911
    A(4,10)   = -TAUFF_DD*F912
    A(4,11)   = 0.0d0
    A(5,1)    = -RHOBF_DD*F61
    A(5,2)    = -RHOBF_DD*F62
    A(5,3)    = -RHOBF_DD*F63
    A(5,4)    = 0.0d0
    A(5,5)    = 1.0d0
    A(5,6)    = 0.0d0
    A(5,7)    = 0.0d0
    A(5,8)    = -TAUFF_DD*F810
    A(5,9)    = -TAUFF_DD*F811
    A(5,10)   = -TAUFF_DD*F812
    A(5,11)   = Z6_BD
    A(6,1)    = -TAUBF_DD*F61
    A(6,2)    = -TAUBF_DD*F62
    A(6,3)    = -TAUBF_DD*F63
    A(6,4)    = 0.0d0
    A(6,5)    = 0.0d0
    A(6,6)    = 1.0d0
    A(6,7)    = 0.0d0
    A(6,8)    = -RHOFF_DD*F810
    A(6,9)    = -RHOFF_DD*F811
    A(6,10)   = -RHOFF_DD*F812
    A(6,11)   = Z8_BD
    A(7,1)    = -TAUBF_DD*F51
    A(7,2)    = -TAUBF_DD*F52
    A(7,3)    = -TAUBF_DD*F53
    A(7,4)    = 0.0d0
    A(7,5)    = 0.0d0
    A(7,6)    = 0.0d0
    A(7,7)    = 1.0d0
    A(7,8)    = -RHOFF_DD*F910
    A(7,9)    = -RHOFF_DD*F911
    A(7,10)   = -RHOFF_DD*F912
    A(7,11)   = 0.0d0
    A(8,1)    = 0.0d0
    A(8,2)    = 0.0d0
    A(8,3)    = 0.0d0
    A(8,4)    = 0.0d0
    A(8,5)    = 0.0d0
    A(8,6)    = -RHOFF_DD*F108
    A(8,7)    = -RHOFF_DD*F109
    A(8,8)    = 1.0d0
    A(8,9)    = -RHOFF_DD*F1011
    A(8,10)   = -RHOFF_DD*F1012
    A(8,11)   = 0.0d0
    A(9,1)    = -TAUBF_DD*F31
    A(9,2)    = 0.0d0
    A(9,3)    = 0.0d0
    A(9,4)    = -TAUBF_DD*F35
    A(9,5)    = -TAUBF_DD*F36
    A(9,6)    = -RHOFF_DD*F118
    A(9,7)    = -RHOFF_DD*F119
    A(9,8)    = -RHOFF_DD*F1110
    A(9,9)    = 1.0d0
    A(9,10)   = 0.0d0
    A(9,11)   = Z11_BD
    A(10,1)   = -TAUBF_DD*F21
    A(10,2)   = 0.0d0
    A(10,3)   = 0.0d0
    A(10,4)   = -TAUBF_DD*F25
    A(10,5)   = -TAUBF_DD*F26
    A(10,6)   = -RHOFF_DD*F128
    A(10,7)   = -RHOFF_DD*F129
    A(10,8)   = -RHOFF_DD*F1210
    A(10,9)   = 0.0d0
    A(10,10)  = 1.0d0
    A(10,11)  = Z12_BD

    CALL SOLMATS(N,A,XSOL)

    J1 = XSOL(1)
    J2 = XSOL(2)
    J3 = XSOL(3)
    J5 = XSOL(4)
    J6 = XSOL(5)
    J8 = XSOL(6)
    J9 = XSOL(7)
    J10 = XSOL(8)
    J11 = XSOL(9)
    J12 = XSOL(10)

    G1 = F12*J2+F13*J3+F15*J5+F16*J6
    G4 = F41*J1+F42*J2+F43*J3+F45*J5+F46*J6
    G7 = F78*J8+F79*J9+F710*J10+F711*J11+F712*J12
    G10 = F108*J8+F109*J9+F1011*J11+F1012*J12

    TAU_BB = (TAUFF_BB_PERP*(AB-NK)*ABS(SIN(OMEGA_H)))/(2.d0*S*ABS(COS(OMEGA_H)))
    TAU_BD = (G4+TAUFF_DD*G10)/2.d0
    RHO_BD = (RHOFF_BT_PARL+TAUBF_DD*G1+G7)/2.d0
    RETURN
END SUBROUTINE PD_BEAM_CASE_III

All Procedures

PD_BEAM_CASE_III Subroutine

Source Code

All Procedures

private subroutine PD_BEAM_CASE_III(S, W, OMEGA_H, DE, RHOFF_BT_PARL, TAUFF_BB_PARL, TAUFF_BD_PARL, RHOBF_BT_PARL, TAUBF_BB_PARL, TAUBF_BD_PARL, RHOFF_BT_PERP, TAUFF_BB_PERP, TAUFF_BD_PERP, RHOBF_BT_PERP, TAUBF_BB_PERP, TAUBF_BD_PERP, RHOBF_DD, RHOFF_DD, TAUFF_DD, TAUBF_DD, RHO_BD, TAU_BD, TAU_BB)

Arguments

Calls

Called By

Source Code

Source Code

All Procedures