| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(in) | :: | IConst | |||
| type(BasisStruct), | intent(out) | :: | Basis |
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 ConstructBasis (IConst, Basis)
! SUBROUTINE INFORMATION:
! AUTHOR Joe Klems
! DATE WRITTEN June 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Set up a basis from the matrix information pointed to in Construction by ICons
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: IConst !Index for accessing Construct array
TYPE (BasisStruct), INTENT(OUT) :: Basis
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: I =0 !general purpose index
INTEGER :: J =0 !general purpose index
INTEGER :: NThetas =0 !Current number of theta values
INTEGER :: NumElem =0 !Number of elements in current basis
INTEGER :: ElemNo =0 !Current basis element number
INTEGER :: MaxNPhis !Max no of NPhis for any theta
REAL(r64) :: Theta =0.0d0 !Current theta value
REAL(r64) :: Phi =0.0d0 !Current phi value
REAL(r64) :: DTheta =0.0d0 !Increment for theta value (Window6 type input)
REAL(r64) :: DPhi =0.0d0 !Increment for phi value (Window6 type input)
REAL(r64) :: HalfDTheta =0.0d0 !Half-width of all theta bins except first and last (W6 input)
REAL(r64) :: Lamda =0.0d0 !Current 'Lamda' value (element weight)
REAL(r64) :: SolAng =0.0d0 !Current element solid angle
REAL(r64) :: NextTheta =0.0d0 !Next theta in the W6 basis after current
REAL(r64) :: LastTheta =0.0d0 !Previous theta in the W6 basis before current
REAL(r64) :: LowerTheta =0.0d0 !Lower theta boundary of the element
REAL(r64) :: UpperTheta =0.0d0 !Upper theta boundary of the element
REAL(r64) :: Azimuth !Azimuth of window surface (radians)
REAL(r64) :: Tilt !Tilt of window surface (radians)
REAL(r64), DIMENSION(:), ALLOCATABLE :: Thetas !temp array holding theta values
INTEGER, DIMENSION(:), ALLOCATABLE :: NPhis !temp array holding number of phis for a given theta
!
!
!
NThetas = Construct(IConst)%BSDFInput%BasisMatNrows !Note here assuming row by row input
Basis%NThetas = NThetas
Basis%BasisMatIndex = Construct(IConst)%BSDFInput%BasisMatIndex
Basis%NBasis = Construct(IConst)%BSDFInput%NBasis
ALLOCATE(Basis%Grid(Basis%NBasis))
ALLOCATE(Thetas(NThetas+1)) !Temp array
!By convention the Thetas array contains a final point at Pi/2 which is not a basis element
ALLOCATE(NPhis(NThetas+1)) !Temp array
ALLOCATE(Basis%Thetas(NThetas+1))
ALLOCATE(Basis%NPhis(NThetas+1))
ALLOCATE(Basis%Lamda(Construct(IConst)%BSDFInput%NBasis))
ALLOCATE(Basis%SolAng(Construct(IConst)%BSDFInput%NBasis))
BTW: IF(Construct(IConst)%BSDFInput%BasisType == BasisType_WINDOW) THEN
!
! WINDOW6 Basis
!
Basis%BasisType = BasisType_WINDOW
BST: IF(Construct(IConst)%BSDFInput%BasisSymmetryType == BasisSymmetry_None) THEN
!
! No basis symmetry
!
Basis%BasisSymmetryType = BasisSymmetry_None
Thetas(1) = 0.0d0 !By convention, the first basis point is at the center (theta=0,phi=0)
Thetas(NThetas + 1) = 0.5d0*Pi !and there is an N+1st point (not a basis element) at Pi/2
NPhis(1) = 1
NumElem = 1
DO I = 2,NThetas
Thetas(I)=Construct(IConst)%BSDFInput%BasisMat(I,1)*DegToRadians
NPhis(I)=FLOOR(Construct(IConst)%BSDFInput%BasisMat(I,2)+0.001)
IF(NPhis(I)<=0) Call ShowFatalError('WindowComplexManager: incorrect input, no. phis must be positive.')
NumElem=NumElem+NPhis(I)
END DO
MaxNPhis =MAXVAL(NPhis(1:NThetas))
ALLOCATE(Basis%Phis( MaxNPhis + 1 , NThetas+1 ) ) !N+1st Phi point (not basis element) at 2Pi
ALLOCATE( Basis%BasisIndex ( NThetas+1 , MaxNPhis ) )
Basis%Phis =0.0d0 !Initialize so undefined elements will contain zero
Basis%BasisIndex = 0 !Initialize so undefined elements will contain zero
IF (NumElem /= Construct(IConst)%BSDFInput%NBasis) THEN !Constructed Basis must match property matrices
CALL ShowFatalError('WindowComplexManager: Constructed basis length does not match property matrices.')
ENDIF
Basis%Thetas = Thetas
Basis%NPhis = NPhis
ElemNo = 0
ThLoop: DO I = 1,NThetas
Theta = Thetas(I)
IF ( I == 1 ) THEN !First theta value must always be zero
HalfDTheta=0.5d0*Thetas(I+1)
LastTheta = 0.0d0
NextTheta = Thetas(I+1)
LowerTheta = 0.0d0
UpperTheta = HalfDTheta
ELSE IF(I > 1 .AND. I < NThetas) THEN
LastTheta = Thetas(I-1)
NextTheta = Thetas(I+1)
LowerTheta=UpperTheta
HalfDTheta = Theta - LowerTheta
UpperTheta = Theta + HalfDTheta
ELSE IF (I == NThetas) THEN
LastTheta = Thetas(I-1)
NextTheta = 0.5d0*Pi
LowerTheta = UpperTheta !It is assumed that Thetas(N) is the mean between the previous
!UpperTheta and pi/2.
UpperTheta = 0.5d0*Pi
ENDIF
DPhi=2.0d0*Pi/NPhis(I)
IF (I==1) THEN
Lamda = Pi*(SIN(UpperTheta))**2
SolAng = 2.0d0*Pi*(1.0d0 - COS(UpperTheta))
ELSE
Lamda=0.5d0*DPhi*((SIN(UpperTheta))**2-(SIN(LowerTheta))**2) !For W6 basis, lamda is funct of Theta and
! NPhis, not individual Phi
SolAng = DPhi*(COS(LowerTheta) - COS(UpperTheta))
END IF
DTheta = UpperTheta-LowerTheta
Basis%Phis ( NPhis(I) + 1 , I ) = 2.0d0*Pi !Non-basis-element Phi point for table searching in Phi
DO J = 1,NPhis(I)
ElemNo = ElemNo+1
Basis%BasisIndex(I,J) = ElemNo
Phi = (J-1)*DPhi
Basis%Phis( J , I ) = Phi !Note: this ordering of I & J are necessary to allow Phis(Theta) to
! be searched as a one-dimensional table
Call FillBasisElement (Theta,Phi,ElemNo,Basis%Grid(ElemNo) &
& ,LowerTheta,UpperTheta,DPhi,BasisType_WINDOW) !This gets all the simple grid characteristics
Basis%Lamda(ElemNo) = Lamda
Basis%SolAng(ElemNo) = SolAng
END DO
END DO ThLoop
ELSE BST
!
! Axisymmetric basis symmetry (Note this only useful specular systems, where it allows shorter data input)
!
Basis%BasisSymmetryType = BasisSymmetry_Axisymmetric
Thetas(1) = 0.0d0 !By convention, the first basis point is at the center (theta=0,phi=0)
Thetas(NThetas + 1) = 0.5d0*Pi !and there is an N+1st point (not a basis element) at Pi/2
NPhis = 1 !As insurance, define one phi for each theta
NumElem = 1
DO I = 2,NThetas
Thetas(I)=Construct(IConst)%BSDFInput%BasisMat(I,1)*DegToRadians
NumElem=NumElem+1
END DO
ALLOCATE(Basis%Phis( NThetas , 1 ) )
ALLOCATE( Basis%BasisIndex ( NThetas , 1 ) )
Basis%Phis =0.0d0 !Initialize so undefined elements will contain zero
Basis%BasisIndex = 0 !Initialize so undefined elements will contain zero
IF (NumElem /= Construct(IConst)%BSDFInput%NBasis) THEN !Constructed Basis must match property matrices
CALL ShowFatalError('WindowComplexManager: Constructed basis length does not match property matrices.')
ENDIF
Basis%Thetas = Thetas
Basis%NPhis = NPhis
ElemNo = 0
DPhi=2.0d0*Pi
ThLoop2: DO I = 1,NThetas
Theta = Thetas(I)
IF ( I == 1 ) THEN !First theta value must always be zero
HalfDTheta=0.5d0*Thetas(I+1)
LastTheta = 0.0d0
NextTheta = Thetas(I+1)
LowerTheta = 0.0d0
UpperTheta = HalfDTheta
ELSE IF(I > 1 .AND. I < NThetas) THEN
LastTheta = Thetas(I-1)
NextTheta = Thetas(I+1)
LowerTheta=UpperTheta
HalfDTheta = Theta - LowerTheta
UpperTheta = Theta + HalfDTheta
ELSE IF (I == NThetas) THEN
LastTheta = Thetas(I-1)
NextTheta = 0.5d0*Pi
LowerTheta = UpperTheta !It is assumed that Thetas(N) is the mean between the previous
!UpperTheta and pi/2.
UpperTheta = 0.5d0*Pi
ENDIF
IF (I==1) THEN
Lamda = Pi*(SIN(UpperTheta))**2
SolAng = 2.0d0*Pi*(1.0d0 - COS(UpperTheta))
ELSE
Lamda=0.5d0*DPhi*((SIN(UpperTheta))**2-(SIN(LowerTheta))**2) !For W6 basis, lamda is funct of Theta and
! NPhis, not individual Phi
SolAng = DPhi*(COS(LowerTheta) - COS(UpperTheta))
END IF
DTheta = UpperTheta-LowerTheta
ElemNo = ElemNo + 1
Basis%BasisIndex(I,1) = ElemNo
Phi = 0.0d0
Basis%Phis( 1 , I ) = Phi !Note: this ordering of I & J are necessary to allow Phis(Theta) to
! be searched as a one-dimensional table
Call FillBasisElement (Theta,Phi,ElemNo,Basis%Grid(ElemNo)&
,LowerTheta,UpperTheta,DPhi,BasisType_WINDOW) !This gets all the simple grid characteristics
Basis%Lamda(ElemNo) = Lamda
Basis%SolAng(ElemNo) = SolAng
END DO ThLoop2
END IF BST
ELSE BTW
Call ShowFatalError('WindowComplexManager: Non-Window6 basis type not yet implemented.')
END IF BTW
DEALLOCATE(Thetas,NPhis)
RETURN
END SUBROUTINE ConstructBasis