Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | ProfAng | |||
real(kind=r64), | intent(in) | :: | SlatAng | |||
logical, | intent(in) | :: | VarSlats | |||
real(kind=r64), | intent(in) | :: | PropArray(37,MaxSlatAngs) |
REAL(r64) FUNCTION InterpProfSlatAng(ProfAng,SlatAng,VarSlats,PropArray)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Dec 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Does simultaneous profile-angle and slat-angle interpolation of window
! blind solar-thermal properties that depend on profile angle and slat angle
! METHODOLOGY EMPLOYED:
! Linear interpolation.
! REFERENCES:na
! USE STATEMENTS:
USE DataGlobals, ONLY: Pi,PiOvr2
USE DataSurfaces, ONLY : MaxSlatAngs
IMPLICIT NONE
! FUNCTION ARGUMENT DEFINITIONS:
REAL(r64),INTENT(IN ) :: ProfAng ! Profile angle (rad)
REAL(r64),INTENT(IN) :: SlatAng ! Slat angle (rad)
LOGICAL,INTENT(IN) :: VarSlats ! True if variable-angle slats
REAL(r64),INTENT(IN) :: PropArray(37,MaxSlatAngs) ! Array of blind properties
! FUNCTION PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: DeltaProfAng = Pi/36.d0
REAL(r64), PARAMETER :: DeltaSlatAng = Pi/(REAL(MaxSlatAngs,r64)-1.d0)
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) ProfAngRatio ! Profile angle interpolation factor
REAL(r64) SlatAngRatio ! Slat angle interpolation factor
INTEGER IAlpha ! Profile angle index
INTEGER IBeta ! Slat angle index
REAL(r64) Val1,Val2,Val3,Val4 ! Property values at points enclosing the given ProfAngle and SlatAngle
REAL(r64) ValA,ValB ! Property values at given SlatAngle to be interpolated in profile angle
REAL(r64) SlatAng1
REAL(r64) ProfAng1
IF(SlatAng > Pi .OR. SlatAng < 0.0d0 .OR. ProfAng > PiOvr2 .OR. ProfAng < -PiOvr2) THEN
! InterpProfSlatAng = 0.0
! RETURN
SlatAng1 = MIN(MAX(SlatAng,0.0d0),PI)
! This is not correct, fixed 2/17/2010
!ProfAng1 = MIN(MAX(SlatAng,-PiOvr2),PiOvr2)
ProfAng1 = MIN(MAX(ProfAng,-PiOvr2),PiOvr2)
ELSE
SlatAng1 = SlatAng
ProfAng1 = ProfAng
END IF
IAlpha = INT((ProfAng1+PiOvr2)/DeltaProfAng) + 1
ProfAngRatio = (ProfAng1 + PiOvr2 - (IAlpha-1)*DeltaProfAng)/DeltaProfAng
IF(VarSlats) THEN ! Variable-angle slats: interpolate in profile angle and slat angle
IBeta = INT(SlatAng1/DeltaSlatAng) + 1
SlatAngRatio = (SlatAng1 - (IBeta-1)*DeltaSlatAng)/DeltaSlatAng
Val1 = PropArray(IAlpha,IBeta)
Val2 = PropArray(IAlpha,MIN(MaxSlatAngs,IBeta+1))
Val3 = PropArray(MIN(37,IAlpha+1),IBeta)
Val4 = PropArray(MIN(37,IAlpha+1),MIN(MaxSlatAngs,IBeta+1))
ValA = Val1 + SlatAngRatio*(Val2-Val1)
ValB = Val3 + SlatAngRatio*(Val4-Val3)
InterpProfSlatAng = ValA + ProfAngRatio*(ValB-ValA)
ELSE ! Fixed-angle slats: interpolate only in profile angle
Val1 = PropArray(IAlpha,1)
Val2 = PropArray(MIN(37,IAlpha+1),1)
InterpProfSlatAng = Val1 + ProfAngRatio*(Val2-Val1)
END IF
RETURN
END FUNCTION InterpProfSlatAng