Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | S | |||
real(kind=r64), | intent(in) | :: | W | |||
real(kind=r64), | intent(in) | :: | RHOFF_DD | |||
real(kind=r64), | intent(in) | :: | RHOBF_DD | |||
real(kind=r64), | intent(in) | :: | TAUF_DD | |||
real(kind=r64), | intent(out) | :: | RHOFDD | |||
real(kind=r64), | intent(out) | :: | TAUFDD |
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 PD_DIFF(S, W, RHOFF_DD, RHOBF_DD, TAUF_DD, RHOFDD, TAUFDD)
!
! 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 diffuse transmittance and reflectance of a drapery layer.
! Used for both LW and solar diffuse.
!
! METHODOLOGY EMPLOYED:
! Eight surface flat-fabric model with rectangular enclosure. If you want the back-side
! reflectance call this routine a second time with reversed front and back properties
!
! 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):: RHOFF_DD ! fabric front diffuse-diffuse reflectance
REAL(r64), INTENT(IN):: RHOBF_DD ! fabric back diffuse-diffuse reflectance
REAL(r64), INTENT(IN):: TAUF_DD ! fabric diffuse-diffuse transmittance
REAL(r64), INTENT(OUT):: RHOFDD ! returned: drape diffuse-diffuse reflectance
REAL(r64), INTENT(OUT):: TAUFDD ! returned: drape diffuse-diffuse transmittance
!
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: N = 6
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AK, CG ! length of diagonal strings of the rectangular enclosure
REAL(r64) :: F12, F14, F32, F21, F31, F34, F24, F41, F42 ! shape factors
REAL(r64) :: F57, F56, F58, F67, F65, F68, F75, F76, F78, F85, F87, F86
REAL(r64) :: J1, J2, J4, J7, J6, J8 ! radiosity, surface i
REAL(r64) :: G1, G3, G5, G7 ! irradiance, surface i
REAL(r64) :: A( N, N+2)
REAL(r64) :: XSOL( N)
! Flow
IF (W/S < SMALL_ERROR) THEN
! flat drape (no pleats)
RHOFDD = RHOFF_DD
TAUFDD = TAUF_DD
RETURN
END IF
! SOLVE FOR DIAGONAL STRINGS AND SHAPE FACTORS
AK = SQRT (S*S + W*W)
CG = AK
F12 = (S+W-AK)/(2.d0*S)
F14 = (S+W-CG)/(2.d0*S)
F32 = F14
F31 = (AK+CG-2.d0*W)/(2.d0*S)
F34 = F12
F21 = (S+W-AK)/(2.d0*W)
F24 = (AK+CG-2.d0*S)/(2.d0*W)
F41 = (S+W-CG)/(2.d0*W)
F42 = F24
F57 = F31
F56 = F12
F58 = F14
F75 = F31
F76 = F32
F78 = F34
F67 = F41
F65 = F21
F68 = F24
F85 = F41
F87 = F21
F86 = F42
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*F14
A(1,4) = 0.0d0
A(1,5) = 0.0d0
A(1,6) = 0.0d0
A(1,7) = TAUF_DD
A(2,1) = -RHOBF_DD*F21
A(2,2) = 1.0d0
A(2,3) = -RHOBF_DD*F24
A(2,4) = -TAUF_DD*F87
A(2,5) = -TAUF_DD*F86
A(2,6) = 0.0d0
A(2,7) = TAUF_DD*F85
A(3,1) = -RHOBF_DD*F41
A(3,2) = -RHOBF_DD*F42
A(3,3) = 1.0d0
A(3,4) = -TAUF_DD*F67
A(3,5) = 0.0d0
A(3,6) = -TAUF_DD*F68
A(3,7) = TAUF_DD*F65
A(4,1) = 0.0d0
A(4,2) = 0.0d0
A(4,3) = 0.0d0
A(4,4) = 1.0d0
A(4,5) = -RHOFF_DD*F76
A(4,6) = -RHOFF_DD*F78
A(4,7) = RHOFF_DD*F75
A(5,1) = -TAUF_DD*F41
A(5,2) = -TAUF_DD*F42
A(5,3) = 0.0d0
A(5,4) = -RHOFF_DD*F67
A(5,5) = 1.0d0
A(5,6) = -RHOFF_DD*F68
A(5,7) = RHOFF_DD*F65
A(6,1) = -TAUF_DD*F21
A(6,2) = 0.0d0
A(6,3) = -TAUF_DD*F24
A(6,4) = -RHOFF_DD*F87
A(6,5) = -RHOFF_DD*F86
A(6,6) = 1.0d0
A(6,7) = RHOFF_DD*F85
CALL SOLMATS( N, A, XSOL)
J1 = XSOL(1)
J2 = XSOL(2)
J4 = XSOL(3)
J7 = XSOL(4)
J6 = XSOL(5)
J8 = XSOL(6)
G1 = F12*J2+F14*J4
G3 = F32*J2+F31*J1+F34*J4
G5 = F57*J7+F56*J6+F58*J8
G7 = F75+F76*J6+F78*J8
TAUFDD = P01( (G3+TAUF_DD*G7)/2.0d0, "PD_DIFF TauDD")
RHOFDD = P01( (RHOFF_DD+TAUF_DD*G1+G5)/2.0d0, "PD_DIFF RhoDD")
RETURN
END SUBROUTINE PD_DIFF