! ###################################################################
! Copyright (c) 2013-2021, Marc De Graef Research Group/Carnegie Mellon University
! All rights reserved.
!
! Redistribution and use in source and binary forms, with or without modification, are
! permitted provided that the following conditions are met:
!
!     - Redistributions of source code must retain the above copyright notice, this list
!        of conditions and the following disclaimer.
!     - Redistributions in binary form must reproduce the above copyright notice, this
!        list of conditions and the following disclaimer in the documentation and/or
!        other materials provided with the distribution.
!     - Neither the names of Marc De Graef, Carnegie Mellon University nor the names
!        of its contributors may be used to endorse or promote products derived from
!        this software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! ###################################################################

!--------------------------------------------------------------------------
! EMsoft:rotations.f90
!--------------------------------------------------------------------------
!
! MODULE: rotations
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief everything that has to do with rotations and conversions between rotations
!
!> @details This file relies a lot on the relations listed in the book "Orientations
!> and Rotations" by Adam Morawiec [Springer 2004].  I've tried to implement every
!> available representation for rotations in a way that makes it easy to convert
!> between any pair.  Needless to say, this needs extensive testing and debugging...
!>
!> Instead of converting all the time between representations, I've opted to
!> "waste" a little more memory and time and provide the option to precompute all the representations.
!> This way all representations are available via a single data structure.
!>
!> Obviously, the individual conversion routines also exist and can be called either in
!> single or in double precision (using a function interface for each call, so that only
!> one function name is used).  The conversion routines use the following format for their
!> call name:  ab2cd, where (ab and cd are two-characters strings selected from the following
!> possibilities: [the number in parenthesis lists the number of entries that need to be provided]
!>
!> eu : euler angle representation (3)
!> om : orientation matrix representation (3x3)
!> ax : axis angle representation (4)
!> ro : Rodrigues vector representation (3)
!> qu : unit quaternion representation (4)
!> ho : homochoric representation (3)
!> cu : cubochoric representation (3)
!> st : 3D stereographic representation (3)  [added in October 2017]
!> rv : rotation vector representation (3)  [added in Summer 2019]
!>
!> hence, conversion from homochoric to euler angle is called as ho2eu(); the argument of
!> each routine must have the correct number of dimensions and entries.
!> All 42 conversion routines exist in both single and double precision.
!>
!> Some routines were modified in July 2014, to simplify the paths in case the direct conversion
!> routine does not exist.  Given the complexity of the cubochoric transformations, all routines
!> going to and from this representation will require at least one and sometimes two or three
!> intermediate representations.  cu2eu and qu2cu currently represent the longest computation
!> paths with three intermediate steps each.
!>
!> In August 2014, all routines were modified to account for active vs. passive rotations,
!> after some inconsistencies were discovered that could be traced back to that distinction.
!> The default is for a rotation to be passive, and only those transformation rules have been
!> implemented.  For active rotations, the user needs to explicitly take action in the calling
!> program.
!>
!> Testing: the program rotationtest.f90 was generated by an IDL script and contains all possible
!> pairwise and triplet transformations, using a series of input angle combinations; for now, these
!> are potentially problematic Euler combinations.
!>
!> The conventions of this module are:
!>
!> - all reference frames are right-handed and orthonormal (except for the Bravais frames)
!> - a rotation angle is positive for a counterclockwise rotation when viewing along the positive rotation axis towards the origin
!> - all rotations are interpreted in the passive way
!> - Euler angles follow the Bunge convention, with phi1 in [0,2pi], Phi in [0,pi], and phi2 in [0,2pi]
!> - rotation angles (in axis-angle derived representations) are limited to the range [0,pi]
!>
!> To make things easier for the user, this module provides a routine to create a rotation
!> representation starting from an axis, described by a unit axis vector, and a rotation angle.
!> This routine properly takes the sign of epsijk into account, and always produces a passive rotation.
!> The user must explicitly take action to interpret a rotation a being active.
!>
!> @date 08/04/13 MDG 1.0 original
!> @date 07/08/14 MDG 2.0 modifications to several routines (mostly simplifications)
!> @date 08/08/14 MDG 3.0 added active/passive handling (all routines passive)
!> @date 08/11/14 MDG 3.1 modified Rodrigues vector to 4 components (n and length) to accomodate Infinity
!> @date 08/18/14 MDG 3.2 added RotateVector, RotateTensor2 routines with active/passive switch
!> @date 08/20/14 MDG 3.3 completed extensive testing of epsijk<0 mode; all tests passed for the first time !
!> @date 08/21/14 MDG 3.4 minor correction in om2ax to get things to work for epsijk>0 mode; all tests passed!
!> @date 09/30/14 MDG 3.5 added routines to make rotation definitions easier
!> @date 09/30/14 MDG 3.6 added strict range checking routines for all representations (tested on 10/1/14)
!> @date 03/11/15 MDG 3.7 removed the RotVec_q routine, since it is surpassed by the new quat_Lp and quat_Lpstar routines
!> @date 03/12/15 MDG 3.8 correction of Rodrigues representation for identity rotation -> [0,0,epsijk,0]
!> @date 03/16/15 MDG 3.9 added quat_average routine
!> @date 04/17/15 MDG 3.91 simplification to qu2eu routines
!> @date 09/23/15 MDG 3.92 changes to .eq. tests on reals; replaced all by close_enough calls
!> @date 10/05/17 MDG 4.0 added 3D stereographic representation
!> @date 10/29/19  SS 5.0 added rotation vector representation
!> @date 10/31/19 MDG 5.1 replaced 'ex' notation by 'rv' for rotation vector
!--------------------------------------------------------------------------
module rotations

use local
use typedefs
use quaternions
use math

!--------------------------------
! routines to check the validity range of rotation representations
public :: eu_check
interface eu_check
        module procedure eu_check
        module procedure eu_check_d
end interface

public :: ro_check
interface ro_check
        module procedure ro_check
        module procedure ro_check_d
end interface

public :: ho_check
interface ho_check
        module procedure ho_check
        module procedure ho_check_d
end interface

public :: cu_check
interface cu_check
        module procedure cu_check
        module procedure cu_check_d
end interface

public :: qu_check
interface qu_check
        module procedure qu_check
        module procedure qu_check_d
end interface

public :: ax_check
interface ax_check
        module procedure ax_check
        module procedure ax_check_d
end interface

public :: om_check
interface om_check
        module procedure om_check
        module procedure om_check_d
end interface

public :: st_check
interface st_check
        module procedure st_check
        module procedure st_check_d
end interface

public :: rv_check
interface rv_check
        module procedure rv_check
        module procedure rv_check_d
end interface
!--------------------------------
! general rotation creation routine, to make sure that a rotation representation is
! correctly initialized, takes an axis and an angle as input, returns an orientationtype structure
public:: genrot
interface genrot
        module procedure genrot
        module procedure genrot_d
end interface

! general interface routine to populate the orientation type
public:: init_orientation
interface init_orientation
        module procedure init_orientation
        module procedure init_orientation_om
        module procedure init_orientation_d
        module procedure init_orientation_om_d
end interface

!--------------------------------
! convert Euler angles to 3x3 orientation matrix
public :: eu2om
interface eu2om
        module procedure eu2om
        module procedure eu2om_d
end interface

! convert Euler angles to axis angle
public :: eu2ax
interface eu2ax
        module procedure eu2ax
        module procedure eu2ax_d
end interface

! convert Euler angles to Rodrigues vector
public :: eu2ro
interface eu2ro
        module procedure eu2ro
        module procedure eu2ro_d
end interface

! convert Euler angles to quaternion
public :: eu2qu
interface eu2qu
        module procedure eu2qu
        module procedure eu2qu_d
end interface

! convert Euler angles to homochoric
public :: eu2ho
interface eu2ho
        module procedure eu2ho
        module procedure eu2ho_d
end interface

! convert Euler angles to cubochoric
public :: eu2cu
interface eu2cu
        module procedure eu2cu
        module procedure eu2cu_d
end interface

! convert Euler angles to stereographic
public :: eu2st
interface eu2st
        module procedure eu2st
        module procedure eu2st_d
end interface

! convert Euler angles to rotation vector map
public :: eu2rv
interface eu2rv
        module procedure eu2rv
        module procedure eu2rv_d
end interface

!--------------------------------
! convert 3x3 orientation matrix to Euler angles
public :: om2eu
interface om2eu
        module procedure om2eu
        module procedure om2eu_d
end interface

! convert 3x3 orientation matrix to axis angle
public :: om2ax
interface om2ax
        module procedure om2ax
        module procedure om2ax_d
end interface

! convert 3x3 orientation matrix to Rodrigues
public :: om2ro
interface om2ro
        module procedure om2ro
        module procedure om2ro_d
end interface

! convert 3x3 rotation matrix to quaternion
public :: om2qu
interface om2qu
        module procedure om2qu
        module procedure om2qu_d
end interface

! convert 3x3 rotation matrix to homochoric
public :: om2ho
interface om2ho
        module procedure om2ho
        module procedure om2ho_d
end interface

! convert 3x3 rotation matrix to cubochoric
public :: om2cu
interface om2cu
        module procedure om2cu
        module procedure om2cu_d
end interface

! convert 3x3 rotation matrix to stereographic
public :: om2st
interface om2st
        module procedure om2st
        module procedure om2st_d
end interface

! convert rotation matrix to rotation vector map
public :: om2rv
interface om2rv
        module procedure om2rv
        module procedure om2rv_d
end interface

!--------------------------------
! convert axis angle pair to euler
public :: ax2eu
interface ax2eu
        module procedure ax2eu
        module procedure ax2eu_d
end interface

! convert axis angle pair to orientation matrix
public :: ax2om
interface ax2om
        module procedure ax2om
        module procedure ax2om_d
end interface

! convert axis angle pair to Rodrigues
public :: ax2ro
interface ax2ro
        module procedure ax2ro
        module procedure ax2ro_d
end interface

! convert axis angle pair to quaternion
public :: ax2qu
interface ax2qu
        module procedure ax2qu
        module procedure ax2qu_d
end interface

! convert axis angle pair to homochoric representation
public :: ax2ho
interface ax2ho
        module procedure ax2ho
        module procedure ax2ho_d
end interface

! convert axis angle pair to cubochoric
public :: ax2cu
interface ax2cu
        module procedure ax2cu
        module procedure ax2cu_d
end interface

! convert axis angle pair to stereographic
public :: ax2st
interface ax2st
        module procedure ax2st
        module procedure ax2st_d
end interface

! convert axis angle pair to rotation vector map
public :: ax2rv
interface ax2rv
        module procedure ax2rv
        module procedure ax2rv_d
end interface

!--------------------------------
! convert Rodrigues vector to Euler angles
public :: ro2eu
interface ro2eu
        module procedure ro2eu
        module procedure ro2eu_d
end interface

! convert Rodrigues vector to orientation matrix
public :: ro2om
interface ro2om
        module procedure ro2om
        module procedure ro2om_d
end interface

! convert Rodrigues vector to axis angle pair
public :: ro2ax
interface ro2ax
        module procedure ro2ax
        module procedure ro2ax_d
end interface

! convert Rodrigues vector to quaternion
public :: ro2qu
interface ro2qu
        module procedure ro2qu
        module procedure ro2qu_d
end interface

! convert Rodrigues vector to homochoric
public :: ro2ho
interface ro2ho
        module procedure ro2ho
        module procedure ro2ho_d
end interface

! convert Rodrigues vector to cubochoric
public :: ro2cu
interface ro2cu
        module procedure ro2cu
        module procedure ro2cu_d
end interface

! convert Rodrigues vector to stereographic
public :: ro2st
interface ro2st
        module procedure ro2st
        module procedure ro2st_d
end interface

! convert Rodrigues vector to rotation vector map
public :: ro2rv
interface ro2rv
        module procedure ro2rv
        module procedure ro2rv_d
end interface

!--------------------------------
! convert quaternion to Euler angles
public :: qu2eu
interface qu2eu
        module procedure qu2eu
        module procedure qu2eu_d
end interface

! convert quaternion to orientation matrix
public :: qu2om
interface qu2om
        module procedure qu2om
        module procedure qu2om_d
end interface

! convert quaternion to axis angle
public :: qu2ax
interface qu2ax
        module procedure qu2ax
        module procedure qu2ax_d
end interface

! convert quaternion to Rodrigues
public :: qu2ro
interface qu2ro
        module procedure qu2ro
        module procedure qu2ro_d
end interface

! convert quaternion to homochoric
public :: qu2ho
interface qu2ho
        module procedure qu2ho
        module procedure qu2ho_d
end interface

! convert quaternion to cubochoric
public :: qu2cu
interface qu2cu
        module procedure qu2cu
        module procedure qu2cu_d
end interface

! convert quaternion to stereographic
public :: qu2st
interface qu2st
        module procedure qu2st
        module procedure qu2st_d
end interface

! convert quaternion to rotation vector map
public :: qu2rv
interface qu2rv
        module procedure qu2rv
        module procedure qu2rv_d
end interface

!--------------------------------
! convert homochoric to euler
public :: ho2eu
interface ho2eu
        module procedure ho2eu
        module procedure ho2eu_d
end interface

! convert homochoric to orientation matrix
public :: ho2om
interface ho2om
        module procedure ho2om
        module procedure ho2om_d
end interface

! convert homochoric to axis angle pair
public :: ho2ax
interface ho2ax
        module procedure ho2ax
        module procedure ho2ax_d
end interface

! convert homochoric to Rodrigues
public :: ho2ro
interface ho2ro
        module procedure ho2ro
        module procedure ho2ro_d
end interface

! convert homochoric to quaternion
public :: ho2qu
interface ho2qu
        module procedure ho2qu
        module procedure ho2qu_d
end interface

! convert homochoric to cubochoric
public :: ho2cu
interface ho2cu
        module procedure ho2cu
        module procedure ho2cu_d
end interface

! convert homochoric to steregraphic
public :: ho2st
interface ho2st
        module procedure ho2st
        module procedure ho2st_d
end interface

! convert homochoric to rotation vector map
public :: ho2rv
interface ho2rv
        module procedure ho2rv
        module procedure ho2rv_d
end interface

!--------------------------------
! convert cubochoric to euler
public :: cu2eu
interface cu2eu
        module procedure cu2eu
        module procedure cu2eu_d
end interface

! convert cubochoric to orientation matrix
public :: cu2om
interface cu2om
        module procedure cu2om
        module procedure cu2om_d
end interface

! convert cubochoric to axis angle
public :: cu2ax
interface cu2ax
        module procedure cu2ax
        module procedure cu2ax_d
end interface

! convert cubochoric to Rodrigues
public :: cu2ro
interface cu2ro
        module procedure cu2ro
        module procedure cu2ro_d
end interface

! convert cubochoric to quaternion
public :: cu2qu
interface cu2qu
        module procedure cu2qu
        module procedure cu2qu_d
end interface

! convert cubochoric to homochoric
public :: cu2ho
interface cu2ho
        module procedure cu2ho
        module procedure cu2ho_d
end interface

! convert cubochoric to stereographic
public :: cu2st
interface cu2st
        module procedure cu2st
        module procedure cu2st_d
end interface

! convert cubochoric to rotation vector map
public :: cu2rv
interface cu2rv
        module procedure cu2rv
        module procedure cu2rv_d
end interface

!--------------------------------
! convert stereographic to euler
public :: st2eu
interface st2eu
        module procedure st2eu
        module procedure st2eu_d
end interface

! convert stereographic to orientation matrix
public :: st2om
interface st2om
        module procedure st2om
        module procedure st2om_d
end interface

! convert stereographic to axis angle
public :: st2ax
interface st2ax
        module procedure st2ax
        module procedure st2ax_d
end interface

! convert stereographic to Rodrigues
public :: st2ro
interface st2ro
        module procedure st2ro
        module procedure st2ro_d
end interface

! convert stereographic to quaternion
public :: st2qu
interface st2qu
        module procedure st2qu
        module procedure st2qu_d
end interface

! convert stereographic to homochoric
public :: st2ho
interface st2ho
        module procedure st2ho
        module procedure st2ho_d
end interface

! convert stereographic to homochoric
public :: st2cu
interface st2cu
        module procedure st2cu
        module procedure st2cu_d
end interface

! convert stereographic to rotation vector map
public :: st2rv
interface st2rv
        module procedure st2rv
        module procedure st2rv_d
end interface

!-----------------------------------
! rotation vector map to axis-angle pair
public :: rv2ax
interface rv2ax
        module procedure rv2ax
        module procedure rv2ax_d
end interface

! rotation vector map to quaternion
public :: rv2qu
interface rv2qu
        module procedure rv2qu
        module procedure rv2qu_d
end interface

! rotation vector map to euler
public :: rv2eu
interface rv2eu
        module procedure rv2eu
        module procedure rv2eu_d
end interface

! rotation vector map to rodrigues vector
public :: rv2ro
interface rv2ro
        module procedure rv2ro
        module procedure rv2ro_d
end interface

! rotation vector map to orientation matrix
public :: rv2om
interface rv2om
        module procedure rv2om
        module procedure rv2om_d
end interface

! rotation vector map to cubochoric vector
public :: rv2cu
interface rv2cu
        module procedure rv2cu
        module procedure rv2cu_d
end interface

! rotation vector map to stereographic vector
public :: rv2st
interface rv2st
        module procedure rv2st
        module procedure rv2st_d
end interface

! rotation vector map to homochoric vector
public :: rv2ho
interface rv2ho
        module procedure rv2ho
        module procedure rv2ho_d
end interface

!--------------------------------
! Rodrigues vector product
public :: RodriguesProduct
interface RodriguesProduct
        module procedure RodriguesProduct
        module procedure RodriguesProduct_d
end interface

! apply a rotation to a vector
public :: RotateVector
interface RotateVector
        module procedure RotVec_om
        module procedure RotVec_om_d
end interface

! apply a rotation to a second rank tensor
public :: RotateTensor2
interface RotateTensor2
        module procedure RotTensor2_om
        module procedure RotTensor2_om_d
end interface

! average a list of quaternions
public :: quat_average
interface quat_average
        module procedure quat_average
        module procedure quat_average_d
end interface

!--------------------------------
! print quaternion and equivalent 3x3 rotation matrix
public :: print_orientation
interface print_orientation
        module procedure print_orientation
        module procedure print_orientation_d
end interface

! numerical comparison test of two reals
private :: close_enough
interface close_enough
        module procedure close_enough
        module procedure close_enough_d
end interface

contains

!--------------------------------------------------------------------------
!
! Function: close_enough
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief compares two reals and returns .TRUE. is they are closer than E-8 ! machine precision
!
!> @param a (single precision)
!> @param b (single precision)
!
!> @date 9/23/15 MDG 1.0 original
!--------------------------------------------------------------------------
recursive function close_enough(a,b) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: close_enough

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: a
real(kind=sgl),INTENT(IN)       :: b
logical                         :: res

real(kind=sgl)                  :: eps = 1.E-08 ! epsilon(1.0)

res = .FALSE.
if (abs(a-b).lt.eps) res = .TRUE.

end function close_enough

!--------------------------------------------------------------------------
!
! Function: close_enough_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief compares two reals and returns .TRUE. is they are closer than D-12 ! machine precision
!
!> @param a (double precision)
!> @param b (double precision)
!
!> @date 9/23/15 MDG 1.0 original
!--------------------------------------------------------------------------
recursive function close_enough_d(a,b) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: close_enough_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: a
real(kind=dbl),INTENT(IN)       :: b
logical                         :: res

real(kind=sgl)                  :: eps = 1.D-12 ! epsilon(1.0D0)

res = .FALSE.
if (dabs(a-b).lt.eps) res = .TRUE.

end function close_enough_d

!--------------------------------------------------------------------------
!
! Function: eu_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the Euler angles are in the correct respective ranges
!
!> @param eu 3-component vector (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu_check(eu) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: eu(3)

integer(kind=irg)               :: res

res = 1

if ((eu(1).lt.0.0).or.(eu(1).gt.(2.0*sngl(cPi)))) then
   call FatalError('rotations:eu_check','phi1 Euler angle outside of valid range [0,2pi]')
endif
if ((eu(2).lt.0.0).or.(eu(2).gt.cPi)) then
   call FatalError('rotations:eu_check','Phi  Euler angle outside of valid range [0,pi]')
endif
if ((eu(3).lt.0.0).or.(eu(3).gt.(2.0*sngl(cPi)))) then
   call FatalError('rotations:eu_check','phi2 Euler angle outside of valid range [0,2pi]')
endif

res = 0

end function eu_check

!--------------------------------------------------------------------------
!
! Function: eu_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the Euler angles are in the correct respective ranges
!
!> @param eu 3-component vector (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu_check_d(eu) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: eu(3)

integer(kind=irg)               :: res

res = 1

if ((eu(1).lt.0.0).or.(eu(1).gt.(2.0*sngl(cPi)))) then
   call FatalError('rotations:eu_check_d','phi1 Euler angle outside of valid range [0,2pi]')
endif
if ((eu(2).lt.0.0).or.(eu(2).gt.cPi)) then
   call FatalError('rotations:eu_check_d','Phi  Euler angle outside of valid range [0,pi]')
endif
if ((eu(3).lt.0.0).or.(eu(3).gt.(2.0*sngl(cPi)))) then
   call FatalError('rotations:eu_check_d','phi2 Euler angle outside of valid range [0,2pi]')
endif

res = 0

end function eu_check_d

!--------------------------------------------------------------------------
!
! Function: ro_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the Rodrigues vector has positive length and unit axis vector
!
!> @param ro 4-component vector (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro_check(ro) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: ro(4)

integer(kind=irg)               :: res
real(kind=sgl), parameter       :: eps = 1.e-7

res = 1

if (ro(4).lt.0.0) then
   call FatalError('rotations:ro_check','Rodrigues-Frank vector has negative length')
endif
if (abs(sqrt(sum(ro(1:3)*ro(1:3)))-1.0).gt.eps) then
   call FatalError('rotations:ro_check','Rodrigues-Frank axis vector not normalized')
endif

res = 0

end function ro_check

!--------------------------------------------------------------------------
!
! Function: ro_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the Rodrigues vector has positive length and unit axis vector
!
!> @param ro 4-component vector (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro_check_d(ro) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: ro(4)

integer(kind=irg)               :: res
real(kind=dbl), parameter       :: eps = 1.d-15

res = 1

if (ro(4).lt.0.0) then
   call FatalError('rotations:ro_check_d','Rodrigues-Frank vector has negative length')
endif
if (abs(sqrt(sum(ro(1:3)*ro(1:3)))-1.0).gt.eps) then
   call FatalError('rotations:ro_check_d','Rodrigues-Frank axis vector not normalized')
endif

res = 0

end function ro_check_d

!--------------------------------------------------------------------------
!
! Function: ho_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the homochoric vector is inside or on the homochoric ball
!
!> @param ho 3-component vector (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho_check(ho) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: ho(3)

integer(kind=irg)               :: res
real(kind=sgl)                  :: r

res = 1

r = sqrt(sum(ho*ho))
if (r.gt.sngl(LPs%R1)) then
   call FatalError('rotations:ho_check','homochoric vector outside homochoric ball')
endif

res = 0

end function ho_check

!--------------------------------------------------------------------------
!
! Function: ho_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the homochoric vector is inside or on the homochoric ball
!
!> @param ho 3-component vector (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho_check_d(ho) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: ho(3)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r

res = 1

r = dsqrt(sum(ho*ho))
if (r.gt.LPs%R1) then
   call FatalError('rotations:ho_check_d','homochoric vector outside homochoric ball')
endif

res = 0

end function ho_check_d

!--------------------------------------------------------------------------
!
! Function: cu_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the cubochoric vector is inside or on the cube
!
!> @param cu 3-component vector (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu_check(cu) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: cu(3)

integer(kind=irg)               :: res
real(kind=sgl)                  :: r

res = 1

r = maxval(abs(cu))
if (r.gt.sngl(LPs%ap/2.D0)) then
   call FatalError('rotations:cu_check','cubochoric vector outside cube')
endif

res = 0

end function cu_check

!--------------------------------------------------------------------------
!
! Function: cu_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the cubochoric vector is inside or on the cube
!
!> @param cu 3-component vector (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu_check_d(cu) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: cu(3)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r

res = 1

r = maxval(dabs(cu))
if (r.gt.(LPs%ap/2.D0)) then
   call FatalError('rotations:cu_check_d','cubochoric vector outside cube')
endif

res = 0

end function cu_check_d

!--------------------------------------------------------------------------
!
! Function: qu_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the quaternion has unit length and positive scalar part
!
!> @param qu 4-component vector (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu_check(qu) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: qu(4)

integer(kind=irg)               :: res
real(kind=sgl)                  :: r
real(kind=sgl), parameter       :: eps = 1.e-7

res = 1

r = sqrt(sum(qu*qu))
if (qu(1).lt.0.0) then
   call FatalError('rotations:qu_check','quaternion must have positive scalar part')
endif
if (abs(r-1.0).gt.eps) then
   call FatalError('rotations:qu_check','quaternion must have unit norm')
endif

res = 0

end function qu_check

!--------------------------------------------------------------------------
!
! Function: qu_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the quaternion has unit length and positive scalar part
!
!> @param qu 4-component vector (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu_check_d(qu) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: qu(4)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r
real(kind=dbl), parameter       :: eps = 1.d-15

res = 1

r = dsqrt(sum(qu*qu))
if (qu(1).lt.0.D0) then
   call FatalError('rotations:qu_check_d','quaternion must have positive scalar part')
endif
if (dabs(r-1.D0).gt.eps) then
   call FatalError('rotations:qu_check_d','quaternion must have unit norm')
endif

res = 0

end function qu_check_d

!--------------------------------------------------------------------------
!
! Function: st_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the stereographic vector lies inside the unit ball
!
!> @param st 3-component vector (single precision)
!>
!> @date 10/05/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st_check(st) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: st(3)

integer(kind=irg)               :: res
real(kind=sgl)                  :: r
real(kind=sgl), parameter       :: eps = 1.e-7

res = 1

r = sqrt(sum(st*st))
if (abs(r-1.0).gt.eps) then
   call FatalError('rotations:st_check','stereographic vector must have unit norm')
endif

res = 0

end function st_check

!--------------------------------------------------------------------------
!
! Function: st_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the stereographic vector lies inside the unit ball
!
!> @param st 3-component vector (double precision)
!>
!> @date 10/05/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st_check_d(st) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: st(3)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r
real(kind=dbl), parameter       :: eps = 1.d-15

res = 1

r = sqrt(sum(st*st))
if (abs(r-1.0).gt.eps) then
   call FatalError('rotations:st_check_d','stereographic vector must have unit norm')
endif

res = 0

end function st_check_d

!--------------------------------------------------------------------------
!
! Function: ax_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the axis angle pair has a unit vector and angle in the correct range
!
!> @param ax 4-component vector (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax_check(ax) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: ax(4)

integer(kind=irg)               :: res
real(kind=sgl)                  :: r
real(kind=sgl), parameter       :: eps = 1.e-7

res = 1

r = sqrt(sum(ax(1:3)*ax(1:3)))
if ((ax(4).lt.0.0).or.(ax(4).gt.sngl(cPi))) then
   call FatalError('rotations:ax_check','angle must be in range [0,pi]')
endif
if (abs(r-1.0).gt.eps) then
   call FatalError('rotations:ax_check','axis-angle axis vector must have unit norm')
endif

res = 0

end function ax_check

!--------------------------------------------------------------------------
!
! Function: ax_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the axis angle pair has a unit vector and angle in the correct range
!
!> @param ax 4-component vector (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax_check_d(ax) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: ax(4)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r
real(kind=dbl), parameter       :: eps = 1.e-15

res = 1

r = dsqrt(sum(ax(1:3)*ax(1:3)))
if ((ax(4).lt.0.D0).or.(ax(4).gt.cPi)) then
   call FatalError('rotations:ax_check_d','angle must be in range [0,pi]')
endif
if (dabs(r-1.D0).gt.eps) then
   call FatalError('rotations:ax_check_d','axis-angle axis vector must have unit norm')
endif

res = 0

end function ax_check_d

!--------------------------------------------------------------------------
!
! Function: om_check
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the rotation matrix is actually a proper rotation matrix
!
!> @param om 3x3-component matrix (single precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om_check(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: om(3,3)

integer(kind=irg)               :: res
real(kind=sgl)                  :: r, det
real(kind=sgl), parameter       :: eps = 1.e-6
integer(kind=irg)               :: i

res = 1

! compute the determinant (must be +1)
det = om(1,1)*om(2,2)*om(3,3) + om(1,2)*om(2,3)*om(3,1) + om(1,3)*om(2,1)*om(3,2) - &
      om(1,3)*om(2,2)*om(3,1) - om(1,2)*om(2,1)*om(3,3) - om(1,1)*om(2,3)*om(3,2)
if (det.lt.0.0) then
   call FatalError('rotations:om_check','Determinant of rotation matrix must be positive')
endif
if (abs(det-1.0).gt.eps) then
   call FatalError('rotations:om_check','Determinant of rotation matrix must be unity')
endif

! next check the row and column sums
r = sum(abs(matmul(om,transpose(om))))
if (abs(r-3.0).gt.eps) then
   call FatalError('rotations:om_check','rotation matrix times transpose must be identity matrix')
endif

res = 0

end function om_check

!--------------------------------------------------------------------------
!
! Function: om_check_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief verify that the rotation matrix is actually a proper rotation matrix
!
!> @param om 3x3-component matrix (double precision)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om_check_d(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: om(3,3)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r, det
real(kind=dbl), parameter       :: eps = 1.e-15
integer(kind=irg)               :: i

res = 1

! compute the determinant (must be +1)
det = om(1,1)*om(2,2)*om(3,3) + om(1,2)*om(2,3)*om(3,1) + om(1,3)*om(2,1)*om(3,2) - &
      om(1,3)*om(2,2)*om(3,1) - om(1,2)*om(2,1)*om(3,3) - om(1,1)*om(2,3)*om(3,2)
if (det.lt.0.D0) then
   call FatalError('rotations:om_check_d','Determinant of rotation matrix must be positive')
endif
if (dabs(det-1.D0).gt.eps) then
   call FatalError('rotations:om_check_d','Determinant of rotation matrix must be unity')
endif

! next check the row and column sums
r = sum(dabs(matmul(om,transpose(om))))
if (dabs(r-3.D0).gt.eps) then
   call FatalError('rotations:om_check_d','rotation matrix times transpose must be identity matrix')
endif

res = 0

end function om_check_d

!--------------------------------------------------------------------------
!
! Function: rv_check
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief verify that the rotation vector has magnitude in range [0, pi]
!
!> @param ex 3-component vector (single precision)
!>
!
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv_check(rv) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv_check

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: rv(3)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r
real(kind=dbl), parameter       :: eps = 1.e-15

res = 1

r = vecnorm(rv)

if ((r - cPi) .ge. eps) then
   call FatalError('rotations:rv_check_d','magnitude must be in range [0,pi]')
endif

res = 0

end function rv_check

!--------------------------------------------------------------------------
!
! Function: rv_check_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief verify that the rotation vector map has magnitude in range [0, pi]
!
!> @param ex 3-component vector (double precision)
!>
!
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv_check_d(rv) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv_check_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: rv(3)

integer(kind=irg)               :: res
real(kind=dbl)                  :: r
real(kind=dbl), parameter       :: eps = 1.e-15

res = 1

r = vecnorm(rv)

if ((r - cPi) .ge. eps) then
   call FatalError('rotations:rv_check_d','magnitude must be in range [0,pi]')
endif

res = 0

end function rv_check_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! here we start with a series of input routines
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! Function: genrot
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief generate a passive rotation representation, given the unit axis vector and the rotation angle
!
!> @param av 3-component vector (single precision)
!> @param omega rotation angle (radians)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function genrot(av,omega) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: genrot

use local
use constants
use error

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: av(3)
real(kind=sgl),INTENT(IN)       :: omega

type(orientationtype)           :: res
real(kind=sgl)                  :: axang(4), s

! first make sure that the rotation angle is in the interval [0,pi]
if ((omega.lt.0.0).or.(omega.gt.sngl(cPi))) then
  call FatalError('rotations:getrot','rotation angle must be in range [0,pi]')
  STOP
endif

! define the axis-angle pair with the correct sign of epsijk
axang(1:3) = -epsijk * av(1:3)
axang(4) = omega

! normalize the unit vector
s = sqrt(sum(av*av))
if (s.ne.0.0) then
        axang(1:3) = axang(1:3)/s
else
        call FatalError('rotations:getrot','axis unit vector can not be [0,0,0]')
        STOP
endif

res = init_orientation(axang,'ax')

end function genrot

!--------------------------------------------------------------------------
!
! Function: genrot_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief generate a passive rotation representation, given the unit axis vector and the rotation angle
!
!> @param av 3-component vector (double precision)
!> @param omega rotation angle (radians)
!>
!
!> @date 9/30/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function genrot_d(av,omega) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: genrot_d

use local
use constants
use error

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: av(3)
real(kind=dbl),INTENT(IN)       :: omega

type(orientationtyped)          :: res
real(kind=dbl)                  :: axang(4), s

! first make sure that the rotation angle is in the interval [0,pi]
if ((omega.lt.0.D0).or.(omega.gt.cPi)) then
  call FatalError('rotations:getrot_d','rotation angle must be in range [0,pi]')
  STOP
endif

! define the axis-angle pair with the correct sign of epsijk
axang(1:3) = -epsijk * av(1:3)
axang(4) = omega

! normalize the unit vector
s = dsqrt(sum(av*av))
if (s.ne.0.D0) then
        axang(1:3) = axang(1:3)/s
else
        call FatalError('rotations:getrot','axis unit vector can not be [0,0,0]')
        STOP
endif

res = init_orientation_d(axang,'ax')

end function genrot_d

!--------------------------------------------------------------------------
!
! Function: init_orientation
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief take an orientation representation with 3 components and init all others (single precision)
!
!> @param orient 3-component vector (single precision)
!> @param intype input type ['eu', 'ro', 'ho', 'cu']
!> @param rotcheck  optional parameter to enforce strict range checking
!
!> @date 8/04/13   MDG 1.0 original
!> @date 9/30/14   MDG 1.1 added testing of valid ranges
!--------------------------------------------------------------------------
recursive function init_orientation(orient,intype,rotcheck) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: init_orientation

use local

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: orient(*)            ! 3 or 4 component orientation descriptor
character(2),INTENT(IN)         :: intype               ! describes input type
logical,INTENT(IN),OPTIONAL     :: rotcheck             ! check valid range if present

type(orientationtype)           :: res
integer(kind=irg)               :: i

select case (intype)
        case ('eu')     ! Euler angles
                ! verify the Euler angle ranges; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = eu_check(orient)
                endif
                res%eulang = orient(1:3)
                res%om = eu2om(orient(1:3))
                res%quat = eu2qu(orient(1:3))
                res%rodrigues = eu2ro(orient(1:3))
                res%axang = eu2ax(orient(1:3))
                res%homochoric = eu2ho(orient(1:3))
                res%cubochoric = eu2cu(orient(1:3))
                res%stereographic = eu2st(orient(1:3))
                res%rvmap = eu2rv(orient(1:3))
        case ('ro')     ! Rodrigues vector
                ! verify the Rodrigues-Frank vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = ro_check(orient)
                endif
                res%rodrigues = orient(1:4)
                res%eulang = ro2eu(orient(1:4))
                res%om = ro2om(orient(1:4))
                res%quat = ro2qu(orient(1:4))
                res%axang = ro2ax(orient(1:4))
                res%homochoric = ro2ho(orient(1:4))
                res%cubochoric = ro2cu(orient(1:4))
                res%stereographic = ro2st(orient(1:4))
                res%rvmap = ro2rv(orient(1:4))
        case ('ho')     ! homochoric
                ! verify the homochoric vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = ho_check(orient)
                endif
                res%homochoric = orient(1:3)
                res%axang = ho2ax(orient(1:3))
                res%om = ho2om(orient(1:3))
                res%eulang = ho2eu(orient(1:3))
                res%rodrigues = ho2ro(orient(1:3))
                res%quat = ho2qu(orient(1:3))
                res%cubochoric = ho2cu(orient(1:3))
                res%stereographic = ho2st(orient(1:3))
                res%rvmap = ho2rv(orient(1:3))
        case ('cu')     ! cubochoric
                ! verify the cubochoric vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = cu_check(orient)
                endif
                res%cubochoric = orient(1:3)
                res%homochoric = cu2ho(orient(1:3))
                res%eulang = cu2eu(orient(1:3))
                res%om = cu2om(orient(1:3))
                res%quat = cu2qu(orient(1:3))
                res%axang = cu2ax(orient(1:3))
                res%rodrigues = cu2ro(orient(1:3))
                res%stereographic = cu2st(orient(1:3))
                res%rvmap = cu2rv(orient(1:3))
        case ('st')     ! stereographic
                ! verify the cstereographic vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = st_check(orient)
                endif
                res%stereographic = orient(1:3)
                res%cubochoric = st2cu(orient(1:3))
                res%homochoric = st2ho(orient(1:3))
                res%eulang = st2eu(orient(1:3))
                res%om = st2om(orient(1:3))
                res%quat = st2qu(orient(1:3))
                res%axang = st2ax(orient(1:3))
                res%rodrigues = st2ro(orient(1:3))
                res%rvmap = st2rv(orient(1:3))
        case ('qu')     ! quaternion
                ! verify the quaternion; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = qu_check(orient)
                endif
                res%quat = orient(1:4)
                res%eulang = qu2eu(orient(1:4))
                res%om = qu2om(orient(1:4))
                res%rodrigues = qu2ro(orient(1:4))
                res%axang = qu2ax(orient(1:4))
                res%homochoric = qu2ho(orient(1:4))
                res%cubochoric = qu2cu(orient(1:4))
                res%stereographic = qu2st(orient(1:4))
                res%rvmap = qu2rv(orient(1:4))
        case ('ax')     ! axis angle pair
                ! verify the axis angle pair; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = ax_check(orient)
                endif
                res%axang = orient(1:4)
                res%om = ax2om(orient(1:4))
                res%eulang = ax2eu(orient(1:4))
                res%rodrigues = ax2ro(orient(1:4))
                res%quat = ax2qu(orient(1:4))
                res%homochoric = ax2ho(orient(1:4))
                res%cubochoric = ax2cu(orient(1:4))
                res%stereographic = ax2st(orient(1:4))
                res%rvmap = ax2rv(orient(1:4))
        case('rv')      ! rotation vector map
                ! verify the rotation vector map; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = qu_check(orient)
                endif
                res%rvmap = orient(1:3)
                res%stereographic = rv2st(orient(1:3))
                res%cubochoric = rv2cu(orient(1:3))
                res%homochoric = rv2ho(orient(1:3))
                res%eulang = rv2eu(orient(1:3))
                res%om = rv2om(orient(1:3))
                res%quat = rv2qu(orient(1:3))
                res%axang = rv2ax(orient(1:3))
                res%rodrigues = rv2ro(orient(1:3))

end select

end function init_orientation

!--------------------------------------------------------------------------
!
! Function: init_orientation_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief take an orientation representation with 3 components and init all others (double precision)
!
!> @param orient 3-component vector (double precision)
!> @param intype input type ['eu', 'ro', 'ho', 'cu']
!> @param rotcheck  optional parameter to enforce strict range checking
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 9/30/14   MDG 1.1 added testing of valid ranges
!--------------------------------------------------------------------------
recursive function init_orientation_d(orient,intype,rotcheck) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: init_orientation_d

use local
use error
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: orient(*)            ! 3-component orientation descriptor
character(2),INTENT(IN)         :: intype               ! describes input type
logical,INTENT(IN),OPTIONAL     :: rotcheck             ! check valid range if present

type(orientationtyped)          :: res
integer(kind=irg)               :: i

select case (intype)
        case ('eu')     ! Euler angles
                ! verify the Euler angle ranges; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = eu_check_d(orient)
                endif
                res%eulang = orient(1:3)
                res%om = eu2om_d(orient(1:3))
                res%quat = eu2qu_d(orient(1:3))
                res%rodrigues = eu2ro_d(orient(1:3))
                res%axang = eu2ax_d(orient(1:3))
                res%homochoric = eu2ho_d(orient(1:3))
                res%cubochoric = eu2cu_d(orient(1:3))
                res%stereographic = eu2st_d(orient(1:3))
                res%rvmap = eu2rv_d(orient(1:3))
        case ('ro')     ! Rodrigues vector
                ! verify the Rodrigues-Frank vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = ro_check_d(orient)
                endif
                res%rodrigues = orient(1:4)
                res%eulang = ro2eu_d(orient(1:4))
                res%om = ro2om_d(orient(1:4))
                res%quat = ro2qu_d(orient(1:4))
                res%axang = ro2ax_d(orient(1:4))
                res%homochoric = ro2ho_d(orient(1:4))
                res%cubochoric = ro2cu_d(orient(1:4))
                res%stereographic = ro2st_d(orient(1:4))
                res%rvmap = ro2rv_d(orient(1:4))
        case ('ho')     ! homochoric
                ! verify the homochoric vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = ho_check_d(orient)
                endif
                res%homochoric = orient(1:3)
                res%axang = ho2ax_d(orient(1:3))
                res%om = ho2om_d(orient(1:3))
                res%eulang = ho2eu_d(orient(1:3))
                res%rodrigues = ho2ro_d(orient(1:3))
                res%quat = ho2qu_d(orient(1:3))
                res%cubochoric = ho2cu_d(orient(1:3))
                res%stereographic = ho2st_d(orient(1:3))
                res%rvmap = ho2rv_d(orient(1:4))
        case ('cu')     ! cubochoric
                ! verify the cubochoric vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = cu_check_d(orient)
                endif
                res%cubochoric = orient(1:3)
                res%homochoric = cu2ho_d(orient(1:3))
                res%eulang = cu2eu_d(orient(1:3))
                res%om = cu2om_d(orient(1:3))
                res%quat = cu2qu_d(orient(1:3))
                res%axang = cu2ax_d(orient(1:3))
                res%rodrigues = cu2ro_d(orient(1:3))
                res%stereographic = cu2st_d(orient(1:3))
                res%rvmap = cu2rv_d(orient(1:3))
        case ('st')     ! stereographic
                ! verify the cstereographic vector; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = st_check_d(orient)
                endif
                res%stereographic = orient(1:3)
                res%cubochoric = st2cu_d(orient(1:3))
                res%homochoric = st2ho_d(orient(1:3))
                res%eulang = st2eu_d(orient(1:3))
                res%om = st2om_d(orient(1:3))
                res%quat = st2qu_d(orient(1:3))
                res%axang = st2ax_d(orient(1:3))
                res%rodrigues = st2ro_d(orient(1:3))
                res%rvmap = st2rv_d(orient(1:3))
        case ('qu')     ! quaternion
                ! verify the quaternion; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = qu_check_d(orient)
                endif
                res%quat = orient(1:4)
                res%eulang = qu2eu_d(orient(1:4))
                res%om = qu2om_d(orient(1:4))
                res%rodrigues = qu2ro_d(orient(1:4))
                res%axang = qu2ax_d(orient(1:4))
                res%homochoric = qu2ho_d(orient(1:4))
                res%cubochoric = qu2cu_d(orient(1:4))
                res%stereographic = qu2st(orient(1:4))
                res%rvmap = qu2rv_d(orient(1:4))
        case ('ax')     ! axis angle pair
                ! verify the axis angle pair; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = ax_check_d(orient)
                endif
                res%axang = orient(1:4)
                res%om = ax2om_d(orient(1:4))
                res%eulang = ax2eu_d(orient(1:4))
                res%rodrigues = ax2ro_d(orient(1:4))
                res%quat = ax2qu_d(orient(1:4))
                res%homochoric = ax2ho_d(orient(1:4))
                res%cubochoric = ax2cu_d(orient(1:4))
                res%stereographic = ax2st_d(orient(1:4))
                res%rvmap = ax2rv_d(orient(1:4))
        case('rv')      ! rotation vector map
                ! verify the rotation vector map; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = qu_check(orient)
                endif
                res%rvmap = orient(1:3)
                res%stereographic = rv2st_d(orient(1:3))
                res%cubochoric = rv2cu_d(orient(1:3))
                res%homochoric = rv2ho_d(orient(1:3))
                res%eulang = rv2eu_d(orient(1:3))
                res%om = rv2om_d(orient(1:3))
                res%quat = rv2qu_d(orient(1:3))
                res%axang = rv2ax_d(orient(1:3))
                res%rodrigues = rv2ro_d(orient(1:3))
end select

end function init_orientation_d

!--------------------------------------------------------------------------
!
! Function: init_orientation_om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief take an orientation representation with 3x3 components and init all others (single precision)
!
!> @param orient r-component vector (single precision)
!> @param intype input type ['om']
!> @param rotcheck  optional parameter to enforce strict range checking
!>
!
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function init_orientation_om(orient,intype,rotcheck) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: init_orientation_om

use local

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: orient(3,3)          ! 3x3-component orientation descriptor
character(2),INTENT(IN)         :: intype               ! describes input type
logical,INTENT(IN),OPTIONAL     :: rotcheck             ! check valid range if present

type(orientationtype)           :: res
integer(kind=irg)               :: i

select case (intype)
        case ('om')     ! orientation matrix
                ! verify the rotation matrix; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = om_check(orient)
                endif
                res%om = orient
                res%quat = om2qu(orient)
                res%eulang = om2eu(orient)
                res%rodrigues = om2ro(orient)
                res%axang = om2ax(orient)
                res%homochoric = om2ho(orient)
                res%stereographic = om2st(orient)
                res%cubochoric = om2cu(orient)
                res%rvmap = om2rv(orient)
end select

end function init_orientation_om

!--------------------------------------------------------------------------
!
! Function: init_orientation_om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief take an orientation representation with 3x3 components and init all others (double precision)
!
!> @param orient r-component vector (double precision)
!> @param intype input type ['om']
!> @param rotcheck  optional parameter to enforce strict range checking
!>
!
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function init_orientation_om_d(orient,intype,rotcheck) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: init_orientation_om_d

use local

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: orient(3,3)          ! 3x3-component orientation descriptor
character(2),INTENT(IN)         :: intype               ! describes input type
logical,INTENT(IN),OPTIONAL     :: rotcheck             ! check valid range if present

type(orientationtyped)          :: res
integer(kind=irg)               :: i

select case (intype)
        case ('om')     ! orientation matrix
                ! verify the rotation matrix; this will abort program if values are outside range
                if (present(rotcheck)) then
                        if (rotcheck.eqv..TRUE.) i = om_check_d(orient)
                endif
                res%om = orient
                res%quat = om2qu_d(orient)
                res%eulang = om2eu_d(orient)
                res%rodrigues = om2ro_d(orient)
                res%axang = om2ax_d(orient)
                res%homochoric = om2ho_d(orient)
                res%stereographic = om2st_d(orient)
                res%cubochoric = om2cu_d(orient)
                res%rvmap = om2rv_d(orient)
end select

end function init_orientation_om_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! here we start with a series of conversion routines between representations
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! Function: eu2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Euler angles to orientation matrix (single precision) [Morawiec, page 28]
!
!> @param e 3 Euler angles in radians (single precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @data 7/23/14   MDG 1.1 verified
!--------------------------------------------------------------------------
recursive function eu2om(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2om

use local

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< Euler angles in radians
real(kind=sgl)                  :: res(3,3)     !< output orientation matrix

real(kind=sgl)                  :: c1, c2, c3, s1, s2, s3
integer(kind=irg)               :: i,j
real(kind=sgl),parameter        :: thr = 1.0E-8

c1 = cos(e(1))
c2 = cos(e(2))
c3 = cos(e(3))
s1 = sin(e(1))
s2 = sin(e(2))
s3 = sin(e(3))

res(1,1) = c1*c3-s1*s3*c2
res(1,2) = s1*c3+c1*s3*c2
res(1,3) = s3*s2
res(2,1) = -c1*s3-s1*c3*c2
res(2,2) = -s1*s3+c1*c3*c2
res(2,3) = c3*s2
res(3,1) = s1*s2
res(3,2) = -c1*s2
res(3,3) = c2

do i=1,3
  do j=1,3
    if (abs(res(i,j)).lt.thr) res(i,j) = 0.0
  end do
end do

end function eu2om

!--------------------------------------------------------------------------
!
! Function: eu2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Euler angles to orientation matrix (double precision) [Morawiec, page 28]
!
!> @param e 3 Euler angles in radians (double precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @data 7/23/14   MDG 1.1 verified
!--------------------------------------------------------------------------
recursive function eu2om_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2om_d

use local

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< Euler angles in radians
real(kind=dbl)                  :: res(3,3)     !< output orientation matrix

real(kind=dbl)                  :: c1, c2, c3, s1, s2, s3
integer(kind=irg)               :: i,j
real(kind=dbl),parameter        :: thr = 1.0D-10

c1 = dcos(e(1))
c2 = dcos(e(2))
c3 = dcos(e(3))
s1 = dsin(e(1))
s2 = dsin(e(2))
s3 = dsin(e(3))

res(1,1) = c1*c3-s1*s3*c2
res(1,2) = s1*c3+c1*s3*c2
res(1,3) = s3*s2
res(2,1) = -c1*s3-s1*c3*c2
res(2,2) = -s1*s3+c1*c3*c2
res(2,3) = c3*s2
res(3,1) = s1*s2
res(3,2) = -c1*s2
res(3,3) = c2

do i=1,3
  do j=1,3
    if (dabs(res(i,j)).lt.thr) res(i,j) = 0.D0
  end do
end do

end function eu2om_d

!--------------------------------------------------------------------------
!
! FUNCTION: eu2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert euler to axis angle
!
!> @param e 3 euler angles (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 explicit implementation
!> @date 7/23/14   MDG 2.1 exception for zero rotation angle
!> @date 9/23/15   MDG 2.2 moved alphe.lt.0 test inside else statement
!--------------------------------------------------------------------------
recursive function eu2ax(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2ax

use local
use constants

real(kind=sgl), INTENT(IN)              :: e(3)
real(kind=sgl)                          :: res(4), t, del, tau, alpha, sig
real(kind=dbl),parameter                :: thr = 1.0E-6

t = tan(e(2)*0.5)
sig = 0.5*(e(1)+e(3))
del = 0.5*(e(1)-e(3))
tau = sqrt(t*t+sin(sig)**2)

if (close_enough(sig,sngl(cPi)*0.5)) then  ! Infinity
  alpha = sngl(cPi)
else
  alpha = 2.0 * atan(tau/cos(sig))
end if

if (abs(alpha).lt.thr) then
! return a default identity axis-angle pair
        res = (/ 0.0, 0.0, 1.0, 0.0 /)
else
! passive axis-angle pair so a minus sign in front
        res(1:3) = - epsijk * (/ t*cos(del), t*sin(del), sin(sig) /) / tau
        res(4) = alpha

! make sure alpha is positive
        if (alpha.lt.0.0) res = -res
end if

end function eu2ax

!--------------------------------------------------------------------------
!
! FUNCTION: eu2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert euler to axis angle
!
!> @param e 3 euler angles (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 1.1 exception for zero rotation angle
!> @date 9/23/15   MDG 2.2 moved alphe.lt.0 test inside else statement
!--------------------------------------------------------------------------
recursive function eu2ax_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2ax_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: e(3)
real(kind=dbl)                          :: res(4), del, t, tau, alpha, sig
real(kind=dbl),parameter                :: thr = 1.0D-10

t = dtan(e(2)*0.5D0)
sig = 0.5D0*(e(1)+e(3))
del = 0.5D0*(e(1)-e(3))
tau = dsqrt(t*t+dsin(sig)**2)

if (close_enough(sig,cPi*0.5D0)) then  ! Infinity
  alpha = cPi
else
  alpha = 2.D0 * datan(tau/dcos(sig))
end if

if (abs(alpha).lt.thr) then
! return a default identity axis-angle pair
        res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
else
! passive axis-angle pair so a minus sign in front
        res(1:3) = - epsijkd *(/ t*dcos(del), t*dsin(del), dsin(sig) /) / tau
        res(4) = alpha

! make sure alpha is positive
        if (alpha.lt.0.D0) res = -res
end if

end function eu2ax_d

!--------------------------------------------------------------------------
!
! Function: eu2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Euler angles to Rodrigues vector (single precision) [Morawiec, page 40]
!
!> @param e 3 Euler angles in radians (single precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2ro(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2ro

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input Euler angles (radians)
real(kind=sgl)                  :: res(4)       !< output Rodrigues vector

real(kind=sgl)                  :: t
real(kind=sgl),parameter        :: thr = 1.0E-7

! first go to the axis-angle representation
res = eu2ax(e)

! then adjust the fourth component to be tan(omega/2)
t = res(4)
if (abs(t-sngl(cPi)).lt.thr) then
  res(4) = infty()
  return
end if

if (close_enough(t,0.0)) then
  res = (/ 0.0, 0.0, epsijk, 0.0 /)
else
  res(4) = tan(t*0.5)
end if

end function eu2ro

!--------------------------------------------------------------------------
!
! Function: eu2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Euler angles to Rodrigues vector (double precision) [Morawiec, page 40]
!
!> @param e 3 Euler angles in radians (double precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2ro_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2ro_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input Euler angles (radians)
real(kind=dbl)                  :: res(4)       !< output Rodrigues vector

real(kind=dbl)                  :: t
real(kind=sgl),parameter        :: thr = 1.0D-10

! first go to the axis-angle representation
res = eu2ax_d(e)

! then adjust the fourth component to be tan(omega/2)
t = res(4)
if (abs(t-cPi).lt.thr) then
  res(4) = inftyd()
  return
end if

if (close_enough(t,0.D0)) then
  res = (/ 0.D0, 0.D0, epsijkd, 0.D0 /)
else
  res(4) = dtan(t*0.5D0)
end if

end function eu2ro_d

!--------------------------------------------------------------------------
!
! Function: eu2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Euler angles to quaternion (single precision) [Morawiec, page 40]
!
!> @note verified 8/5/13
!
!> @param e 3 Euler angles in radians (single precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 8/07/14   MDG 1.1 verified
!--------------------------------------------------------------------------
recursive function eu2qu(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2qu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input Euler angles in radians
real(kind=sgl)                  :: res(4)       !< output quaternion

real(kind=sgl)                  :: ee(3), cPhi, cp, cm, sPhi, sp, sm

ee = 0.5*e

cPhi = cos(ee(2))
sPhi = sin(ee(2))
cm = cos(ee(1)-ee(3))
sm = sin(ee(1)-ee(3))
cp = cos(ee(1)+ee(3))
sp = sin(ee(1)+ee(3))

! passive quaternion
res = (/ cPhi*cp, -epsijk*sPhi*cm, -epsijk*sPhi*sm, -epsijk*cPhi*sp /)

! first component must be positive
if (res(1).lt.0.0) res = -res

end function eu2qu

!--------------------------------------------------------------------------
!
! Function: eu2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Euler angles to quaternion (double precision) [Morawiec, page 40]
!
!> @note verified 8/5/13
!
!> @param e 3 Euler angles in radians (double precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 8/07/14   MDG 1.1 verified
!--------------------------------------------------------------------------
recursive function eu2qu_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2qu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input Euler angles in radians
real(kind=dbl)                  :: res(4)       !< output quaternion

real(kind=dbl)                  :: ee(3), cPhi, cp, cm, sPhi, sp, sm

ee = 0.5D0*e

cPhi = dcos(ee(2))
sPhi = dsin(ee(2))
cm = dcos(ee(1)-ee(3))
sm = dsin(ee(1)-ee(3))
cp = dcos(ee(1)+ee(3))
sp = dsin(ee(1)+ee(3))

! passive quaternion
res = (/ cPhi*cp, -epsijkd*sPhi*cm, -epsijkd*sPhi*sm, -epsijkd*cPhi*sp /)

! first component must be positive
if (res(1).lt.0.D0) res = -res

end function eu2qu_d

!--------------------------------------------------------------------------
!
! Function: om2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief orientation matrix to euler angles (single precision)
!
!> @note verified 8/19/14 using Mathematica
!
!> @param o orientation matrix (single precision)
!
!> @date 8/04/13   MDG 1.0 original
!> @date 8/19/14   MDG 1.1 verification using Mathematica
!--------------------------------------------------------------------------
recursive function om2eu(o) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2eu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: o(3,3)               !< orientation matrix
real(kind=sgl)                  :: res(3), zeta
real(kind=dbl),parameter        :: thr = 1.0D-6

if (.not.close_enough(abs(o(3,3)),1.0)) then
        res(2) = acos(o(3,3))
        zeta = 1.0/sqrt(1.0-o(3,3)**2)
        res(1) = atan2(o(3,1)*zeta,-o(3,2)*zeta)
        res(3) = atan2(o(1,3)*zeta, o(2,3)*zeta)
else
! we arbitrarily assign the entire angle to phi_1
        if (close_enough(o(3,3),1.0)) then
                res(1) = atan2( o(1,2),o(1,1))
                res(2) = 0.0
                res(3) = 0.0
        else
                res(1) =-atan2(-o(1,2),o(1,1))
                res(2) = sngl(cPi)
                res(3) = 0.0
        end if
end if

! reduce Euler angles to definition ranges (and positive values only)
if (res(1).lt.0.0) res(1) = mod(res(1)+100.0*sngl(cPi),2.0*sngl(cPi))
if (res(2).lt.0.0) res(2) = mod(res(2)+100.0*sngl(cPi),sngl(cPi))
if (res(3).lt.0.0) res(3) = mod(res(3)+100.0*sngl(cPi),2.0*sngl(cPi))

end function om2eu

!--------------------------------------------------------------------------
!
! Function: om2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief orientation matrix to euler angles (double precision)
!
!> @note verified 8/19/14 using Mathematica
!
!> @param o orientation matrix (double precision)
!
!> @date 8/04/13   MDG 1.0 original
!> @date 8/19/14   MDG 1.1 verification using Mathematica
!--------------------------------------------------------------------------
recursive function om2eu_d(o) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2eu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: o(3,3)               !< orientation matrix
real(kind=dbl)                  :: res(3), zeta
real(kind=dbl),parameter        :: thr = 1.0D-8

if (.not.close_enough(dabs(o(3,3)),1.D0)) then
        res(2) = dacos(o(3,3))
        zeta = 1.D0/dsqrt(1.D0-o(3,3)**2)
        res(1) = datan2(o(3,1)*zeta,-o(3,2)*zeta)
        res(3) = datan2(o(1,3)*zeta, o(2,3)*zeta)
else
! we arbitrarily assign the entire angle to phi_1
        if (close_enough(o(3,3),1.D0)) then
                res(1) = datan2( o(1,2),o(1,1))
                res(2) = 0.D0
                res(3) = 0.D0
        else
                res(1) =-datan2(-o(1,2),o(1,1))
                res(2) = cPi
                res(3) = 0.D0
        end if
end if

! reduce Euler angles to definition ranges (and positive values only)
if (res(1).lt.0.D0) res(1) = dmod(res(1)+100.D0*cPi,2.D0*cPi)
if (res(2).lt.0.D0) res(2) = dmod(res(2)+100.D0*cPi,cPi)
if (res(3).lt.0.D0) res(3) = dmod(res(3)+100.D0*cPi,2.D0*cPi)

end function om2eu_d

!--------------------------------------------------------------------------
!
! Function: ax2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Axis angle pair to orientation matrix (single precision)
!
!> @note verified 8/5/13.
!
!> @param a axis angle pair (single precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2om(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2om

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: a(4)         !< axis angle pair
real(kind=sgl)                  :: res(3,3)

real(kind=sgl)                  :: q, c, s, omc
integer(kind=irg)               :: i

c = cos(a(4))
s = sin(a(4))
omc = 1.0-c

do i=1,3
  res(i,i) = a(i)**2*omc + c
end do

q = omc*a(1)*a(2)
res(1,2) = q + s*a(3)
res(2,1) = q - s*a(3)

q = omc*a(2)*a(3)
res(2,3) = q + s*a(1)
res(3,2) = q - s*a(1)

q = omc*a(3)*a(1)
res(3,1) = q + s*a(2)
res(1,3) = q - s*a(2)

if (epsijk.eq.1.0) res = transpose(res)

end function ax2om

!--------------------------------------------------------------------------
!
! Function: ax2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Axis angle pair to orientation matrix (double precision)
!
!> @note verified 8/5/13.
!
!> @param a axis angle pair (double precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2om_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2om_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: a(4)         !< axis angle pair
real(kind=dbl)                  :: res(3,3)

real(kind=dbl)                  :: q, c, s, omc
integer(kind=irg)               :: i

c = dcos(a(4))
s = dsin(a(4))
omc = 1.D0-c

do i=1,3
  res(i,i) = a(i)**2*omc + c
end do

q = omc*a(1)*a(2)
res(1,2) = q + s*a(3)
res(2,1) = q - s*a(3)

q = omc*a(2)*a(3)
res(2,3) = q + s*a(1)
res(3,2) = q - s*a(1)

q = omc*a(3)*a(1)
res(3,1) = q + s*a(2)
res(1,3) = q - s*a(2)

if (epsijkd.eq.1.D0) res = transpose(res)

end function ax2om_d

!--------------------------------------------------------------------------
!
! Function: qu2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Quaternion to Euler angles (single precision) [Morawiec page 40, with errata !!!! ]
!
!> @param q quaternion (single precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 4/17/15   MDG 1.1 simplification based on M. Jackson question
!--------------------------------------------------------------------------
recursive function qu2eu(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2eu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: q(4)         !< quaternion
real(kind=sgl)                  :: res(3)

real(kind=sgl)                  :: qq(4), q12, q03, chi, Phi, phi1, phi2

qq = q

q03 = qq(1)**2+qq(4)**2
q12 = qq(2)**2+qq(3)**2
chi = sqrt(q03*q12)

if (close_enough(chi,0.0)) then
  if (close_enough(q12,0.0)) then
    Phi = 0.0
    phi2 = 0.0                  ! arbitrarily due to degeneracy
    phi1 = atan2(-epsijk*2.0*qq(1)*qq(4),qq(1)**2-qq(4)**2)
  else
    Phi = sngl(cPi)
    phi2 = 0.0                  ! arbitrarily due to degeneracy
    phi1 = atan2(2.0*qq(2)*qq(3),qq(2)**2-qq(3)**2)
  end if
else            ! this is not a special degenerate case
    Phi = atan2( 2.0*chi, q03-q12 )
    chi = 1.0/chi
    phi1 = atan2( (-epsijk*qq(1)*qq(3)+qq(2)*qq(4))*chi, (-epsijk*qq(1)*qq(2)-qq(3)*qq(4))*chi )
    phi2 = atan2( (epsijk*qq(1)*qq(3)+qq(2)*qq(4))*chi, (-epsijk*qq(1)*qq(2)+qq(3)*qq(4))*chi )
end if

res = (/ phi1, Phi, phi2 /)

! reduce Euler angles to definition ranges (and positive values only)
if (res(1).lt.0.0) res(1) = mod(res(1)+100.0*sngl(cPi),2.0*sngl(cPi))
if (res(2).lt.0.0) res(2) = mod(res(2)+100.0*sngl(cPi),sngl(cPi))
if (res(3).lt.0.0) res(3) = mod(res(3)+100.0*sngl(cPi),2.0*sngl(cPi))

end function qu2eu

!--------------------------------------------------------------------------
!
! Function: qu2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Quaternion to Euler angles (double precision) [Morawiec page 40, with errata !!!! ]
!
!> @param q quaternion (double precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 4/17/15   MDG 1.1 simplification based on M. Jackson question
!--------------------------------------------------------------------------
recursive function qu2eu_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2eu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: q(4)         !< quaternion
real(kind=dbl)                  :: res(3)

real(kind=dbl)                  :: qq(4), q12, q03, chi, Phi, phi1, phi2

qq = q

q03 = qq(1)**2+qq(4)**2
q12 = qq(2)**2+qq(3)**2
chi = dsqrt(q03*q12)

if (close_enough(chi,0.D0)) then
  if (close_enough(q12,0.D0)) then
    Phi = 0.D0
    phi2 = 0.D0                  ! arbitrarily due to degeneracy
    phi1 = datan2(-epsijk*2.D0*qq(1)*qq(4),qq(1)**2-qq(4)**2)
  else
    Phi = cPi
    phi2 = 0.D0                  ! arbitrarily due to degeneracy
    phi1 = datan2(2.D0*qq(2)*qq(3),qq(2)**2-qq(3)**2)
  end if
else            ! this is not a special degenerate case
    Phi = datan2( 2.D0*chi, q03-q12 )
    chi = 1.D0/chi
    phi1 = datan2( (-epsijk*qq(1)*qq(3)+qq(2)*qq(4))*chi, (-epsijk*qq(1)*qq(2)-qq(3)*qq(4))*chi )
    phi2 = datan2( (epsijk*qq(1)*qq(3)+qq(2)*qq(4))*chi, (-epsijk*qq(1)*qq(2)+qq(3)*qq(4))*chi )
end if

res = (/ phi1, Phi, phi2 /)

! reduce Euler angles to definition ranges (and positive values only)
if (res(1).lt.0.D0) res(1) = dmod(res(1)+100.D0*cPi,2.D0*cPi)
if (res(2).lt.0.D0) res(2) = dmod(res(2)+100.D0*cPi,cPi)
if (res(3).lt.0.D0) res(3) = dmod(res(3)+100.D0*cPi,2.D0*cPi)

end function qu2eu_d

!--------------------------------------------------------------------------
!
! Function: ax2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Axis angle pair to homochoric (single precision)
!
!> @param a axis-angle pair (single precision)
!>
! !
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2ho(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2ho

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: a(4)         !< axis angle pair
real(kind=sgl)                  :: res(3)

real(kind=sgl)                  :: f

! a(4) must be in [0,pi] !

f = 0.75 * ( a(4) - sin(a(4)) )
f = f**(1.0/3.0)

res = a(1:3) * f

end function ax2ho

!--------------------------------------------------------------------------
!
! Function: ax2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Axis angle pair to homochoric (double precision)
!
!> @param a axis-angle pair (double precision)
!>
! !
!> @date 8/04/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2ho_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2ho_d

use local

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: a(4)         !< axis angle pair
real(kind=dbl)                  :: res(3)

real(kind=dbl)                  :: f

! a(4) must be in [0,pi] !

f = 0.75D0 * ( a(4) - dsin(a(4)) )
f = f**(1.D0/3.D0)

res = a(1:3) * f

end function ax2ho_d

!--------------------------------------------------------------------------
!
! Function: ho2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Homochoric to axis angle pair (single precision)
!
!> @param h homochoric coordinates (single precision)
!>
!
!
!> @date 08/04/13 MDG 1.0 original
!> @date 07/21/14 MDG 1.1 double precision fit coefficients
!> @date 03/28/16 MDG 1.2 increased order of fit coefficients
!--------------------------------------------------------------------------
recursive function ho2ax(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2ax

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: h(3)         !< homochoric coordinates
real(kind=sgl)                  :: res(4)

integer(kind=irg)               :: i
real(kind=sgl)                  :: hn(3), hmag, s, hm, sPi
real(kind=sgl),parameter        :: thr = 1.0E-6

sPi = sngl(cPi)

! normalize h and store the magnitude
hmag = sum(h*h)
if (close_enough(hmag,0.0)) then
  res = (/ 0.0, 0.0, 1.0, 0.0 /)
else
  hm = hmag
  hn = h/sqrt(hmag)

! convert the magnitude to the rotation angle
  s = LPs%tfit(1) + LPs%tfit(2) * hmag
! do i=3,16
  do i=3,21
    hm = hm*hmag
    s = s + LPS%tfit(i) * hm
  end do

  s = 2.0*acos(s)
  if (abs(s-sngl(cPi)).lt.thr) then
   res = (/ hn(1), hn(2), hn(3), sPi /)
  else
   res = (/ hn(1), hn(2), hn(3), s /)
  end if
end if

end function ho2ax

!--------------------------------------------------------------------------
!
! Function: ho2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Homochoric to axis angle pair (double precision)
!
!> @param h homochoric coordinates (double precision)
!>
!
!> @date 08/04/13 MDG 1.0 original
!> @date 07/21/14 MDG 1.1 double precision fit coefficients
!> @date 03/28/16 MDG 1.2 increased order of fit coefficients
!--------------------------------------------------------------------------
recursive function ho2ax_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2ax_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: h(3)         !< homochoric coordinates
real(kind=dbl)                  :: res(4)

integer(kind=irg)               :: i
real(kind=dbl)                  :: hn(3), hmag, s, hm
real(kind=dbl),parameter        :: thr = 1.0E-8

! normalize h and store the magnitude
hmag = sum(h*h)
if (close_enough(hmag,0.D0)) then
  res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
else
  hm = hmag
  hn = h/dsqrt(hmag)

! convert the magnitude to the rotation angle
  s = LPs%tfit(1) + LPs%tfit(2) * hmag
! do i=3,16
  do i=3,21
    hm = hm*hmag
    s = s + LPS%tfit(i) * hm
  end do

  s = 2.D0*dacos(s)
  if (dabs(s-cPi).lt.thr) then
   res = (/ hn(1), hn(2), hn(3), cPi /)
  else
   res = (/ hn(1), hn(2), hn(3), s /)
  end if
end if

end function ho2ax_d

!--------------------------------------------------------------------------
!
! FUNCTION: om2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to axis angle
!
!> @details this assumes that the matrix represents a passive rotation.
!
!> @param om 3x3 orientation matrix (single precision)
!>
!
!> @date 8/12/13  MDG 1.0 original
!> @date 07/08/14 MDG 2.0 replaced by direct solution
!> @date 09/28/15 MDG 2.1 corrected dgeev -> sgeev
!> @date 10/25/17 MDG 2.2 corrected issue in which the WORK space was too small
!--------------------------------------------------------------------------
recursive function om2ax(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2ax

use local
use constants
use error
use io

real(kind=sgl), INTENT(IN)              :: om(3,3)
real(kind=sgl)                          :: res(4)

real(kind=sgl)                          :: t, omega, qq(4), o(3,3)
real(kind=sgl)                          :: VL(3,3), VR(3,3), Wr(3), Wi(3), WORK(20)
complex(kind=sgl)                       :: ev
complex(kind=sgl),parameter             :: cone = cmplx(1.0,0.0)
real(kind=sgl),parameter                :: thr = 1.0E-6
integer(kind=irg)                       :: nn, LDA, LDVL, LDVR, INFO, LWORK
character(1)                            :: JOBVL, JOBVR

 o = om

! first get the rotation angle
 t = 0.50*(om(1,1)+om(2,2)+om(3,3) - 1.0)
 if (t.gt.1.0) t = 1.0
 if (t.lt.-1.0) t = -1.0
 res(4) = acos(t)

if (close_enough(res(4),0.0)) then
  res(1:3) = (/ 0.0, 0.0, 1.0 /)
  return
else
! set some initial LAPACK variables
 nn = 3
 LDA = nn
 LDVL = nn
 LDVR = nn
 INFO = 0

! first initialize the parameters for the LAPACK DGEEV routines
 JOBVL = 'N'   ! do not compute the left eigenvectors
 JOBVR = 'V'   ! do compute the right eigenvectors
 LWORK = 20

!     SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
!    $                  LDVR, WORK, LWORK, INFO )

! call the eigenvalue solver
  call sgeev(JOBVL,JOBVR,nn,o,LDA,Wr,Wi,VL,LDVL,VR,LDVR,WORK,LWORK,INFO)
  if (INFO.ne.0) call FatalError('Error in om2ax/sgeev : ','SGEEV return not zero')

! next, find the eigenvalue cmplx(1,0)
  do i=1,3
    ev = cmplx(Wr(i),Wi(i))
    if (abs(ev-cone).lt.thr) then
      res(1:3) = VR(1:3,i)
      if ((om(2,3)-om(3,2)).ne.0.D0) res(1) = sign(res(1),-epsijk*(om(2,3)-om(3,2)))
      if ((om(3,1)-om(1,3)).ne.0.D0) res(2) = sign(res(2),-epsijk*(om(3,1)-om(1,3)))
      if ((om(1,2)-om(2,1)).ne.0.D0) res(3) = sign(res(3),-epsijk*(om(1,2)-om(2,1)))
      return
    end if
  end do
end if

end function om2ax

!--------------------------------------------------------------------------
!
! FUNCTION: om2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to axis angle
!
!> @param om 3x3 orientation matrix (double precision)
!>
!
!> @date 8/12/13  MDG 1.0 original
!> @date 07/08/14 MDG 2.0 replaced by direct solution
!> @date 08/20/14 MDG 3.0 replaced by eigenvalue-based method
!> @date 10/25/17 MDG 3.1 corrected issue in which the WORK space was too small
!--------------------------------------------------------------------------
recursive function om2ax_d(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2ax_d

use local
use constants
use error
use io

real(kind=dbl), INTENT(IN)              :: om(3,3)
real(kind=dbl)                          :: res(4)

real(kind=dbl)                          :: t, omega, qq(4), o(3,3)
real(kind=dbl)                          :: VL(3,3), VR(3,3), Wr(3), Wi(3), WORK(20)
complex(kind=dbl)                       :: ev
complex(kind=dbl),parameter             :: cone = cmplx(1.D0,0.D0)
real(kind=dbl),parameter                :: thr = 1.0D-14
integer(kind=irg)                       :: nn, LDA, LDVL, LDVR, INFO, LWORK
character(1)                            :: JOBVL, JOBVR

 o = om

! first get the rotation angle
 t = 0.5D0*(om(1,1)+om(2,2)+om(3,3) - 1.D0)
 if (t.gt.1.D0) t = 1.D0
 if (t.lt.-1.D0) t = -1.D0
 res(4) = dacos(t)

if (close_enough(res(4),0.D0)) then
  res(1:3) = (/ 0.D0, 0.D0, 1.D0 /)
  return
else
! set some initial LAPACK variables
 nn = 3
 LDA = nn
 LDVL = nn
 LDVR = nn
 INFO = 0

! first initialize the parameters for the LAPACK DGEEV routines
 JOBVL = 'N'   ! do not compute the left eigenvectors
 JOBVR = 'V'   ! do compute the right eigenvectors
 LWORK = 20

!     SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
!    $                  LDVR, WORK, LWORK, INFO )

! call the eigenvalue solver
  call dgeev(JOBVL,JOBVR,nn,o,LDA,Wr,Wi,VL,LDVL,VR,LDVR,WORK,LWORK,INFO)
  if (INFO.ne.0) call FatalError('Error in om2ax/dgeev : ','DGEEV return not zero')

! next, find the eigenvalue cmplx(1,0)
 do i=1,3
    if ((abs(Wr(i)-1.D0).lt.thr).and.(abs(Wi(i)).lt.thr)) then
      res(1:3) = VR(1:3,i)
      if ((om(2,3)-om(3,2)).ne.0.D0) res(1) = dsign(res(1),-epsijkd*(om(2,3)-om(3,2)))
      if ((om(3,1)-om(1,3)).ne.0.D0) res(2) = dsign(res(2),-epsijkd*(om(3,1)-om(1,3)))
      if ((om(1,2)-om(2,1)).ne.0.D0) res(3) = dsign(res(3),-epsijkd*(om(1,2)-om(2,1)))
      return
    end if
  end do
end if

end function om2ax_d

!--------------------------------------------------------------------------
!
! Function: ro2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Rodrigues vector to axis angle pair (single precision)
!
!> @param r Rodrigues vector (single precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 8/11/14   MDG 1.1 added infty handling
!--------------------------------------------------------------------------
recursive function ro2ax(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2ax

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: r(4)         !< input Rodrigues vector
real(kind=sgl)                  :: res(4)       !< output axis-angle pair

real(kind=sgl)                  :: ta, angle, sPi

ta = r(4)
sPi = sngl(cPi)

if (close_enough(ta,0.0)) then
  res = (/ 0.0, 0.0, 1.0, 0.0 /)
  return
end if

if (ta.eq.infty()) then
  res = (/ r(1), r(2), r(3), sPi /)
else
  angle = 2.0*atan(ta)
  ta = 1.0/sqrt(sum(r(1:3)*r(1:3)))
  res = (/ r(1)*ta, r(2)*ta, r(3)*ta, angle /)
end if

end function ro2ax

!--------------------------------------------------------------------------
!
! Function: ro2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Rodrigues vector to axis angle pair (double precision)
!
!> @param r Rodrigues vector (double precision)
!>
!
!> @date 8/04/13   MDG 1.0 original
!> @date 8/11/14   MDG 1.1 added infty handling
!--------------------------------------------------------------------------
recursive function ro2ax_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2ax_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: r(4)         !< input Rodrigues vector
real(kind=dbl)                  :: res(4)       !< output axis-angle pair

real(kind=dbl)                  :: ta, angle

ta = r(4)

if (close_enough(ta,0.D0)) then
  res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
  return
end if

if (ta.eq.inftyd()) then
  res = (/ r(1), r(2), r(3), cPi /)
else
  angle = 2.D0*datan(ta)
  ta = 1.D0/dsqrt(sum(r(1:3)*r(1:3)))
  res = (/ r(1)*ta, r(2)*ta, r(3)*ta, angle /)
end if

end function ro2ax_d

!--------------------------------------------------------------------------
!
! FUNCTION: ax2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to Rodrigues
!
!> @param a axis angle pair (single precision)
!>
!
!> @date 8/12/13 MDG 1.0 original
!> @date 7/6/14  MDG 2.0 simplified
!> @date 8/11/14 MDG 2.1 added infty handling
!--------------------------------------------------------------------------
recursive function ax2ro(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2ro

use local
use constants

real(kind=sgl), INTENT(IN)              :: a(4)
real(kind=sgl)                          :: res(4)

real(kind=sgl)                          :: t
real(kind=sgl),parameter                :: thr = 1.0E-7

if (close_enough(a(4),0.0)) then
  res = (/ 0.0, 0.0, epsijk, 0.0 /)
  return
end if

res(1:3) =  a(1:3)

! we need to deal with the 180 degree case
if (abs(a(4)-sngl(cPi)).lt.thr) then
!if (close_enough(abs(a(4)-sngl(cPi)),0.0)) then
  res(4) = infty()
else
  res(4) = tan( a(4) * 0.5 )
end if

end function ax2ro

!--------------------------------------------------------------------------
!
! FUNCTION: ax2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to Rodrigues
!
!> @param a axis angle pair (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/6/14  MDG 2.0 simplified
!> @date 8/11/14 MDG 2.1 added infty handling
!--------------------------------------------------------------------------
recursive function ax2ro_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2ro_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: a(4)
real(kind=dbl)                          :: res(4)

real(kind=sgl)                          :: t
real(kind=sgl),parameter                :: thr = 1.0E-7

if (a(4).eq.0.D0) then
  res = (/ 0.D0, 0.D0, epsijkd, 0.D0 /)
  return
end if

res(1:3) =  a(1:3)

! we need to deal with the 180 degree case
if (dabs(a(4)-cPi).lt.thr) then
!if (close_enough(dabs(a(4)-cPi),0.D0)) then
  res(4) = inftyd()
else
  res(4) = dtan( a(4) * 0.5D0 )
end if

end function ax2ro_d

!--------------------------------------------------------------------------
!
! FUNCTION: ax2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to quaternion
!
!> @param a axis angle pair (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 1.1 explicit transformation
!--------------------------------------------------------------------------
recursive function ax2qu(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2qu

use local

real(kind=sgl), INTENT(IN)              :: a(4)
real(kind=sgl)                          :: res(4), c, s

if (close_enough(a(4),0.0)) then
        res = (/ 1.0, 0.0, 0.0, 0.0 /)
else
        c = cos(a(4)*0.5)
        s = sin(a(4)*0.5)
        res = (/ c, a(1)*s, a(2)*s, a(3)*s /)
end if

end function ax2qu

!--------------------------------------------------------------------------
!
! FUNCTION: ax2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to quaternion
!
!> @param a axis angle pair (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 1.1 explicit transformation
!--------------------------------------------------------------------------
recursive function ax2qu_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2qu_d

use local

real(kind=dbl), INTENT(IN)              :: a(4)
real(kind=dbl)                          :: res(4), c, s

if (close_enough(a(4),0.D0)) then
        res = (/ 1.D0, 0.D0, 0.D0, 0.D0 /)
else
        c = dcos(a(4)*0.5D0)
        s = dsin(a(4)*0.5D0)
        res = (/ c, a(1)*s, a(2)*s, a(3)*s /)
end if

end function ax2qu_d

!--------------------------------------------------------------------------
!
! FUNCTION: ro2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert rodrigues to homochoric
!
!> @param r Rodrigues vector (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/24/14   MDG 2.0 explicit transformation
!> @date 8/11/14   MDG 3.0 added infty handling
!--------------------------------------------------------------------------
recursive function ro2ho(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2ho

use local
use constants

real(kind=sgl), INTENT(IN)              :: r(4)
real(kind=sgl)                          :: res(3), rv, f, t

rv = sum(r(1:3)*r(1:3))
if (close_enough(rv,0.0)) then
        res = (/ 0.0, 0.0, 0.0 /)
        return
end if

if (r(4).eq.infty()) then
        f = 0.750 * sngl(cPi)
else
        t = 2.0*atan(r(4))
        f = 0.750*(t- sin(t))
end if

res(1:3) = r(1:3) * f**0.333333333

end function ro2ho

!--------------------------------------------------------------------------
!
! FUNCTION: ro2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert rodrigues to homochoric
!
!> @param r Rodrigues vector (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/24/14   MDG 2.0 explicit transformation
!--------------------------------------------------------------------------
recursive function ro2ho_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2ho_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: r(4)
real(kind=dbl)                          :: res(3), rv, f, t

rv = sum(r(1:3)*r(1:3))
if (close_enough(rv,0.D0)) then
        res = (/ 0.D0, 0.D0, 0.D0 /)
        return
end if

if (r(4).eq.inftyd()) then
        f = 0.75D0 * cPi
else
        t = 2.D0*datan(r(4))
        f = 0.75D0*(t- dsin(t))
end if

res(1:3) = r(1:3) * f**0.333333333D0

end function ro2ho_d

!--------------------------------------------------------------------------
!
! FUNCTION: qu2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert a quaternion to a 3x3 matrix
!
!> @param q quaternion (single precision)
!>
!
!> @note verified 8/5/13
!
!> @date 6/03/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu2om(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2om

use local
use constants

real(kind=sgl),INTENT(IN)               :: q(4)
real(kind=sgl)                          :: res(3,3)

real(kind=sgl)                          :: qq, qc(4)

qq=q(1)*q(1)-(q(2)*q(2)+q(3)*q(3)+q(4)*q(4))

qc = q

res(1,1) = qq+2.0*qc(2)*qc(2)
res(2,2) = qq+2.0*qc(3)*qc(3)
res(3,3) = qq+2.0*qc(4)*qc(4)

res(1,2) = 2.0*(qc(2)*qc(3)-qc(1)*qc(4))
res(2,3) = 2.0*(qc(3)*qc(4)-qc(1)*qc(2))
res(3,1) = 2.0*(qc(4)*qc(2)-qc(1)*qc(3))
res(2,1) = 2.0*(qc(3)*qc(2)+qc(1)*qc(4))
res(3,2) = 2.0*(qc(4)*qc(3)+qc(1)*qc(2))
res(1,3) = 2.0*(qc(2)*qc(4)+qc(1)*qc(3))

if (epsijk.ne.1.0) res = transpose(res)

end function qu2om

!--------------------------------------------------------------------------
!
! FUNCTION: qu2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert a quaternion to a 3x3 matrix (double precision)
!
!> @param q quaternion (double precision)
!>
!
!> @note verified 8/5/13
!
!> @date 6/03/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu2om_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2om_d

use local
use constants

real(kind=dbl),INTENT(IN)               :: q(4)
real(kind=dbl)                          :: res(3,3)

real(kind=dbl)                          :: qq, qc(4)

qq=q(1)*q(1)-(q(2)*q(2)+q(3)*q(3)+q(4)*q(4))

qc = q

res(1,1) = qq+2.D0*qc(2)*qc(2)
res(2,2) = qq+2.D0*qc(3)*qc(3)
res(3,3) = qq+2.D0*qc(4)*qc(4)

res(1,2) = 2.D0*(qc(2)*qc(3)-qc(1)*qc(4))
res(2,3) = 2.D0*(qc(3)*qc(4)-qc(1)*qc(2))
res(3,1) = 2.D0*(qc(4)*qc(2)-qc(1)*qc(3))
res(2,1) = 2.D0*(qc(3)*qc(2)+qc(1)*qc(4))
res(3,2) = 2.D0*(qc(4)*qc(3)+qc(1)*qc(2))
res(1,3) = 2.D0*(qc(2)*qc(4)+qc(1)*qc(3))

if (epsijkd.ne.1.D0) res = transpose(res)

end function qu2om_d

!--------------------------------------------------------------------------
!
! FUNCTION: om2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert a 3x3 rotation matrix to a unit quaternion (see Morawiec, page 37)
!
!> @param x 3x3 matrix to be converted (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 8/18/14   MDG 2.0 new version
!--------------------------------------------------------------------------
recursive function om2qu(x) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2qu

use local
use constants

real(kind=sgl), INTENT(IN)              :: x(3,3)               !< input matrix
real(kind=sgl)                          :: res(4)

real(kind=sgl)                          :: s, s1, s2, s3, oax(4)

s = x(1,1) + x(2,2) + x(3,3) + 1.0
if (abs(s).lt.thr) s = 0.0
s = sqrt(s)

s1 = x(1,1) - x(2,2) - x(3,3) + 1.0
if (abs(s1).lt.thr) s1 = 0.0
s1 = sqrt(s1)

s2 = -x(1,1) + x(2,2) - x(3,3) + 1.0
if (abs(s2).lt.thr) s2 = 0.0
s2 = sqrt(s2)

s3 = -x(1,1) - x(2,2) + x(3,3) + 1.0
if (abs(s3).lt.thr) s3 = 0.0
s3 = sqrt(s3)

res = (/ s, s1, s2, s3 /) * 0.5

! verify the signs (q0 always positive)
if (x(3,2).lt.x(2,3)) res(2) = -epsijk * res(2)
if (x(1,3).lt.x(3,1)) res(3) = -epsijk * res(3)
if (x(2,1).lt.x(1,2)) res(4) = -epsijk * res(4)

! normalize
s = sqrt(sum(res*res))
if (s.ne.0.0) res = res/s

! we need to do a quick test here to make sure that the
! sign of the vector part is the same as that of the
! corresponding vector in the axis-angle representation;
! these two can end up being different, presumably due to rounding
! issues, but this needs to be further analyzed...
! This adds a little bit of computation overhead but for now it
! is the easiest way to make sure the signs are correct.
oax = om2ax(x)
if (oax(1)*res(2).lt.0.0) res(2) = -res(2)
if (oax(2)*res(3).lt.0.0) res(3) = -res(3)
if (oax(3)*res(4).lt.0.0) res(4) = -res(4)

end function om2qu

!--------------------------------------------------------------------------
!
! FUNCTION: om2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert a 3x3 rotation matrix to a unit quaternion (see Morawiec, page 37)
!
!> @param x 3x3 matrix to be converted (double precision)
!
!> @date 8/12/13   MDG 1.0 original
!> @date 8/18/14   MDG 2.0 new version
!--------------------------------------------------------------------------
recursive function om2qu_d(x) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2qu_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: x(3,3)               !< input matrix
real(kind=dbl)                          :: res(4)

real(kind=dbl)                          :: s, s1, s2, s3, oax(4)
real(kind=dbl),parameter                :: thr = 1.0D-10

s = x(1,1) + x(2,2) + x(3,3) + 1.D0
if (abs(s).lt.thr) s = 0.D0
s = dsqrt(s)

s1 = x(1,1) - x(2,2) - x(3,3) + 1.D0
if (abs(s1).lt.thr) s1 = 0.D0
s1 = dsqrt(s1)

s2 = -x(1,1) + x(2,2) - x(3,3) + 1.D0
if (abs(s2).lt.thr) s2 = 0.D0
s2 = dsqrt(s2)

s3 = -x(1,1) - x(2,2) + x(3,3) + 1.D0
if (abs(s3).lt.thr) s3 = 0.D0
s3 = dsqrt(s3)

res = (/ s, s1, s2, s3 /) * 0.5

! verify the signs (q0 always positive)
if (epsijkd.eq.1.D0) then
  if (x(3,2).lt.x(2,3)) res(2) = -epsijkd * res(2)
  if (x(1,3).lt.x(3,1)) res(3) = -epsijkd * res(3)
  if (x(2,1).lt.x(1,2)) res(4) = -epsijkd * res(4)
end if

! normalize
s = dsqrt(sum(res*res))
if (s.ne.0.D0) res = res/s

! we need to do a quick test here to make sure that the
! sign of the vector part is the same as that of the
! corresponding vector in the axis-angle representation;
! these two can end up being different, presumably due to rounding
! issues, but this needs to be further analyzed...
! This adds a little bit of computation overhead but for now it
! is the easiest way to make sure the signs are correct.
oax = om2ax(x)
if (oax(1)*res(2).lt.0.D0) res(2) = -res(2)
if (oax(2)*res(3).lt.0.D0) res(3) = -res(3)
if (oax(3)*res(4).lt.0.D0) res(4) = -res(4)

end function om2qu_d

!--------------------------------------------------------------------------
!
! FUNCTION: qu2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to axis angle
!
!> @param q quaternion (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 explicit transformation
!--------------------------------------------------------------------------
recursive function qu2ax(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2ax

use local
use constants

real(kind=sgl), INTENT(IN)              :: q(4)
real(kind=sgl)                          :: res(4), omega, s, sPi

omega = 2.0 * acos(q(1))
sPi = sngl(cPi)

! if the angle equals zero, then we return the rotation axis as [001]
if (close_enough(omega,0.0)) then
  res = (/ 0.0, 0.0, 1.0, 0.0 /)
else
  if (q(1).ne.0.0) then
    s =  (q(1)/abs(q(1)))/sqrt(q(2)**2+q(3)**2+q(4)**2)
    res = (/ q(2)*s, q(3)*s, q(4)*s, omega /)
  else
    res = (/ q(2), q(3), q(4), sPi /)
  end if
end if

end function qu2ax

!--------------------------------------------------------------------------
!
! FUNCTION: qu2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to axis angle
!
!> @param q quaternion (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 explicit transformation
!--------------------------------------------------------------------------
recursive function qu2ax_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2ax_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: q(4)
real(kind=dbl)                          :: res(4), omega, s

omega = 2.D0 * dacos(q(1))
! if the angle equals zero, then we return the rotation axis as [001]
if (close_enough(omega,0.D0)) then
  res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
else
  if (q(1).ne.0.D0) then
    s =  (q(1)/abs(q(1)))/dsqrt(q(2)**2+q(3)**2+q(4)**2)
    res = (/ q(2)*s, q(3)*s, q(4)*s, omega /)
  else
    res = (/ q(2), q(3), q(4), cPi /)
  end if
end if

end function qu2ax_d

!--------------------------------------------------------------------------
!
! FUNCTION: qu2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to Rodrigues
!
!> @param q quaternion (single precision)
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 direct transformation
!> @date 8/11/14   MDG 2.1 added infty handling
!--------------------------------------------------------------------------
recursive function qu2ro(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2ro

use local
use constants

real(kind=sgl), INTENT(IN)              :: q(4)
real(kind=sgl)                          :: res(4), omega, t, s
real(kind=sgl),parameter                :: thr = 1.0E-8

res(1:3) = q(2:4)
res(4) = 0.0

if (q(1).lt.thr) then
  res(4)=infty()
  return
end if

s = sqrt(sum(res(1:3)*res(1:3)))
if (s.lt.thr) then
  res = (/ 0.0, 0.0, epsijk, 0.0 /)
  return
else
  t = tan(acos(q(1)))
  res = (/ res(1)/s, res(2)/s, res(3)/s, t /)
end if

end function qu2ro

!--------------------------------------------------------------------------
!
! FUNCTION: qu2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to Rodrigues
!
!> @param q quaternion (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 direct transformation
!> @date 8/11/14   MDG 2.1 added infty handling
!--------------------------------------------------------------------------
recursive function qu2ro_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2ro_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: q(4)
real(kind=dbl)                          :: res(4), omega, s, t
real(kind=dbl),parameter                :: thr = 1.0D-10

res(1:3) = q(2:4)
res(4) = 0.D0

if (q(1).lt.thr) then
  res(4)=inftyd()
  return
end if

s = dsqrt(sum(res(1:3)*res(1:3)))
if (s.lt.thr) then
  res = (/ 0.D0, 0.D0, epsijkd, 0.D0 /)
  return
else
  t = dtan(dacos(q(1)))
  res = (/ res(1)/s, res(2)/s, res(3)/s, t /)
end if

end function qu2ro_d

!--------------------------------------------------------------------------
!
! FUNCTION: qu2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to homochoric
!
!> @param q quaternion (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 explicit transformation
!--------------------------------------------------------------------------
recursive function qu2ho(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2ho

use local

real(kind=sgl), INTENT(IN)              :: q(4)
real(kind=sgl)                          :: res(3), omega, s, f

omega = 2.0 * acos(q(1))
if (close_enough(omega,0.0)) then
        res = (/ 0.0, 0.0, 0.0 /)
else
        res = q(2:4)
        s = 1.0/sqrt(sum(res**2))
        res = res * s
        f = 0.75 * ( omega - sin(omega) )
        res = res * f**0.333333333
end if

end function qu2ho

!--------------------------------------------------------------------------
!
! FUNCTION: qu2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to homochoric
!
!> @param q quaternion (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 7/23/14   MDG 2.0 explicit transformation
!--------------------------------------------------------------------------
recursive function qu2ho_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2ho_d

use local

real(kind=dbl), INTENT(IN)              :: q(4)
real(kind=dbl)                          :: res(3), omega, s, f

omega = 2.D0 * dacos(q(1))
if (close_enough(omega,0.D0)) then
        res = (/ 0.D0, 0.D0, 0.D0 /)
else
        res = q(2:4)
        s = 1.D0/dsqrt(sum(res**2))
        res = res * s
        f = 0.75D0 * ( omega - dsin(omega) )
        res = res * f**0.333333333D0
end if

end function qu2ho_d
!--------------------------------------------------------------------------
!
! FUNCTION: ho2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to cubochoric
!
!> @param h homochoric coordinates (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2cu(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2cu

use local
use Lambert, only: LambertBallToCube

real(kind=sgl), INTENT(IN)              :: h(3)         !< input coordinates
real(kind=sgl)                          :: res(3)

integer(kind=irg)                       :: ierr

! calling program must have initialized the Lambert parameters!!!!
!>
res = LambertBallToCube(h,ierr)

end function ho2cu

!--------------------------------------------------------------------------
!
! FUNCTION: ho2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to cubochoric
!
!> @param h homochoric coordinates (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2cu_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2cu_d

use local
use Lambert, only: LambertBallToCube

real(kind=dbl), INTENT(IN)              :: h(3)         !< input coordinates
real(kind=dbl)                          :: res(3)

integer(kind=irg)                       :: ierr

! calling program must have initialized the Lambert parameters!!!!
!>
res = LambertBallToCube(h,ierr)

end function ho2cu_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to homochoric
!
!> @param c cubochoric coordinates (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2ho(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2ho

use local
use Lambert, only: LambertCubeToBall

real(kind=sgl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=sgl)                          :: res(3)

integer(kind=irg)                       :: ierr

! calling program must have initialized the Lambert parameters!!!!
!>
res = LambertCubeToBall(c,ierr)

end function cu2ho

!--------------------------------------------------------------------------
!
! FUNCTION: cu2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to homochoric
!
!> @param c cubochoric coordinates (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2ho_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2ho_d

use local
use Lambert, only: LambertCubeToBall

real(kind=dbl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=dbl)                          :: res(3)

integer(kind=irg)                       :: ierr

! calling program must have initialized the Lambert parameters!!!!
!>
res = LambertCubeToBall(c,ierr)

end function cu2ho_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! and here are a bunch of transformation routines that are derived from the others
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! Function: ro2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Rodrigues vector to Euler angles (single precision)
!
!> @param r Rodrigues vector (single precision)
!>
!
!> @date  8/04/13   MDG 1.0 original
!> @date  8/11/14   MDG 1.1 added infty handling
!> @date 10/20/17   MDG 1.2 check for small values that could cause rounding issues in other routines
!--------------------------------------------------------------------------
recursive function ro2eu(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2eu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: r(4)         !< Rodrigues vector
real(kind=sgl)                  :: res(3)

real(kind=sgl)                  :: rr(3), s, d, eps = 1.0e-8
integer(kind=irg)               :: i, j
real(kind=sgl), parameter       :: pivals(4) = (/ 1.570796326794, 3.141592653589, 4.712388980384, 6.283185307179 /)

res = om2eu(ro2om(r))

do i=1,3
  if (abs(res(i)).lt.eps) res(i) = 0.0
  do j=1,4
    if (abs(res(i)-pivals(j)).lt.eps) res(i) = pivals(j)
  end do
end do

end function ro2eu

!--------------------------------------------------------------------------
!
! Function: ro2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief Rodrigues vector to Euler angles (double precision)
!
!> @param r Rodrigues vector (double precision)
!>
!
!> @date  8/04/13   MDG 1.0 original
!> @date  8/11/14   MDG 1.1 added infty handling
!> @date 10/20/17   MDG 1.2 check for small values that could cause rounding issues in other routines
!--------------------------------------------------------------------------
recursive function ro2eu_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2eu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: r(4)         !< Rodrigues vector
real(kind=dbl)                  :: res(3)

real(kind=dbl)                  :: rr(3), s, d, eps = 1.0D-12
integer(kind=irg)               :: i, j
real(kind=dbl), parameter       :: pivals(4) = (/ cPi*0.5D0, cPi, 3.D0*cPi*0.5D0, 2.D0*cPi /)

res = om2eu_d(ro2om_d(r))

do i=1,3
  if (abs(res(i)).lt.eps) res(i) = 0.D0
  do j=1,4
    if (abs(res(i)-pivals(j)).lt.eps) res(i) = pivals(j)
  end do
end do

end function ro2eu_d

!--------------------------------------------------------------------------
!
! FUNCTION: eu2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert euler to homochoric
!
!> @param e 3 euler angles (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2ho(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2ho

use local

real(kind=sgl), INTENT(IN)              :: e(3)
real(kind=sgl)                          :: res(3)

res = ax2ho(eu2ax(e))

end function eu2ho

!--------------------------------------------------------------------------
!
! FUNCTION: eu2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert euler to homochoric
!
!> @param e 3 euler angles (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2ho_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2ho_d

use local

real(kind=dbl), INTENT(IN)              :: e(3)
real(kind=dbl)                          :: res(3)

res = ax2ho_d(eu2ax_d(e))

end function eu2ho_d

!--------------------------------------------------------------------------
!
! FUNCTION: om2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to Rodrigues
!
!> @param om 3x3 orientation matrix (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om2ro(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2ro

use local

real(kind=sgl), INTENT(IN)              :: om(3,3)
real(kind=sgl)                          :: res(4)

res = eu2ro(om2eu(om))

end function om2ro

!--------------------------------------------------------------------------
!
! FUNCTION: om2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to Rodrigues
!
!> @param om 3x3 orientation matrix (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om2ro_d(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2ro_d

use local

real(kind=dbl), INTENT(IN)              :: om(3,3)
real(kind=dbl)                          :: res(4)

res = eu2ro_d(om2eu_d(om))

end function om2ro_d

!--------------------------------------------------------------------------
!
! FUNCTION: om2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to homochoric
!
!> @param om 3x3 orientation matrix (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 07/08/14 MDG 2.0 simplification via ax (shorter path)
!--------------------------------------------------------------------------
recursive function om2ho(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2ho

use local

real(kind=sgl), INTENT(IN)              :: om(3,3)
real(kind=sgl)                          :: res(3)

res = ax2ho(om2ax(om))

end function om2ho

!--------------------------------------------------------------------------
!
! FUNCTION: om2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to homochoric
!
!> @param om 3x3 orientation matrix (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 07/08/14 MDG 2.0 simplification via ax (shorter path)
!--------------------------------------------------------------------------
recursive function om2ho_d(om) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2ho_d

use local

real(kind=dbl), INTENT(IN)              :: om(3,3)
real(kind=dbl)                          :: res(3)

res = ax2ho(om2ax(om))

end function om2ho_d

!--------------------------------------------------------------------------
!
! FUNCTION: ax2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to euler
!
!> @param a axis angle pair (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 07/08/14 MDG 2.0 simplification via ro (shorter path)
!--------------------------------------------------------------------------
recursive function ax2eu(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2eu

use local

real(kind=sgl), INTENT(IN)              :: a(4)
real(kind=sgl)                          :: res(3)

res = om2eu(ax2om(a))

end function ax2eu

!--------------------------------------------------------------------------
!
! FUNCTION: ax2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to euler
!
!> @param a axis angle pair (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!> @date 07/08/14 MDG 2.0 simplification via ro (shorter path)
!--------------------------------------------------------------------------
recursive function ax2eu_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2eu_d

use local

real(kind=dbl), INTENT(IN)              :: a(4)
real(kind=dbl)                          :: res(3)

res = om2eu(ax2om(a))

end function ax2eu_d

!--------------------------------------------------------------------------
!
! FUNCTION: ro2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert rodrigues to orientation matrix
!
!> @param r Rodrigues vector (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2om(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2om

use local

real(kind=sgl), INTENT(IN)              :: r(4)
real(kind=sgl)                          :: res(3,3)

res = ax2om(ro2ax(r))

end function ro2om

!--------------------------------------------------------------------------
!
! FUNCTION: ro2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert rodrigues to orientation matrix
!
!> @param r Rodrigues vector (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2om_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2om_d

use local

real(kind=dbl), INTENT(IN)              :: r(4)
real(kind=dbl)                          :: res(3,3)

res = ax2om_d(ro2ax_d(r))

end function ro2om_d

!--------------------------------------------------------------------------
!
! FUNCTION: ro2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert rodrigues to quaternion
!
!> @param r Rodrigues vector (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2qu(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2qu

use local

real(kind=sgl), INTENT(IN)              :: r(4)
real(kind=sgl)                          :: res(4)

res = ax2qu(ro2ax(r))

end function ro2qu

!--------------------------------------------------------------------------
!
! FUNCTION: ro2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert rodrigues to quaternion
!
!> @param r Rodrigues vector (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2qu_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2qu_d

use local

real(kind=dbl), INTENT(IN)              :: r(4)
real(kind=dbl)                          :: res(4)

res = ax2qu_d(ro2ax_d(r))

end function ro2qu_d

!--------------------------------------------------------------------------
!
! FUNCTION: ho2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to euler
!
!> @param h homochoric coordinates (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2eu(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2eu

use local

real(kind=sgl), INTENT(IN)              :: h(3)
real(kind=sgl)                          :: res(3)

res = ax2eu(ho2ax(h))

end function ho2eu

!--------------------------------------------------------------------------
!
! FUNCTION: ho2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to euler
!
!> @param h homochoric coordinates (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2eu_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2eu_d

use local

real(kind=dbl), INTENT(IN)              :: h(3)
real(kind=dbl)                          :: res(3)

res = ax2eu_d(ho2ax_d(h))

end function ho2eu_d

!--------------------------------------------------------------------------
!
! FUNCTION: ho2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to orientation matrix
!
!> @param h homochoric coordinates (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2om(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2om

use local

real(kind=sgl), INTENT(IN)              :: h(3)
real(kind=sgl)                          :: res(3,3)

res = ax2om(ho2ax(h))

end function ho2om

!--------------------------------------------------------------------------
!
! FUNCTION: ho2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to orientation matrix
!
!> @param h homochoric coordinates (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2om_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2om_d

use local

real(kind=dbl), INTENT(IN)              :: h(3)
real(kind=dbl)                          :: res(3,3)

res = ax2om_d(ho2ax_d(h))

end function ho2om_d

!--------------------------------------------------------------------------
!
! FUNCTION: ho2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to Rodrigues
!
!> @param h homochoric coordinates (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2ro(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2ro

use local

real(kind=sgl), INTENT(IN)              :: h(3)
real(kind=sgl)                          :: res(4)

res = ax2ro(ho2ax(h))

end function ho2ro

!--------------------------------------------------------------------------
!
! FUNCTION: ho2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to Rodrigues
!
!> @param h homochoric coordinates (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2ro_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2ro_d

use local

real(kind=dbl), INTENT(IN)              :: h(3)
real(kind=dbl)                          :: res(4)

res = ax2ro_d(ho2ax_d(h))

end function ho2ro_d

!--------------------------------------------------------------------------
!
! FUNCTION: ho2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to quaternion
!
!> @param h homochoric coordinates (single precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2qu(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2qu

use local

real(kind=sgl), INTENT(IN)              :: h(3)
real(kind=sgl)                          :: res(4)

res = ax2qu(ho2ax(h))

end function ho2qu

!--------------------------------------------------------------------------
!
! FUNCTION: ho2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric to quaternion
!
!> @param h homochoric coordinates (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2qu_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2qu_d

use local

real(kind=dbl), INTENT(IN)              :: h(3)
real(kind=dbl)                          :: res(4)

res = ax2qu_d(ho2ax_d(h))

end function ho2qu_d

!--------------------------------------------------------------------------
!
! FUNCTION: eu2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert euler angles to cubochoric
!
!> @param e euler angles (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2cu(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2cu

use local

real(kind=sgl), INTENT(IN)              :: e(3)         !< input coordinates
real(kind=sgl)                          :: res(3)

res = ho2cu(eu2ho(e))

end function eu2cu

!--------------------------------------------------------------------------
!
! FUNCTION: eu2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert euler angles to cubochoric
!
!> @param e euler angles (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2cu_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2cu_d

use local

real(kind=dbl), INTENT(IN)              :: e(3)         !< input coordinates
real(kind=dbl)                          :: res(3)

res = ho2cu_d(eu2ho_d(e))

end function eu2cu_d

!--------------------------------------------------------------------------
!
! FUNCTION: om2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to cubochoric
!
!> @param o orientation matrix (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om2cu(o) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2cu

use local

real(kind=sgl), INTENT(IN)              :: o(3,3)               !< input coordinates
real(kind=sgl)                          :: res(3)

res = ho2cu(om2ho(o))

end function om2cu

!--------------------------------------------------------------------------
!
! FUNCTION: om2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to cubochoric
!
!> @param o orientation matrix (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om2cu_d(o) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2cu_d

use local

real(kind=dbl), INTENT(IN)              :: o(3,3)               !< input coordinates
real(kind=dbl)                          :: res(3)

res = ho2cu_d(om2ho_d(o))

end function om2cu_d

!--------------------------------------------------------------------------
!
! FUNCTION: ax2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to cubochoric
!
!> @param a axis angle (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2cu(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2cu

use local

real(kind=sgl), INTENT(IN)              :: a(4)         !< input coordinates
real(kind=sgl)                          :: res(3)

res = ho2cu(ax2ho(a))

end function ax2cu

!--------------------------------------------------------------------------
!
! FUNCTION: ax2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis angle to cubochoric
!
!> @param a axis angle (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2cu_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2cu_d

use local

real(kind=dbl), INTENT(IN)              :: a(4)         !< input coordinates
real(kind=dbl)                          :: res(3)

res = ho2cu_d(ax2ho_d(a))

end function ax2cu_d

!--------------------------------------------------------------------------
!
! FUNCTION: ro2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert Rodrigues to cubochoric
!
!> @param r Rodrigues (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2cu(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2cu

use local

real(kind=sgl), INTENT(IN)              :: r(4)         !< input coordinates
real(kind=sgl)                          :: res(3)

res = ho2cu(ro2ho(r))

end function ro2cu

!--------------------------------------------------------------------------
!
! FUNCTION: ro2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert Rodrigues to cubochoric
!
!> @param r Rodrigues (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2cu_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2cu_d

use local

real(kind=dbl), INTENT(IN)              :: r(4)         !< input coordinates
real(kind=dbl)                          :: res(3)

res = ho2cu_d(ro2ho_d(r))

end function ro2cu_d

!--------------------------------------------------------------------------
!
! FUNCTION: qu2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to cubochoric
!
!> @param q quaternion (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu2cu(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2cu

use local

real(kind=sgl), INTENT(IN)              :: q(4)         !< input coordinates
real(kind=sgl)                          :: res(3)

res = ho2cu(qu2ho(q))

end function qu2cu

!--------------------------------------------------------------------------
!
! FUNCTION: qu2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to cubochoric
!
!> @param q quaternion (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu2cu_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2cu_d

use local

real(kind=dbl), INTENT(IN)              :: q(4)         !< input coordinates
real(kind=dbl)                          :: res(3)

res = ho2cu_d(qu2ho_d(q))

end function qu2cu_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to euler angles
!
!> @param c cubochoric coordinates (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2eu(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2eu

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=sgl)                          :: res(3)

res = ho2eu(cu2ho(c))

end function cu2eu

!--------------------------------------------------------------------------
!
! FUNCTION: cu2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to euler angles
!
!> @param c cubochoric coordinates (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2eu_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2eu_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=dbl)                          :: res(3)

res = ho2eu_d(cu2ho_d(c))

end function cu2eu_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to orientation matrix
!
!> @param c cubochoric coordinates (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2om(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2om

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=sgl)                          :: res(3,3)

res = ho2om(cu2ho(c))

end function cu2om

!--------------------------------------------------------------------------
!
! FUNCTION: cu2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to orientation matrix
!
!> @param c cubochoric coordinates  (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2om_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2om_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=dbl)                          :: res(3,3)

res = ho2om_d(cu2ho_d(c))

end function cu2om_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to axis angle
!
!> @param c cubochoric coordinates (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2ax(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2ax

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=sgl)                          :: res(4)

res = ho2ax(cu2ho(c))

end function cu2ax

!--------------------------------------------------------------------------
!
! FUNCTION: cu2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to axis angle
!
!> @param c cubochoric coordinates  (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2ax_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2ax_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=dbl)                          :: res(4)

res = ho2ax_d(cu2ho_d(c))

end function cu2ax_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to Rodrigues
!
!> @param c cubochoric coordinates (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2ro(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2ro

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=sgl)                          :: res(4)

if (maxval(abs(c)).eq.0.0) then
  res = (/ 0.0, 0.0, 1.0, 0.0 /)
else
  res = ho2ro(cu2ho(c))
end if

end function cu2ro

!--------------------------------------------------------------------------
!
! FUNCTION: cu2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to Rodrigues
!
!> @param c cubochoric coordinates  (double precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2ro_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2ro_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=dbl)                          :: res(4)

if (maxval(dabs(c)).eq.0.0D0) then
  res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
else
  res = ho2ro_d(cu2ho_d(c))
end if

end function cu2ro_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to quaternion
!
!> @param c cubochoric coordinates (single precision)
!>
!
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2qu(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2qu

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=sgl)                          :: res(4)

res = ho2qu(cu2ho(c))

end function cu2qu

!--------------------------------------------------------------------------
!
! FUNCTION: cu2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert cubochoric to quaternion
!
!> @param c cubochoric coordinates  (double precision)
!>
!
!> @date 8/12/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2qu_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2qu_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input coordinates
real(kind=dbl)                          :: res(4)

res = ho2qu_d(cu2ho_d(c))

end function cu2qu_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! new routines for 3D stereographic representation [added October 2017]
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! FUNCTION: om2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to stereographic
!
!> @param c rotation matrix (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2st

use local

real(kind=sgl), INTENT(IN)              :: c(3,3)         !< input
real(kind=sgl)                          :: res(3)

res = qu2st(om2qu(c))

end function om2st

!--------------------------------------------------------------------------
!
! FUNCTION: om2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert orientation matrix to stereographic
!
!> @param c rotation matrix (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function om2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(3,3)         !< input
real(kind=dbl)                          :: res(3)

res = qu2st_d(om2qu_d(c))

end function om2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: ax2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis-angle pair to stereographic
!
!> @param c axis-angle pair (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2st

use local

real(kind=sgl), INTENT(IN)              :: c(4)         !< input
real(kind=sgl)                          :: res(3)

res = qu2st(ax2qu(c))

end function ax2st

!--------------------------------------------------------------------------
!
! FUNCTION: ax2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert axis-angle pair to stereographic
!
!> @param c axis-angle pair (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ax2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(4)         !< input
real(kind=dbl)                          :: res(3)

res = qu2st_d(ax2qu_d(c))

end function ax2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: ro2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert Rodrigues vector to stereographic
!
!> @param c Rodrigues vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2st

use local

real(kind=sgl), INTENT(IN)              :: c(4)         !< input
real(kind=sgl)                          :: res(3)

res = qu2st(ro2qu(c))

end function ro2st

!--------------------------------------------------------------------------
!
! FUNCTION: ro2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert Rodrigues vector to stereographic
!
!> @param c Rodrigues vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ro2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(4)         !< input
real(kind=dbl)                          :: res(3)

res = qu2st_d(ro2qu_d(c))

end function ro2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: ho2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric vector to stereographic
!
!> @param c homochoric vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2st

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3)

res = qu2st(ho2qu(c))

end function ho2st

!--------------------------------------------------------------------------
!
! FUNCTION: ho2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric vector to stereographic
!
!> @param c homochoric vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function ho2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3)

res = qu2st_d(ho2qu_d(c))

end function ho2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: cu2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric vector to stereographic
!
!> @param c homochoric vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2st

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3)

res = qu2st(cu2qu(c))

end function cu2st

!--------------------------------------------------------------------------
!
! FUNCTION: cu2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert homochoric vector to stereographic
!
!> @param c homochoric vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function cu2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3)

res = qu2st_d(cu2qu_d(c))

end function cu2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: eu2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert Euler angles to stereographic
!
!> @param c Euler angles (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2st

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3)

res = qu2st(eu2qu(c))

end function eu2st

!--------------------------------------------------------------------------
!
! FUNCTION: eu2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert Euler angles to stereographic
!
!> @param c Euler angles (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function eu2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3)

res = qu2st_d(eu2qu_d(c))

end function eu2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: qu2st
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to stereographic
!
!> @param c quaternion (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu2st(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2st

use local

real(kind=sgl), INTENT(IN)              :: c(4)         !< input
real(kind=sgl)                          :: res(3)

res(1:3) = c(2:4)
if (c(1).ne.0.0) then
   res = res / (1.0 + c(1))
end if

end function qu2st

!--------------------------------------------------------------------------
!
! FUNCTION: qu2st_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert quaternion to stereographic
!
!> @param c quaternion (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function qu2st_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2st_d

use local

real(kind=dbl), INTENT(IN)              :: c(4)         !< input
real(kind=dbl)                          :: res(3)

res(1:3) = c(2:4)
if (c(1).ne.0.D0) then
   res = res / (1.D0 + c(1))
end if

end function qu2st_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to orientation matrix
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2om(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2om

use local
use constants

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3,3)

real(kind=sgl)                          :: l, tmp(3), ax(4), sPi

l = sqrt(sum(c*c))
sPi = sngl(cPi)

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough(l,1.0) ) then
        ax = (/ tmp(1), tmp(2), tmp(3), sPi /)
   else
        ax = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
   end if
   res = ax2om(ax)
else ! return the identity matrix
   res = 0.0
   res(1,1) = 1.0
   res(2,2) = 1.0
   res(3,3) = 1.0
end if

end function st2om

!--------------------------------------------------------------------------
!
! FUNCTION: st2om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to orientation matrix
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2om_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2om_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3,3)

real(kind=dbl)                          :: l, tmp(3), ax(4)

l = sqrt(sum(c*c))

if (l.gt.0.D0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough_d(l,1.D0) ) then
        ax = (/ tmp(1), tmp(2), tmp(3), cPi /)
   else
        ax = (/ tmp(1), tmp(2), tmp(3), 4.D0*datan(l) /)
   end if
   res = ax2om_d(ax)
else ! return the identity matrix
   res = 0.D0
   res(1,1) = 1.D0
   res(2,2) = 1.D0
   res(3,3) = 1.D0
end if

end function st2om_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2eu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to Euler angles
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2eu(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2eu

use local
use constants

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3)

real(kind=sgl)                          :: l, tmp(3), ax(4), sPi

l = sqrt(sum(c*c))
sPi = sngl(cPi)

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough(l,1.0) ) then
        ax = (/ tmp(1), tmp(2), tmp(3), sPi /)
   else
        ax = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
   end if
   res = ax2eu(ax)
else ! return the identity orientation
   res = 0.0
end if

end function st2eu

!--------------------------------------------------------------------------
!
! FUNCTION: st2eu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to Euler angles
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2eu_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2eu_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3)

real(kind=dbl)                          :: l, tmp(3), ax(4)

l = sqrt(sum(c*c))

if (l.gt.0.D0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough_d(l,1.D0) ) then
        ax = (/ tmp(1), tmp(2), tmp(3), cPi /)
   else
        ax = (/ tmp(1), tmp(2), tmp(3), 4.D0*datan(l) /)
   end if
   res = ax2eu_d(ax)
else ! return the identity orientation
   res = 0.D0
end if

end function st2eu_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2qu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to quaternion
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2qu(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2qu

use local
use constants

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(4)

real(kind=sgl)                          :: l, tmp(3), ax(4), sPi

l = sqrt(sum(c*c))
sPi = sngl(cPi)

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough(l,1.0) ) then
        ax = (/ tmp(1), tmp(2), tmp(3), sPi /)
   else
        ax = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
   end if
   res = ax2qu(ax)
else ! return the identity orientation
   res = (/ 1.0, 0.0, 0.0, 0.0 /)
end if

end function st2qu

!--------------------------------------------------------------------------
!
! FUNCTION: st2qu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to quaternion
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2qu_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2qu_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(4)

real(kind=dbl)                          :: l, tmp(3), ax(4)

l = sqrt(sum(c*c))

if (l.gt.0.D0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough_d(l,1.D0) ) then
        ax = (/ tmp(1), tmp(2), tmp(3), cPi /)
   else
        ax = (/ tmp(1), tmp(2), tmp(3), 4.D0*datan(l) /)
   end if
   res = ax2qu_d(ax)
else ! return the identity orientation
   res = (/ 1.D0, 0.D0, 0.D0, 0.D0 /)
end if

end function st2qu_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2ax
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to axis-angle pair
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2ax(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2ax

use local
use constants

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(4)

real(kind=sgl)                          :: l, tmp(3), sPi

l = sqrt(sum(c*c))
sPi = sngl(cPi)

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough(l,1.0) ) then
        res = (/ tmp(1), tmp(2), tmp(3), sPi /)
   else
        res = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
   end if
else ! return the identity orientation
   res = (/ 0.0, 0.0, 1.0, 0.0 /)
end if

end function st2ax

!--------------------------------------------------------------------------
!
! FUNCTION: st2ax_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to axis-angle pair
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2ax_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2ax_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(4)

real(kind=dbl)                          :: l, tmp(3)

l = sqrt(sum(c*c))

if (l.gt.0.D0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough_d(l,1.D0) ) then
        res = (/ tmp(1), tmp(2), tmp(3), cPi /)
   else
        res = (/ tmp(1), tmp(2), tmp(3), 4.D0*datan(l) /)
   end if
else ! return the identity orientation
   res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
end if

end function st2ax_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2ro
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to Rodrigues vector
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2ro(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2ro

use local
use constants

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(4)

real(kind=sgl)                          :: l, tmp(3)

l = sqrt(sum(c*c))

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough(l,1.0) ) then
        res = (/ tmp(1), tmp(2), tmp(3), 0.0 /)
        res(4) = infty()
   else
        res = (/ tmp(1), tmp(2), tmp(3), tan(2.0*atan(l)) /)
   end if
else ! return the identity orientation
   res = (/ 0.0, 0.0, 1.0, 0.0 /)
end if

end function st2ro

!--------------------------------------------------------------------------
!
! FUNCTION: st2ro_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to Rodrigues vector
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2ro_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2ro_d

use local
use constants

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(4)

real(kind=dbl)                          :: l, tmp(3)

l = sqrt(sum(c*c))

if (l.gt.0.D0) then ! not the identity rotation
   tmp = c/l
   if ( close_enough_d(l,1.D0) ) then
        res = (/ tmp(1), tmp(2), tmp(3), 0.D0 /)
        res(4) = inftyd()
   else
        res = (/ tmp(1), tmp(2), tmp(3), tan(2.D0*datan(l)) /)
   end if
else ! return the identity orientation
   res = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
end if

end function st2ro_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2ho
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to homochoric vector
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2ho(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2ho

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3)

real(kind=sgl)                          :: l, tmp(3), angle

l = sqrt(sum(c*c))

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   angle = 4.0*atan(l)
   res = tmp * (3.0 * ( angle - sin(angle) ) / 4.0) ** (1.0/3.0)
else ! return the identity orientation
   res = (/ 0.0, 0.0, 0.0 /)
end if

end function st2ho

!--------------------------------------------------------------------------
!
! FUNCTION: st2ho_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to homochoric vector
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2ho_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2ho_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3)

real(kind=dbl)                          :: l, tmp(3), angle

l = sqrt(sum(c*c))

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   angle = 4.D0*datan(l)
   res = tmp * (3.D0 * ( angle - dsin(angle) ) / 4.D0) ** (1.D0/3.D0)
else ! return the identity orientation
   res = (/ 0.D0, 0.D0, 0.D0 /)
end if

end function st2ho_d

!--------------------------------------------------------------------------
!
! FUNCTION: st2cu
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to cubochoric vector
!
!> @param c stereographic vector (single precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2cu(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2cu

use local

real(kind=sgl), INTENT(IN)              :: c(3)         !< input
real(kind=sgl)                          :: res(3)

real(kind=sgl)                          :: l, tmp(3), angle

l = sqrt(sum(c*c))

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   angle = 4.0*atan(l)
   res = ho2cu(tmp * (3.0 * ( angle - sin(angle) ) / 4.0) ** (1.0/3.0))
else ! return the identity orientation
   res = (/ 0.0, 0.0, 0.0 /)
end if

end function st2cu

!--------------------------------------------------------------------------
!
! FUNCTION: st2cu_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief convert stereographic to cubochoric vector
!
!> @param c stereographic vector (double precision)
!>
!
!> @date 10/07/17   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function st2cu_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2cu_d

use local

real(kind=dbl), INTENT(IN)              :: c(3)         !< input
real(kind=dbl)                          :: res(3)

real(kind=dbl)                          :: l, tmp(3), angle

l = sqrt(sum(c*c))

if (l.gt.0.0) then ! not the identity rotation
   tmp = c/l
   angle = 4.D0*datan(l)
   res = ho2cu_d(tmp * (3.D0 * ( angle - dsin(angle) ) / 4.D0) ** (1.D0/3.D0))
else ! return the identity orientation
   res = (/ 0.D0, 0.D0, 0.D0 /)
end if

end function st2cu_d

!--------------------------------------------------------------------------
!
! Function: eu2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief Euler angles to rotation vector map
!
!> @param e 3 Euler angles in radians (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function eu2rv(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input Euler angles in radians
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

ax = eu2ax(e)

res = ax(1:3) * ax(4)

end function eu2rv

!--------------------------------------------------------------------------
!
! Function: eu2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief Euler angles to rotation vector map
!
!> @param e 3 Euler angles in radians (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function eu2rv_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: eu2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input Euler angles in radians
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

ax = eu2ax(e)

res = ax(1:3) * ax(4)

end function eu2rv_d

!--------------------------------------------------------------------------
!
! Function: om2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation matrix to rotation vector map
!
!> @param  o 3x3 rotation matrix (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function om2rv(o) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: o(3,3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = qu2rv(om2qu(o))

end function om2rv

!--------------------------------------------------------------------------
!
! Function: om2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation matrix to rotation vector map
!
!> @param o 3x3 rotation matrix (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function om2rv_d(o) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: om2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: o(3,3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = qu2rv(om2qu(o))

end function om2rv_d

!--------------------------------------------------------------------------
!
! Function: ro2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rodrigues vector to rotation vector map
!
!> @param r rodrigues vector (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function ro2rv(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: r(4)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(ro2eu(r))

end function ro2rv

!--------------------------------------------------------------------------
!
! Function: ro2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rodrigues vector to rotation vector map
!
!> @param r rodrigues vector (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function ro2rv_d(r) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ro2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: r(4)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(ro2eu(r))

end function ro2rv_d

!--------------------------------------------------------------------------
!
! Function: qu2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief quaternion to rotation vector map
!
!> @param q quaternion (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function qu2rv(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: q(4)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(qu2eu(q))

end function qu2rv

!--------------------------------------------------------------------------
!
! Function: qu2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief quaternion to rotation vector map
!
!> @param q quaternion (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function qu2rv_d(q) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: qu2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: q(4)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(qu2eu(q))

end function qu2rv_d

!--------------------------------------------------------------------------
!
! Function: cu2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief cubochoric vector to rotation vector map
!
!> @param c cubochoric vector (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function cu2rv(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: c(3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(cu2eu(c))

end function cu2rv

!--------------------------------------------------------------------------
!
! Function: cu2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief cubochoric vector to rotation vector map
!
!> @param c cubochoric vector (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function cu2rv_d(c) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: cu2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: c(3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(cu2eu(c))

end function cu2rv_d

!--------------------------------------------------------------------------
!
! Function: ax2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief axis angle pair to rotation vector map
!
!> @param a axis angle pair (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function ax2rv(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: a(4)
real(kind=dbl)                  :: res(3)       !< output rotation vector map
integer(kind=irg)               :: ii, ctr
real(kind=sgl),parameter        :: thr = 1.0E-6

res = a(1:3) * a(4)

end function ax2rv

!--------------------------------------------------------------------------
!
! Function: ax2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief axis angle to rotation vector map
!
!> @param a axis angle pair (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function ax2rv_d(a) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ax2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: a(4)
real(kind=dbl)                  :: res(3)       !< output rotation vector map
integer(kind=irg)               :: ii, ctr
real(kind=sgl),parameter        :: thr = 1.0D-8

res = a(1:3) * a(4)

end function ax2rv_d

!--------------------------------------------------------------------------
!
! Function: ho2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief homochoric vector to rotation vector map
!
!> @param h homochoric vector (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function ho2rv(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: h(3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(ho2eu(h))

end function ho2rv

!--------------------------------------------------------------------------
!
! Function: ho2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief homochoric vector to rotation vector map
!
!> @param h homochoric vector (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function ho2rv_d(h) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: ho2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: h(3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(ho2eu(h))

end function ho2rv_d

!--------------------------------------------------------------------------
!
! Function: st2rv
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief stereographic vector to rotation vector map
!
!> @param s stereographic vector (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function st2rv(s) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2rv

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: s(3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(st2eu(s))

end function st2rv

!--------------------------------------------------------------------------
!
! Function: st2rv_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief stereographic vector to rotation vector map
!
!> @param s stereographic vector (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function st2rv_d(s) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: st2rv_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: s(3)
real(kind=dbl)                  :: res(3)       !< output rotation vector map

real(kind=dbl)                  :: ax(4)

res = eu2rv(st2eu(s))

end function st2rv_d

!--------------------------------------------------------------------------
!
! Function: rv2ax
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to axis angle pair
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2ax(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2ax

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(4)       !< output axis angle pair

real(kind=dbl)                  :: an, n(3)
real(kind=dbl), parameter       :: tol = 1.0D-10

an = sqrt(sum(e**2))

if(an .gt. tol) then
        n = e / an
else
        n = (/0.0, 0.0, 1.0/)
end if

res = (/n, an/)

end function rv2ax

!--------------------------------------------------------------------------
!
! Function: rv2ax_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to axis angle pair
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2ax_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2ax_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(4)       !< output rotation vector map

real(kind=dbl)                  :: an, n(3)
real(kind=dbl), parameter       :: tol = 1.0D-10

an = sqrt(sum(e**2))

if(an .gt. tol) then
        n = e / an
else
        n = (/0.0, 0.0, 1.0/)
end if

res = (/n, an/)

end function rv2ax_d

!--------------------------------------------------------------------------
!
! Function: rv2om
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to rotation matrix
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2om(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2om

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3,3)     !< output rotation matrix

res = ax2om(rv2ax(e))

end function rv2om

!--------------------------------------------------------------------------
!
! Function: rv2om_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to rotation matrix
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2om_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2om_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3,3)     !< output rotation matrix

res = ax2om(rv2ax(e))

end function rv2om_d

!--------------------------------------------------------------------------
!
! Function: rv2eu
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to euler angles in radians
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2eu(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2eu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output euler angles in radians

res = ax2eu(rv2ax(e))

end function rv2eu

!--------------------------------------------------------------------------
!
! Function: rv2eu_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to euler angles in radians
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2eu_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2eu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output euler angles in radians

res = ax2eu(rv2ax(e))

end function rv2eu_d

!--------------------------------------------------------------------------
!
! Function: rv2qu
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to quaternion
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2qu(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2qu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(4)       !< output quaternion

res = ax2qu(rv2ax(e))

end function rv2qu

!--------------------------------------------------------------------------
!
! Function: rv2qu_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to quaternion
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2qu_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2qu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(4)       !< output quaternion

res = ax2qu(rv2ax(e))

end function rv2qu_d

!--------------------------------------------------------------------------
!
! Function: rv2ro
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to rodrigues vector
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2ro(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2ro

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(4)       !< output rodrigues vector

res = ax2ro(rv2ax(e))

end function rv2ro

!--------------------------------------------------------------------------
!
! Function: rv2ro_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to rodrigues vector
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2ro_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2ro_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(4)       !< output rodrigues vector

res = ax2ro(rv2ax(e))

end function rv2ro_d

!--------------------------------------------------------------------------
!
! Function: rv2cu
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to cubochoric vector
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2cu(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2cu

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output cubochoric vector

res = ax2cu(rv2ax(e))

end function rv2cu

!--------------------------------------------------------------------------
!
! Function: rv2cu_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to cubochoric vector
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2cu_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2cu_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output cubochoric vector

res = ax2cu(rv2ax(e))

end function rv2cu_d

!--------------------------------------------------------------------------
!
! Function: rv2ho
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to homochoric vector
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2ho(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2ho

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output homochoric vector

res = ax2ho(rv2ax(e))

end function rv2ho

!--------------------------------------------------------------------------
!
! Function: rv2ho_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to homochoric vector
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2ho_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2ho_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output homochoric vector

res = ax2ho(rv2ax(e))

end function rv2ho_d

!--------------------------------------------------------------------------
!
! Function: rv2st
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to stereographic vector
!
!> @param e rotation vector map (single precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2st(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2st

use local
use constants

IMPLICIT NONE

real(kind=sgl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output stereographic vector

res = ax2st(rv2ax(e))

end function rv2st

!--------------------------------------------------------------------------
!
! Function: rv2st_d
!
!> @author Saransh Singh, Lawrence Livermore National Lab
!
!> @brief rotation vector map to stereographic vector
!
!> @param e rotation vector map (double precision)
!>
!> @date 10/25/19   SS 1.0 original
!--------------------------------------------------------------------------
recursive function rv2st_d(e) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: rv2st_d

use local
use constants

IMPLICIT NONE

real(kind=dbl),INTENT(IN)       :: e(3)         !< input rotation vector map
real(kind=dbl)                  :: res(3)       !< output stereographic vector

res = ax2st(rv2ax(e))

end function rv2st_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! routines for rotating a vector, tensor, ...
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! FUNCTION: RodriguesProduct
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief multiply two Rodrigues vectors
!
!> @param roA first input Rodrigues vector components (single precision)
!> @param roB second input Rodrigues vector components (single precision)
!
!> @date 12/01/16   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function RodriguesProduct(roA,roB) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: RodriguesProduct

use local
use math

real(kind=sgl),INTENT(IN)       :: roA(3)
real(kind=sgl),INTENT(IN)       :: roB(3)

real(kind=sgl)                  :: res(3)

res = (roA + roB - cross3(roA,roB))/(1.0 - DOT_PRODUCT(roA,roB))

end function RodriguesProduct

!--------------------------------------------------------------------------
!
! FUNCTION: RodriguesProduct_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief multiply two Rodrigues vectors
!
!> @param roA first input Rodrigues vector components (single precision)
!> @param roB second input Rodrigues vector components (single precision)
!
!> @date 12/01/16   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function RodriguesProduct_d(roA,roB) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: RodriguesProduct_d

use local
use math

real(kind=dbl),INTENT(IN)       :: roA(3)
real(kind=dbl),INTENT(IN)       :: roB(3)

real(kind=dbl)                  :: res(3)

res = (roA + roB - cross3(roA,roB))/(1.D0 - DOT_PRODUCT(roA,roB))

end function RodriguesProduct_d

!--------------------------------------------------------------------------
!
! FUNCTION: RotVec_om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief rotate a vector using a rotation matrix, active or passive (single precision)
!
!> @details This routine provides a way for the user to transform a vector
!> and it returns the new vector components.  The user can use either a
!> rotation matrix or a quaternion to define the transformation, and must
!> also specifiy whether an active or passive result is needed.  The quaternion
!> rotation is part of the quaternion.f90 file, in the routine quat_Lp or quat_Lpstar.
!
!> @param vec input vector components (single precision)
!> @param om orientation matrix (single precision)
!> @param ap active/passive switch
!>
!
!> @date 8/18/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function RotVec_om(vec,om,ap) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: RotVec_om

use local

real(kind=sgl),INTENT(IN)       :: vec(3)
real(kind=sgl),INTENT(IN)       :: om(3,3)
character(1),INTENT(IN)         :: ap

real(kind=sgl)                  :: res(3)

if (ap.eq.'p') then
 res = matmul(om,vec)
else
 res = matmul(transpose(om),vec)
end if

end function RotVec_om

!--------------------------------------------------------------------------
!
! FUNCTION: RotVec_om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief rotate a vector using a rotation matrix, active or passive (double precision)
!
!> @details This routine provides a way for the user to transform a vector
!> and it returns the new vector components.  The user can use either a
!> rotation matrix or a quaternion to define the transformation, and must
!> also specifiy whether an active or passive result is needed.  The quaternion
!> rotation is part of the quaternion.f90 file, in the routine quat_Lp or quat_Lpstar.
!
!> @param vec input vector components (double precision)
!> @param om orientation matrix (double precision)
!> @param ap active/passive switch
!>
!
!> @date 8/18/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function RotVec_om_d(vec,om,ap) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: RotVec_om_d

use local

real(kind=dbl),INTENT(IN)       :: vec(3)
real(kind=dbl),INTENT(IN)       :: om(3,3)
character(1),INTENT(IN)         :: ap

real(kind=dbl)                  :: res(3)

if (ap.eq.'p') then
 res = matmul(om,vec)
else
 res = matmul(transpose(om),vec)
end if

end function RotVec_om_d

!--------------------------------------------------------------------------
!
! FUNCTION: RotTensor2_om
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief rotate a second rank tensor using a rotation matrix, active or passive (single precision)
!
!> @param tensor input tensor components (single precision)
!> @param om orientation matrix (single precision)
!> @param ap active/passive switch
!>
!
!> @date 8/18/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function RotTensor2_om(tensor,om,ap) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: RotTensor2_om

use local

real(kind=sgl),INTENT(IN)       :: tensor(3,3)
real(kind=sgl),INTENT(IN)       :: om(3,3)
character(1),INTENT(IN)         :: ap

real(kind=sgl)                  :: res(3,3)

if (ap.eq.'p') then
 res = matmul(matmul(om,tensor),transpose(om))
else
 res = matmul(matmul(transpose(om),tensor),om)
end if

end function RotTensor2_om

!--------------------------------------------------------------------------
!
! FUNCTION: RotTensor2_om_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief rotate a second rank tensor using a rotation matrix, active or passive (double precision)
!
!> @param tensor input tensor components (double precision)
!> @param om orientation matrix (double precision)
!> @param ap active/passive switch
!>
!
!> @date 8/18/14   MDG 1.0 original
!--------------------------------------------------------------------------
recursive function RotTensor2_om_d(tensor,om,ap) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: RotTensor2_om_d

use local

real(kind=dbl),INTENT(IN)       :: tensor(3,3)
real(kind=dbl),INTENT(IN)       :: om(3,3)
character(1),INTENT(IN)         :: ap

real(kind=dbl)                  :: res(3,3)

if (ap.eq.'p') then
 res = matmul(matmul(om,tensor),transpose(om))
else
 res = matmul(matmul(transpose(om),tensor),om)
end if

end function RotTensor2_om_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! some basic averaging routines for quaternions
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! function: quat_average
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief  computes the average of a list of quaternions using the quaternion logarithm
!
!> @param qlist quaternion list
!> @param numq number of quaternions in list
!> @param qstdev standard deviation quaternion/eigenvalues
!
!> @date 03/16/15 MDG 1.0 original
!> @date 10/16/20 MDG 1.1 corrects sign of axis angle pairs when dot product with first entry is negative
!> @date 10/16/20 MDG 1.2 add optional Tmatrix approach (largest eigenvalue determines mean)
!--------------------------------------------------------------------------
recursive function quat_average(qlist,numq,qstdev,Tmatrix) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: quat_average

use local

real(kind=sgl),INTENT(IN)       :: qlist(4,numq)
integer(kind=irg)               :: numq
real(kind=sgl),INTENT(OUT)      :: qstdev(4)
real(kind=sgl)                  :: res(4)
logical,INTENT(IN),OPTIONAL     :: Tmatrix

integer(kind=irg)               :: i, pos(1)
real(kind=sgl)                  :: lsum(3), ax(4), qv, sqv, dfm(3), first(4), dp, qin(4), Tmat(4,4)
real(kind=sgl)                  :: axanglist(3,numq)
logical                         :: doTmatrix

!LAPACK parameters
real(kind=sgl)                  :: VL(4,4), VR(4,4), Wr(4), Wi(4), WORK(40)
integer(kind=irg)               :: nn, LDA, LDVL, LDVR, INFO, LWORK
character(1)                    :: JOBVL, JOBVR

doTmatrix=.FALSE.
if (present(Tmatrix)) then
  if (Tmatrix.eqv..TRUE.) doTmatrix=.TRUE. ! use the Tmatrix approach to find the quaternion average
end if

if (doTmatrix.eqv..TRUE.) then
    Tmat = matmul(qlist,transpose(qlist))/real(numq)

! set some initial LAPACK variables
    nn = 4
    LDA = nn
    LDVL = nn
    LDVR = nn
    INFO = 0

! first initialize the parameters for the LAPACK DGEEV routines
    JOBVL = 'N'   ! do not compute the left eigenvectors
    JOBVR = 'V'   ! do compute the right eigenvectors
    LWORK = 40

! call the eigenvalue solver
    call sgeev(JOBVL,JOBVR,nn,Tmat,LDA,Wr,Wi,VL,LDVL,VR,LDVR,WORK,LWORK,INFO)
    pos = maxloc(Wr)
    res(1:4) = VR(1:4,pos(1))
    qstdev = Wr
! check the sign of the scalar part
    if (res(1).lt.0.D0) res = -res

  else ! use the quaternion logarithm to determine the average

! convert each one to a logarithm, which is really the unit rotation vector multiplied by half the rotation angle
  first = qlist(1:4,1)
  do i=1,numq
    qin = qlist(1:4,i)
! convert the quaternion to an axis angle pair
    ax = qu2ax(qin)
! make sure that the dot product with first is positive
    dp = sum(first*qin)
    if (dp.lt.0.0) then
      axanglist(1:3,i) =  -ax(1:3)*0.50*ax(4)
    else
      axanglist(1:3,i) =   ax(1:3)*0.50*ax(4)
    end if
  end do

! compute the geometric mean
  lsum = sum(axanglist,2)/float(numq)

! then get the standard deviation from the mean
  dfm = 0.0
  do i=1,numq
    dfm(1:3) = dfm(1:3) + (lsum - axanglist(1:3,i))**2
  end do
  dfm = sqrt(dfm/float(numq))

! then convert this average back to a quaternion via the exponentiation operation
  qv = sqrt(sum(lsum*lsum))
  sqv = sin(qv)/qv
  res = (/ cos(qv), lsum(1)*sqv, lsum(2)*sqv, lsum(3)*sqv /)

! and do the same with the standard deviation quaternion
  qv = sqrt(sum(dfm*dfm))
  sqv = sin(qv)/qv
  qstdev = (/ cos(qv), dfm(1)*sqv, dfm(2)*sqv, dfm(3)*sqv /)
end if

end function quat_average

!--------------------------------------------------------------------------
!
! function: quat_average_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief  computes the average of a list of quaternions using the quaternion logarithm
!
!> @param qlist quaternion list
!> @param numq number of quaternions in list
!> @param qstdev standard deviation quaternion/eigenvalues
!
!> @date 03/16/15 MDG 1.0 original
!> @date 10/16/20 MDG 1.1 corrects sign of axis angle pairs when dot product with first entry is negative
!> @date 10/16/20 MDG 1.2 add optional Tmatrix approach (largest eigenvalue determines mean)
!--------------------------------------------------------------------------
recursive function quat_average_d(qlist,numq,qstdev, Tmatrix) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: quat_average_d

use local

real(kind=dbl),INTENT(IN)       :: qlist(4,numq)
integer(kind=irg)               :: numq
real(kind=dbl),INTENT(OUT)      :: qstdev(4)
real(kind=dbl)                  :: res(4)
logical,INTENT(IN),OPTIONAL     :: Tmatrix

integer(kind=irg)               :: i, pos(1)
real(kind=dbl)                  :: lsum(3), ax(4), qv, sqv, dfm(3), first(4), dp, qin(4), Tmat(4,4)
real(kind=dbl)                  :: axanglist(3,numq)
logical                         :: doTmatrix

!LAPACK parameters
real(kind=dbl)                  :: VL(4,4), VR(4,4), Wr(4), Wi(4), WORK(20)
integer(kind=irg)               :: nn, LDA, LDVL, LDVR, INFO, LWORK
character(1)                    :: JOBVL, JOBVR

doTmatrix=.FALSE.
if (present(Tmatrix)) then
  if (Tmatrix.eqv..TRUE.) doTmatrix=.TRUE. ! use the Tmatrix approach to find the quaternion average
end if

if (doTmatrix.eqv..TRUE.) then
    Tmat = matmul(qlist,transpose(qlist))/dble(numq)

! set some initial LAPACK variables
    nn = 4
    LDA = nn
    LDVL = nn
    LDVR = nn
    INFO = 0

! first initialize the parameters for the LAPACK DGEEV routines
    JOBVL = 'N'   ! do not compute the left eigenvectors
    JOBVR = 'V'   ! do compute the right eigenvectors
    LWORK = 40

! call the eigenvalue solver
    call dgeev(JOBVL,JOBVR,nn,Tmat,LDA,Wr,Wi,VL,LDVL,VR,LDVR,WORK,LWORK,INFO)
    pos = maxloc(Wr)
    res(1:4) = VR(1:4,pos(1))
    qstdev = Wr
! check the sign of the scalar part
    if (res(1).lt.0.D0) res = -res

  else ! use the quaternion logarithm to determine the average

! convert each one to a logarithm, which is really the unit rotation vector multiplied by half the rotation angle
  first = qlist(1:4,1)
  do i=1,numq
    qin = qlist(1:4,i)
! convert the quaternion to an axis angle pair
    ax = qu2ax_d(qin)
! make sure that the dot product with first is positive
    dp = sum(first*qin)
    if (dp.lt.0.D0) then
      axanglist(1:3,i) =  -ax(1:3)*0.5D0*ax(4)
    else
      axanglist(1:3,i) =   ax(1:3)*0.5D0*ax(4)
    end if
  end do

! compute the geometric mean
  lsum = sum(axanglist,2)/dble(numq)

! then get the standard deviation from the mean
  dfm = 0.D0
  do i=1,numq
    dfm(1:3) = dfm(1:3) + (lsum - axanglist(1:3,i))**2
  end do
  dfm = dsqrt(dfm/dble(numq))

! then convert this average back to a quaternion via the exponentiation operation; check interval first ?
  qv = dsqrt(sum(lsum*lsum))
  sqv = dsin(qv)/qv
  res = (/ dcos(qv), lsum(1)*sqv, lsum(2)*sqv, lsum(3)*sqv /)

! and do the same with the standard deviation quaternion
  qv = dsqrt(sum(dfm*dfm))
  sqv = dsin(qv)/qv
  qstdev = (/ dcos(qv), dfm(1)*sqv, dfm(2)*sqv, dfm(3)*sqv /)
end if

end function quat_average_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! and finally some printing routines, mostly used for debugging
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
!
! SUBROUTINE: print_orientation
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief  prints a complete orientationtype record or a single entry
!
!> @param o orientationtype record
!> @param outtype (optional) indicates which representation to print
!> @param pretext (optional) up to 10 characters that will precede each line
!
!> @date  8/4/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive subroutine print_orientation(o,outtype,pretext)
!DEC$ ATTRIBUTES DLLEXPORT :: print_orientation

use local
use io
use constants

IMPLICIT NONE

type(orientationtype),INTENT(IN)        :: o
character(2),INTENT(IN),OPTIONAL        :: outtype
character(10),INTENT(IN),OPTIONAL       :: pretext

real(kind=sgl)                          :: ioreal(4)
character(10)                           :: pret

pret = ''
if (present(pretext)) pret=trim(pretext)

if (present(outtype)) then
  select case (outtype)
        case ('eu')
          ioreal(1:3) = o%eulang(1:3)*180.0/sngl(cPi)
          call WriteValue(trim(pret)//'Euler angles                     : ', ioreal, 3, "(3(F8.4,' '))")

        case ('ax')
          ioreal(1:4) = o%axang(1:4)
          ioreal(4) = ioreal(4)*180.0/sngl(cPi)
          call WriteValue(trim(pret)//'Axis angle pair [n; angle]       : ', ioreal, 4, "(3(F8.4,' '),'; ',F8.4)")

        case ('ro')
          if (o%rodrigues(4).lt.infty()) then
            ioreal(1:3) = o%rodrigues(1:3)*o%rodrigues(4)
            call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 3, "(3(F12.4,' '))")
          else
            ioreal(1:4) = o%rodrigues(1:4)
            call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 4, "(4(F12.4,' '))")
          end if

        case ('ho')
          ioreal(1:3) = o%homochoric(1:3)
          call WriteValue(trim(pret)//'Homochoric representation        : ', ioreal, 3, "(3(F8.4,' '))")

        case ('cu')
          ioreal(1:3) = o%cubochoric(1:3)
          call WriteValue(trim(pret)//'Cubochoric representation        : ', ioreal, 3, "(3(F8.4,' '))")

        case ('qu')
          ioreal(1:4) = o%quat
          call WriteValue(trim(pret)//'Quaternion                       : ', ioreal, 4, "(4(F8.4,' '))")

        case ('st')
          ioreal(1:3) = o%stereographic
          call WriteValue(trim(pret)//'Stereographic                    : ', ioreal, 3, "(3(F8.4,' '))")

        case ('rv')
          ioreal(1:3) = o%rvmap
          call WriteValue(trim(pret)//'Rotation vector map              : ', ioreal, 3, "(3(F8.4,' '))")

        case ('om')
          ioreal(1:3) = o%om(1,1:3)
          call WriteValue('                                       / ', ioreal, 3, "(2(F8.4,' '),F8.4,' \')")
          ioreal(1:3) = o%om(2,1:3)
          call WriteValue(trim(pret)//'Orientation Matrix               :  |', ioreal, 3, "(2(F8.4,' '),F8.4,' |')")
          ioreal(1:3) = o%om(3,1:3)
          call WriteValue('                                       \ ', ioreal, 3, "(2(F8.4,' '),F8.4,' /')")

  end select
else
! print the entire record with all representations
  ioreal(1:3) = o%eulang(1:3)*180.0/sngl(cPi)
  call WriteValue(trim(pret)//'Euler angles                     : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:4) = o%axang(1:4)
  ioreal(4) = ioreal(4)*180.0/sngl(cPi)
  call WriteValue(trim(pret)//'Axis angle pair [n; angle]       : ', ioreal, 4, "(3(F8.4,' '),'; ',F8.4)")
  if (o%rodrigues(4).lt.infty()) then
   ioreal(1:3) = o%rodrigues(1:3)*o%rodrigues(4)
   call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 3, "(3(F12.4,' '))")
  else
   ioreal(1:4) = o%rodrigues(1:4)
   call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 4, "(4(F12.4,' '))")
  end if
  ioreal(1:3) = o%homochoric(1:3)
  call WriteValue(trim(pret)//'Homochoric representation        : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:3) = o%cubochoric(1:3)
  call WriteValue(trim(pret)//'Cubochoric representation        : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:4) = o%quat
  call WriteValue(trim(pret)//'Quaternion                       : ', ioreal, 4, "(4(F8.4,' '))")
  ioreal(1:3) = o%stereographic
  call WriteValue(trim(pret)//'Stereographic                    : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:3) = o%rvmap
  call WriteValue(trim(pret)//'Rotation vector map              : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:3) = o%om(1,1:3)
  call WriteValue('                                   / ', ioreal, 3, "(2(F8.4,' '),F8.4,' \')")
  ioreal(1:3) = o%om(2,1:3)
  call WriteValue(trim(pret)//'Orientation Matrix               :  |', ioreal, 3, "(2(F8.4,' '),F8.4,' |')")
  ioreal(1:3) = o%om(3,1:3)
  call WriteValue('                                   \ ', ioreal, 3, "(2(F8.4,' '),F8.4,' /')")
end if

call Message(' ', frm = "(A/)")

end subroutine print_orientation

!--------------------------------------------------------------------------
!
! SUBROUTINE: print_orientation_d
!
!> @author Marc De Graef, Carnegie Mellon University
!
!> @brief  prints a complete orientationtype record or a single entry (double precision)
!
!> @param o orientationtype record
!> @param outtype (optional) indicates which representation to print
!> @param pretext (optional) up to 10 characters that will precede each line
!
!> @date  8/4/13   MDG 1.0 original
!--------------------------------------------------------------------------
recursive subroutine print_orientation_d(o,outtype,pretext)
!DEC$ ATTRIBUTES DLLEXPORT :: print_orientation_d

use local
use io
use constants

IMPLICIT NONE

type(orientationtyped),INTENT(IN)       :: o
character(2),INTENT(IN),OPTIONAL        :: outtype
character(10),INTENT(IN),OPTIONAL       :: pretext

real(kind=dbl)                          :: ioreal(4)
character(10)                           :: pret

pret = ''
if (present(pretext)) pret=trim(pretext)

if (present(outtype)) then
  select case (outtype)
        case ('eu')
          ioreal(1:3) = o%eulang(1:3)*180.D0/cPi
          call WriteValue(trim(pret)//'Euler angles                     : ', ioreal, 3, "(3(F12.7,' '))")

        case ('ax')
          ioreal(1:4) = o%axang(1:4)
          ioreal(4) = ioreal(4)*180.D0/cPi
          call WriteValue(trim(pret)//'Axis angle pair [n; angle]       : ', ioreal, 4, "(3(F12.7,' '),'; ',F12.7)")

        case ('ro')
          if (o%rodrigues(4).lt.inftyd()) then
           ioreal(1:3) = o%rodrigues(1:3)*o%rodrigues(4)
           call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 3, "(3(F16.7,' '))")
          else
           ioreal(1:4) = o%rodrigues(1:4)
           call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 4, "(4(F16.7,' '))")
          end if

        case ('ho')
          ioreal(1:3) = o%homochoric(1:3)
          call WriteValue(trim(pret)//'Homochoric representation        : ', ioreal, 3, "(3(F12.7,' '))")

        case ('cu')
          ioreal(1:3) = o%cubochoric(1:3)
          call WriteValue(trim(pret)//'Cubochoric representation        : ', ioreal, 3, "(3(F12.7,' '))")

        case ('qu')
          ioreal(1:4) = o%quat
          call WriteValue(trim(pret)//'Quaternion                       : ', ioreal, 4, "(4(F12.7,' '))")

        case ('st')
          ioreal(1:3) = o%stereographic
          call WriteValue(trim(pret)//'Stereographic                    : ', ioreal, 3, "(3(F8.4,' '))")

        case ('rv')
          ioreal(1:3) = o%rvmap
          call WriteValue(trim(pret)//'Rotation vector map              : ', ioreal, 3, "(3(F8.4,' '))")

        case ('om')
          ioreal(1:3) = o%om(1,1:3)
          call WriteValue('                                       / ', ioreal, 3, "(2(F8.4,' '),F8.4,' \')")
          ioreal(1:3) = o%om(2,1:3)
          call WriteValue(trim(pret)//'Orientation Matrix               :  |', ioreal, 3, "(2(F8.4,' '),F8.4,' |')")
          ioreal(1:3) = o%om(3,1:3)
          call WriteValue('                                       \ ', ioreal, 3, "(2(F8.4,' '),F8.4,' /')")

  end select
else
! print the entire record with all representations
  ioreal(1:3) = o%eulang(1:3)*180.D0/cPi
  call WriteValue(trim(pret)//'Euler angles                     : ', ioreal, 3, "(3(F12.7,' '))")
  ioreal(1:4) = o%axang(1:4)
  ioreal(4) = ioreal(4)*180.D0/cPi
  call WriteValue(trim(pret)//'Axis angle pair [n; angle]       : ', ioreal, 4, "(3(F12.7,' '),'; ',F12.7)")
  if (o%rodrigues(4).lt.inftyd()) then
   ioreal(1:3) = o%rodrigues(1:3)*o%rodrigues(4)
   call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 3, "(3(F16.7,' '))")
  else
   ioreal(1:4) = o%rodrigues(1:4)
   call WriteValue(trim(pret)//'Rodrigues vector                 : ', ioreal, 4, "(4(F16.7,' '))")
  end if
  ioreal(1:3) = o%homochoric(1:3)
  call WriteValue(trim(pret)//'Homochoric representation        : ', ioreal, 3, "(3(F12.7,' '))")
  ioreal(1:3) = o%cubochoric(1:3)
  call WriteValue(trim(pret)//'Cubochoric representation        : ', ioreal, 3, "(3(F12.7,' '))")
  ioreal(1:4) = o%quat
  call WriteValue(trim(pret)//'Quaternion                       : ', ioreal, 4, "(4(F12.7,' '))")
  ioreal(1:3) = o%stereographic
  call WriteValue(trim(pret)//'Stereographic                    : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:3) = o%rvmap
  call WriteValue(trim(pret)//'Rotation vector map              : ', ioreal, 3, "(3(F8.4,' '))")
  ioreal(1:3) = o%om(1,1:3)
  call WriteValue('                                   / ', ioreal, 3, "(2(F8.4,' '),F8.4,' \')")
  ioreal(1:3) = o%om(2,1:3)
  call WriteValue(trim(pret)//'Orientation Matrix               : | ', ioreal, 3, "(2(F8.4,' '),F8.4,' |')")
  ioreal(1:3) = o%om(3,1:3)
  call WriteValue('                                   \ ', ioreal, 3, "(2(F8.4,' '),F8.4,' /')")
end if

call Message(' ', frm = "(A/)")

end subroutine print_orientation_d

end module rotations