SystemPropertiesAtLambdaAndPhi Subroutine

private subroutine SystemPropertiesAtLambdaAndPhi(n, tt, rft, rbt, aft)

Arguments

Type	Intent		Name
integer,	intent(in)	::	n
real(kind=r64),	intent(out)	::	tt
real(kind=r64),	intent(out)	::	rft
real(kind=r64),	intent(out)	::	rbt
real(kind=r64),	intent(out)	::	aft(5)

Called By

Help

Source Code

SystemPropertiesAtLambdaAndPhi

Source Code

SUBROUTINE SystemPropertiesAtLambdaAndPhi (n, tt, rft, rbt, aft)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Adapted by F. Winkelmann from WINDOW 5
          !                      subroutine op
          !       DATE WRITTEN   August 1999
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! For a given angle of incidence, finds the overall properties of
          ! of a series of layers at a particular wavelength

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:

INTEGER, INTENT(IN) :: n                       ! Number of glass layers
INTEGER             :: i,j                     ! Glass layer counters
REAL(r64)           :: denom,denom1,denom2     ! Intermediate variables
REAL(r64), INTENT(OUT)   :: tt                      ! System transmittance
REAL(r64), INTENT(OUT)   :: rft,rbt                 ! System front and back reflectance
REAL(r64)           :: t0,rb0,rf0              ! Transmittance, back reflectance and front
                                               !   reflectance variables
REAL(r64)           :: af,ab                   ! Front and back absorptance variables
REAL(r64), INTENT(OUT)   :: aft(5)                  ! System absorptance of each glass layer

          ! FLOW

  ! Calculate perimeter elements of rt matrix
  do i=1,n-1
    do J=i+1,n
      denom = 1.0d0 - rfop(j,j) * rbop(j-1,i)
      if (denom .EQ. 0.0) then
        top(i,j) = 0.0d0
        rfop(i,j) = 1.0d0
        rbop(j,i) = 1.0d0
      else
        top(i,j) = top(i,j-1) * top(j,j) / denom
        rfop(i,j) = rfop(i,j-1) + top(i,j-1)**2 * rfop(j,j) / denom
        rbop(j,i) = rbop(j,j) + top(j,j)**2 * rbop(j-1,i) / denom
      endif
    END DO
  END DO
    ! System properties: transmittance, front and back reflectance
    tt = top(1,n)
    rft = rfop(1,n)
    rbt = rbop(n,1)

    ! Absorptance in each layer
    do j=1,n
      if (j.eq.1) then
        t0 = 1.0d0
        rb0 = 0.0d0
      else
        t0 = top(1,j-1)
        rb0 = rbop(j-1,1)
      endif

      if (j.eq.n) then
        rf0 = 0.0d0
      else
        rf0 = rfop(j+1,n)
      endif

      af = 1.0d0 - top(j,j) - rfop(j,j)
      ab = 1.0d0 - top(j,j) - rbop(j,j)
      denom1 = 1.0d0 - rfop(j,n)*rb0
      denom2 = 1.0d0 - rbop(j,1)*rf0

      if (denom1 .EQ. 0.0 .OR. denom2 .EQ. 0.0) then
        aft(j) = 0.0d0
      else
        aft(j) = (t0 * af) / denom1 + (top(1,j) * rf0 * ab) / denom2
      endif
    END DO
    return
END SUBROUTINE SystemPropertiesAtLambdaAndPhi

All Procedures