re-initialize iteration parameters: Vectors:
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | nlayer | |||
real(kind=r64), | intent(in) | :: | tout | |||
real(kind=r64), | intent(in) | :: | tind | |||
real(kind=r64), | intent(inout) | :: | trmin | |||
integer, | intent(in) | :: | isky | |||
real(kind=r64), | intent(in) | :: | outir | ! Layers: |
||
real(kind=r64), | intent(in) | :: | tsky | |||
real(kind=r64), | intent(inout) | :: | esky | |||
real(kind=r64), | intent(in) | :: | fclr | |||
real(kind=r64), | intent(inout), | dimension(MaxGap) | :: | gap | ||
real(kind=r64), | intent(inout), | dimension(maxlay) | :: | thick | ||
real(kind=r64), | intent(inout), | dimension(maxlay) | :: | scon | ||
real(kind=r64), | intent(in), | dimension(maxlay2) | :: | tir | ! Venetians: |
|
real(kind=r64), | intent(in), | dimension(maxlay2) | :: | emis | ! Venetians: |
|
real(kind=r64), | intent(in) | :: | tilt | |||
real(kind=r64), | intent(inout) | :: | hin | ! OUTPUTS: |
||
real(kind=r64), | intent(inout) | :: | hout | ! OUTPUTS: |
||
integer, | intent(in), | dimension(2) | :: | ibc | ||
real(kind=r64), | intent(in), | dimension(maxlay) | :: | SlatThick | ||
real(kind=r64), | intent(in), | dimension(maxlay) | :: | SlatWidth | ||
real(kind=r64), | intent(in), | dimension(maxlay) | :: | SlatAngle | ||
real(kind=r64), | intent(in), | dimension(maxlay) | :: | SlatCond | ||
integer, | intent(in), | dimension(maxlay) | :: | LayerType | ||
integer, | intent(in) | :: | ThermalMod | ! Environment related: |
||
real(kind=r64), | intent(in) | :: | SDScalar | !! INPUTS/OUTPUTS: |
||
real(kind=r64), | intent(out) | :: | ShadeEmisRatioOut | |||
real(kind=r64), | intent(out) | :: | ShadeEmisRatioIn | |||
real(kind=r64), | intent(out) | :: | ShadeHcRatioOut | |||
real(kind=r64), | intent(out) | :: | ShadeHcRatioIn | |||
real(kind=r64), | intent(out), | dimension(maxlay) | :: | Keff | ||
real(kind=r64), | intent(out), | dimension(MaxGap) | :: | ShadeGapKeffConv | ||
real(kind=r64), | intent(out) | :: | sc | |||
real(kind=r64), | intent(out) | :: | shgc | |||
real(kind=r64), | intent(out) | :: | ufactor | |||
real(kind=r64), | intent(out) | :: | flux | |||
real(kind=r64), | intent(out), | dimension(maxlay) | :: | LaminateAU | ||
real(kind=r64), | intent(out), | dimension(maxlay) | :: | sumsolU | ||
real(kind=r64), | intent(out), | dimension(maxlay) | :: | sol0 | ||
real(kind=r64), | intent(out) | :: | hint | |||
real(kind=r64), | intent(out) | :: | houtt | |||
real(kind=r64), | intent(out) | :: | trmout | |||
real(kind=r64), | intent(out) | :: | ebsky | |||
real(kind=r64), | intent(out) | :: | ebroom | |||
real(kind=r64), | intent(out) | :: | Gout | |||
real(kind=r64), | intent(out) | :: | Gin | |||
real(kind=r64), | intent(out), | dimension(maxlay2) | :: | rir | ||
real(kind=r64), | intent(out), | dimension(maxlay1) | :: | vfreevent | ||
integer, | intent(out) | :: | nperr | |||
character(len=*), | intent(inout) | :: | ErrorMessage |
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 PrepVariablesISO15099(nlayer, tout, tind, trmin, isky, outir, tsky, esky, fclr, gap, thick, scon, tir, emis, &
& tilt, hin, hout, ibc, SlatThick, SlatWidth, SlatAngle, SlatCond, LayerType, &
& ThermalMod, SDScalar, ShadeEmisRatioOut, ShadeEmisRatioIn, ShadeHcRatioOut, ShadeHcRatioIn, &
& Keff, ShadeGapKeffConv, sc, shgc, ufactor, flux, LaminateAU, sumsolU, sol0, &
& hint, houtt, trmout, ebsky, ebroom, Gout, Gin, rir, vfreevent, nperr, ErrorMessage)
integer, intent(in) :: nlayer
integer, intent(in) :: ThermalMod
!!! Environment related:
real(r64), intent(in) :: tout,tind, tsky, fclr, tilt
integer, intent(in) :: isky
integer, dimension(2), intent(in) :: ibc
real(r64), intent(in) :: outir !IR radiance of window's exterior/interior surround (W/m2)
!!! Layers:
integer, dimension(maxlay), intent(in) :: LayerType
real(r64), dimension(maxlay2), intent(in) :: tir, emis
!!! Venetians:
real(r64), dimension(maxlay), intent(in) :: SlatThick, SlatWidth, SlatAngle, SlatCond
real(r64), intent(in) :: SDScalar
!!!! INPUTS/OUTPUTS:
real(r64), intent(inout) :: trmin, esky
real(r64), dimension(maxlay), intent(inout) :: scon, thick
real(r64), dimension(MaxGap), intent(inout) :: gap
real(r64), intent(inout) :: hin, hout
!!! OUTPUTS:
integer, intent(out) :: nperr
character (len=*), intent(inout) :: ErrorMessage
real(r64), dimension(maxlay2), intent(out) :: rir
real(r64), intent(out) :: ShadeEmisRatioOut, ShadeEmisRatioIn, ShadeHcRatioOut, ShadeHcRatioIn
real(r64), intent(out) :: Gout, Gin, sc, shgc, ufactor, flux
real(r64), dimension(maxlay1), intent(out) :: vfreevent
real(r64), dimension(maxlay), intent(out) :: LaminateAU, sumsolU, sol0
real(r64), intent(out) :: hint, houtt, trmout, ebsky, ebroom
real(r64), dimension(maxlay), intent(out) :: Keff
real(r64), dimension(MaxGap), intent(out) :: ShadeGapKeffConv
integer :: i, k, k1
real(r64) :: tiltr, Rsky, Fsky, Fground, e0
character(len=3) :: a
!! Initialize variables:
!! Scalars:
ShadeEmisRatioOut = 1.0d0
ShadeEmisRatioIn = 1.0d0
ShadeHcRatioOut = 1.0d0
ShadeHcRatioIn = 1.0d0
!! re-initialize iteration parameters:
sc = 0.0d0
shgc = 0.0d0
ufactor = 0.0d0
flux = 0.0d0
!! Vectors:
LaminateAU = 0.0d0
sumsolU = 0.0d0
vfreevent = 0.0d0
sol0 = 0.0d0
!bi... Clear keff, keffc elements:
Keff = 0.0d0
ShadeGapKeffConv = 0.0d0
! Adjust shading layer properties
do i=1, nlayer
if (LayerType(i).eq.VENETBLIND) then
scon(i) = SlatCond(i)
if (ThermalMod.eq.THERM_MOD_SCW) then
!bi...the idea here is to have glass-to-glass width the same as before scaling
!bi...TODO: check for outdoor and indoor blinds! SCW model is only applicable to in-between SDs!!!
thick(i) = SlatWidth(i) * cos(SlatAngle(i) * Pi / 180.0d0)
if ( i > 1 ) gap(i-1)=gap(i-1) + (1.0d0-SDScalar)/2.0d0 * thick(i) !Objexx:BoundsViolation gap(i-1) @ i=1: Added if condition
!EPTeam - see above line gap(i-1)=gap(i-1) + (1.0d0-SDScalar)/2.0d0 * thick(i)
gap(i)=gap(i) + (1.0d0-SDScalar)/2.0d0 * thick(i)
thick(i) = SDScalar*thick(i)
if (thick(i).lt.SlatThick(i)) thick(i) = SlatThick(i)
else if ((ThermalMod.eq.THERM_MOD_ISO15099).or.(ThermalMod.eq.THERM_MOD_CSM)) then
thick(i) = SlatThick(i)
end if
end if ! Venetian
end do
hint = hin
houtt = hout
tiltr = tilt*2.0d0*pi/360.0d0 ! convert tilt in degrees to radians
! external radiation term
select case (isky)
case (3)
Gout = outir
Trmout = (Gout/StefanBoltzmann)**(0.25d0)
case (2) ! effective clear sky emittance from swinbank (SPC142/ISO15099 equations 131, 132, ...)
Rsky = 5.31d-13*Tout**6
esky = Rsky/(StefanBoltzmann*Tout**4) ! check esky const, also check what esky to use when tsky input...
case (1)
esky = tsky**4/tout**4
case (0) ! for isky=0 it is assumed that actual values for esky and Tsky are specified
esky = esky*tsky**4/tout**4
case DEFAULT
nperr = 1 ! error 2010: isky can be: 0(esky,Tsky input), 1(Tsky input), or 2(Swinbank model)
return
end select
!Simon: In this case we do not need to recalculate Gout and Trmout again
if (isky.ne.3) then
Fsky = (1.0d0+cos(tiltr))/2.0d0
Fground = 1.0d0 - Fsky
e0 = Fground + (1.0d0-fclr)*Fsky + Fsky*fclr*esky
! Trmout = Tout * e0**0.25
!bi Set mean radiant temps for fixed combined film coef. case:
if (ibc(1).eq.1) then ! outside BC - fixed combined film coef.
Trmout = Tout
else
Trmout = Tout * e0**0.25d0
end if
Gout = StefanBoltzmann * Trmout**4
end if !if (isky.ne.3) then
Ebsky = Gout
! Ebsky=sigma*Tout**4.
!
! As of 6/1/01 The expression for Ebsky is different in the current ISO 15099
! (Ebsky=sigma*Tout**4) because equations 32 and 33 specify Tout and Tind as reference
! outdoor and indoor temperatures, but I think that they should be Tne and Tni
! (environmental temps). Therefore, Ebsky becomes the same as Gout.
!
! Inside (room) radiation
! Ebroom = sigma*tind**4.
! See comment above about Ebsky
if (ibc(2).eq.1) then ! inside BC - fixed combined film coef.
Trmin = Tind
end if
Gin = StefanBoltzmann * trmin**4.0d0
Ebroom = Gin
! calculate ir reflectance:
do k = 1, nlayer
k1 = 2*k - 1
rir(k1) = 1 - tir(k1) - emis(k1)
rir(k1+1) = 1 - tir(k1) - emis(k1+1)
if ((tir(k1).lt.0.0d0).or.(tir(k1).gt.1.0d0).or.(tir(k1+1).lt.0.0d0).or.(tir(k1+1).gt.1.0d0)) then
nperr = 4
write(a, '(i3)') k
ErrorMessage = 'Layer transmissivity is our of range (<0 or >1). Layer #'//trim(a)
return
end if
if ((emis(k1).lt.0.0d0).or.(emis(k1).gt.1.0d0).or.(emis(k1+1).lt.0.0d0).or.(emis(k1+1).gt.1.0d0)) then
nperr = 14
write(a, '(i3)') k
ErrorMessage = 'Layer emissivity is our of range (<0 or >1). Layer #'//trim(a)
return
end if
if ((rir(k1).lt.0.0d0).or.(rir(k1).gt.1.0d0).or.(rir(k1+1).lt.0.0d0).or.(rir(k1+1).gt.1.0d0)) then
nperr = 3
write(a, '(i3)') k
ErrorMessage = 'Layer reflectivity is our of range (<0 or >1). Layer #'//trim(a)
return
end if
end do
end subroutine PrepVariablesISO15099