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) | :: | Theta | |||
real(kind=r64), | intent(in) | :: | Phi | |||
integer, | intent(in) | :: | RadType | |||
real(kind=r64), | intent(in) | :: | Gamma | |||
real(kind=r64), | intent(in) | :: | Alpha |
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.
FUNCTION WorldVectFromW6 (Theta, Phi, RadType, Gamma, Alpha) RESULT(UnitVect)
! SUBROUTINE INFORMATION:
! AUTHOR Joe Klems
! DATE WRITTEN Aug 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! Transform angular coordinates in the WINDOW6 coordinate system for
! a given surface into a unit vector in the world coordinate system,
! pointing to the radiation source (for incident radiation) or in
! the direction of propagation (for outgoing radiation)
! METHODOLOGY EMPLOYED:
! <n/a>
! REFERENCES:
! na
! USE STATEMENTS:
USE vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: Theta !Polar angle in W6 Coords
REAL(r64), INTENT(IN) :: Phi !Azimuthal angle in W6 Coords
INTEGER, INTENT(IN) :: RadType !Type of radiation: Front_Incident, etc.
REAL(r64), INTENT(IN) :: Gamma !Surface tilt angle, radians, world coordinate system
REAL(r64), INTENT(IN) :: Alpha !Surface azimuth, radians, world coordinate system
TYPE(Vector) :: UnitVect !unit vector direction in world CS
! Error tolerance is used to make small numbers equal to zero. Due to precision of pi constant used in E+, performing
! trigonometric operations on those constant will not cause absolutely accurate results
REAL(r64), PARAMETER :: ErrorTolerance = 1.d-10
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
UnitVect = vector(0.0d0, 0.0d0, 0.0d0)
SELECT CASE (RadType)
CASE (Front_Incident) !W6 vector will point in direction of propagation, must reverse to get world vector
! after the W6 vector has been rotated into the world CS
UnitVect%x = SIN(Theta)*SIN(Phi)*COS(Gamma)*SIN(Alpha)-SIN(Theta)*COS(Phi)*COS(Alpha)&
& +COS(Theta)*SIN(Gamma)*SIN(Alpha)
UnitVect%y = SIN(Theta)*COS(Phi)*SIN(Alpha)+SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)&
& +COS(Theta)*SIN(Gamma)*COS(Alpha)
UnitVect%z = -(SIN(Theta)*SIN(Phi)*SIN(Gamma)-COS(Theta)*COS(Gamma) )
CASE (Front_Transmitted)
UnitVect%x = SIN(Theta)*COS(Phi)*COS(Alpha)-SIN(Theta)*SIN(Phi)*COS(Gamma)*SIN(Alpha)&
& -COS(Theta)*SIN(Gamma)*SIN(Alpha)
UnitVect%y = -(SIN(Theta)*COS(Phi)*SIN(Alpha)+SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)&
& +COS(Theta)*SIN(Gamma)*COS(Alpha))
UnitVect%z = SIN(Theta)*SIN(Phi)*SIN(Gamma)-COS(Theta)*COS(Gamma)
CASE (Front_Reflected)
UnitVect%x = SIN(Theta)*COS(Phi)*COS(Alpha)-SIN(Theta)*SIN(Phi)*COS(Gamma)*SIN(Alpha)&
& +COS(Theta)*SIN(Gamma)*SIN(Alpha)
UnitVect%y = COS(Theta)*SIN(Gamma)*COS(Alpha)-SIN(Theta)*COS(Phi)*SIN(Alpha)&
& -SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)
UnitVect%z = SIN(Theta)*SIN(Phi)*SIN(Gamma)+COS(Theta)*COS(Gamma)
CASE (Back_Incident)
UnitVect%x = SIN(Theta)*SIN(Phi)*COS(Gamma)*SIN(Alpha) - SIN(Theta)*COS(Phi)*COS(Alpha)&
& -COS(Theta)*SIN(Gamma)*SIN(Alpha)
UnitVect%y = SIN(Theta)*COS(Phi)*SIN(Alpha) + SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)&
& -COS(Theta)*SIN(Gamma)*COS(Alpha)
UnitVect%z = -COS(Theta)*COS(Gamma)-SIN(Theta)*SIN(Phi)*SIN(Gamma)
CASE (Back_Transmitted) !This is same as front reflected
UnitVect%x = SIN(Theta)*COS(Phi)*COS(Alpha)-SIN(Theta)*SIN(Phi)*COS(Gamma)*SIN(Alpha)&
& +COS(Theta)*SIN(Gamma)*SIN(Alpha)
UnitVect%y = COS(Theta)*SIN(Gamma)*COS(Alpha)-SIN(Theta)*COS(Phi)*SIN(Alpha)&
& -SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)
UnitVect%z = SIN(Theta)*SIN(Phi)*SIN(Gamma)+COS(Theta)*COS(Gamma)
CASE (Back_Reflected) !This is same as front transmitted
UnitVect%x = SIN(Theta)*COS(Phi)*COS(Alpha)-SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)&
& -COS(Theta)*SIN(Gamma)*SIN(Alpha)
UnitVect%y = -(SIN(Theta)*COS(Phi)*SIN(Alpha)+SIN(Theta)*SIN(Phi)*COS(Gamma)*COS(Alpha)&
& +COS(Theta)*SIN(Gamma)*COS(Alpha))
UnitVect%z = SIN(Theta)*SIN(Phi)*SIN(Gamma)-COS(Theta)*COS(Gamma)
END SELECT
! Remove small numbers from evaluation (due to limited decimal points for pi)
IF (abs(UnitVect%x) <= ErrorTolerance) UnitVect%x = 0.0d0
IF (abs(UnitVect%y) <= ErrorTolerance) UnitVect%y = 0.0d0
IF (abs(UnitVect%z) <= ErrorTolerance) UnitVect%z = 0.0d0
RETURN
END FUNCTION WorldVectFromW6