! ###################################################################
! Copyright (c) 2013-2022, 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.
! ###################################################################

module mod_rotations
  !! author: MDG
  !! version: 1.0
  !! date: 01/16/20
  !!
  !! everything that has to do with rotations and conversions between rotations
  !!
  !! <start of original comments for EMsoft version 5.X and earlier>
  !! This module 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 Fall 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 as being active.
  !!
  !! See mod_global.f90 for the definition of epsijk and epsijkd.
  !!
  !! @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
  !! <end of original comments for EMsoft version 5.X and earlier>
  !!
  !! @date  Jan 20  MDG 6.0 conversion of module to class structures
  !!
  !! Here is an example program using the rotation classes
  !!
  !!     program rtest
  !!
  !!     use mod_rotations
  !!
  !!     type(r_T)        :: r     ! define a Rodrigues vector
  !!     type(q_T)        :: q     ! define a quaternion
  !!     type(a_T)        :: a     ! define an axis-angle pair
  !!
  !!     real(kind=dbl)   :: x =  1.D0/dsqrt(3.D0)    ! auxiliary parameter
  !!
  !!     ! set the computational precision to Double
  !!     call setRotationPrecision('Double')
  !!
  !!     ! define an axis angle pair
  !!     a = a_T( adinp = (/ 0.D0, 0.D0, -1.D0, cvtoRadians(45.D0) /) )
  !!     ! generate all equivalent rotation representations
  !!     oo = orientation_T( a )
  !!     ! and print them, converting angles to degrees
  !!     call oo%print_orientation('d')
  !!
  !!     ! let's do a 45° rotation around [111], and start with an axis angle pair, also print it
  !!     a = a_T( adinp = (/ x, x, x, cvtoRadians(45.D0) /) )
  !!     call a%a_print('Input axis angle pair : ')
  !!
  !!     ! convert this to a quaternion and print it
  !!     q = a%aq()
  !!     call q%q_print('Quaternion            : ')
  !!
  !!     ! convert this quaternion to a Rodrigues vector
  !!     r = q%qr()
  !!     call r%r_print('Rodrigues vector      : ')
  !!
  !!     ! and back to an axis angle pair
  !!     a = r%ra()
  !!     call a%a_print('Resulting axis-angle  : ')
  !!
  !!     end program rtest
  !!
  !! The output of this program should be :
  !!
  !! Angles in degrees
  !! Euler angles                     :   45.0000000000     0.0000000000     0.0000000000
  !! Axis angle pair [n; angle]       :    0.0000000000     0.0000000000    -1.0000000000    45.0000000000
  !! Rodrigues vector                 :    0.0000000000     0.0000000000    -1.0000000000     0.4142135624
  !! Homochoric representation        :    0.0000000000     0.0000000000    -0.3886795948
  !! Cubochoric representation        :    0.0000000000     0.0000000000     0.7853981634
  !! Quaternion                       :    0.9238795325     0.0000000000     0.0000000000    -0.3826834324
  !! Stereographic                    :    0.0000000000     0.0000000000    -0.1989123674
  !! Rotation vector                  :    0.0000000000     0.0000000000    -0.7853981634
  !! Orientation Matrix               :
  !!     0.7071067812     0.7071067812     0.0000000000
  !!    -0.7071067812     0.7071067812     0.0000000000
  !!     0.0000000000     0.0000000000     1.0000000000
  !!
  !! Input axis angle pair :    0.5773502692     0.5773502692     0.5773502692     0.7853981634
  !! Quaternion            :    0.9238795325     0.2209423827     0.2209423827     0.2209423827
  !! Rodrigues vector      :    0.5773502692     0.5773502692     0.5773502692     0.4142135624
  !! Resulting axis-angle  :    0.5773502692     0.5773502692     0.5773502692     0.7853981634
  !!--------------------------------------------------

use mod_kinds
use mod_global
use mod_quaternions

IMPLICIT NONE

private

! we use a private parameter and a pair of get/set methods to control the precision (single or double);
! by default, all rotation operations are performed in double precision
logical :: rotdoubleprecision = .TRUE.
public :: setRotationPrecision, getRotationPrecision, toRadians, toDegrees, cvtoRadians, cvtoDegrees, &
          RodriguesProduct, quat_average

interface quat_average
  module procedure quat_average
  module procedure quat_average_d
end interface

interface cvtoRadians
  module procedure toRadians_scalars
  module procedure toRadians_scalard
  module procedure toRadians_vectors
  module procedure toRadians_vectord
end interface

interface cvtoDegrees
  module procedure toDegrees_scalars
  module procedure toDegrees_scalard
  module procedure toDegrees_vectors
  module procedure toDegrees_vectord
end interface

! In addition, we define nine classes, each with 8 conversion routines to other representations.
! Each class has a single and a double precision variable that must be 'set'-ed or 'get'-ed
! with a specific method. The precision is set by a setRotationPrecision call. The conversion
! routines are named with a single origin letter and a single destination letter (different from
! the original version in EMsoft 5.X and earlier !!! ).
!
! r: Rodrigues vector
! s: Stereographic vector
! o: rotation/orientation matrix
! h: homochoric vector
! a: axis angle pair
! v: rotation vector
! c: cubochoric vector
! e: Euler angles
! q: quaternion
!
! each class also has a constructor, and print routine and a validation routine.

type, public :: r_T
private
  real(kind=sgl)    :: r(4)
  real(kind=dbl)    :: rd(4)

  contains
  private

    procedure, pass(self) :: rs_
    procedure, pass(self) :: ro_
    procedure, pass(self) :: rh_
    procedure, pass(self) :: ra_
    procedure, pass(self) :: rv_
    procedure, pass(self) :: rc_
    procedure, pass(self) :: re_
    procedure, pass(self) :: rq_
    procedure, pass(self) :: r_check_
    procedure, pass(self) :: r_print_
    procedure, pass(self) :: r_copy_
    procedure, pass(self) :: r_copyd_
    procedure, pass(self) :: r_set_
    procedure, pass(self) :: r_setd_
    final :: r_destructor

    generic, public :: rs => rs_
    generic, public :: ro => ro_
    generic, public :: rh => rh_
    generic, public :: ra => ra_
    generic, public :: rv => rv_
    generic, public :: rc => rc_
    generic, public :: re => re_
    generic, public :: rq => rq_
    generic, public :: r_check => r_check_
    generic, public :: r_print => r_print_
    generic, public :: r_copy => r_copy_
    generic, public :: r_copyd => r_copyd_
    generic, public :: r_set => r_set_
    generic, public :: r_setd => r_setd_

end type r_T

! the constructor routine for this class
interface r_T
  module procedure r_constructor
end interface r_T

type, public :: s_T
private
  real(kind=sgl)    :: s(3)
  real(kind=dbl)    :: sd(3)

  contains
  private

    procedure, pass(self) :: sr_
    procedure, pass(self) :: so_
    procedure, pass(self) :: sh_
    procedure, pass(self) :: sa_
    procedure, pass(self) :: sv_
    procedure, pass(self) :: sc_
    procedure, pass(self) :: se_
    procedure, pass(self) :: sq_
    procedure, pass(self) :: s_check_
    procedure, pass(self) :: s_print_
    procedure, pass(self) :: s_copy_
    procedure, pass(self) :: s_copyd_
    procedure, pass(self) :: s_set_
    procedure, pass(self) :: s_setd_
    final :: s_destructor

    generic, public :: sr => sr_
    generic, public :: so => so_
    generic, public :: sh => sh_
    generic, public :: sa => sa_
    generic, public :: sv => sv_
    generic, public :: sc => sc_
    generic, public :: se => se_
    generic, public :: sq => sq_
    generic, public :: s_check => s_check_
    generic, public :: s_print => s_print_
    generic, public :: s_copy => s_copy_
    generic, public :: s_copyd => s_copyd_
    generic, public :: s_set => s_set_
    generic, public :: s_setd => s_setd_

end type s_T

! the constructor routine for this class
interface s_T
  module procedure s_constructor
end interface s_T

type, public :: o_T
private
  real(kind=sgl)    :: o(3,3)
  real(kind=dbl)    :: od(3,3)

  contains
  private

    procedure, pass(self) :: or_
    procedure, pass(self) :: os_
    procedure, pass(self) :: oh_
    procedure, pass(self) :: oa_
    procedure, pass(self) :: ov_
    procedure, pass(self) :: oc_
    procedure, pass(self) :: oe_
    procedure, pass(self) :: oq_
    procedure, pass(self) :: o_check_
    procedure, pass(self) :: o_print_
    procedure, pass(self) :: o_copy_
    procedure, pass(self) :: o_copyd_
    procedure, pass(self) :: o_set_
    procedure, pass(self) :: o_setd_
    final :: o_destructor

    generic, public :: or => or_
    generic, public :: os => os_
    generic, public :: oh => oh_
    generic, public :: oa => oa_
    generic, public :: ov => ov_
    generic, public :: oc => oc_
    generic, public :: oe => oe_
    generic, public :: oq => oq_
    generic, public :: o_check => o_check_
    generic, public :: o_print => o_print_
    generic, public :: o_copy => o_copy_
    generic, public :: o_copyd => o_copyd_
    generic, public :: o_set => o_set_
    generic, public :: o_setd => o_setd_

end type o_T

! the constructor routine for this class
interface o_T
  module procedure o_constructor
end interface o_T

type, public :: h_T
private
  real(kind=sgl)    :: h(3)
  real(kind=dbl)    :: hd(3)

  contains
  private

    procedure, pass(self) :: hr_
    procedure, pass(self) :: hs_
    procedure, pass(self) :: ho_
    procedure, pass(self) :: ha_
    procedure, pass(self) :: hv_
    procedure, pass(self) :: hc_
    procedure, pass(self) :: he_
    procedure, pass(self) :: hq_
    procedure, pass(self) :: h_check_
    procedure, pass(self) :: h_print_
    procedure, pass(self) :: h_copy_
    procedure, pass(self) :: h_copyd_
    procedure, pass(self) :: h_set_
    procedure, pass(self) :: h_setd_
    final :: h_destructor

    generic, public :: hr => hr_
    generic, public :: hs => hs_
    generic, public :: ho => ho_
    generic, public :: ha => ha_
    generic, public :: hv => hv_
    generic, public :: hc => hc_
    generic, public :: he => he_
    generic, public :: hq => hq_
    generic, public :: h_check => h_check_
    generic, public :: h_print => h_print_
    generic, public :: h_copy => h_copy_
    generic, public :: h_copyd => h_copyd_
    generic, public :: h_set => h_set_
    generic, public :: h_setd => h_setd_

end type h_T

! the constructor routine for this class
interface h_T
  module procedure h_constructor
end interface h_T

type, public :: a_T
private
  real(kind=sgl)    :: a(4)
  real(kind=dbl)    :: ad(4)

  contains
  private

    procedure, pass(self) :: ar_
    procedure, pass(self) :: as_
    procedure, pass(self) :: ao_
    procedure, pass(self) :: ah_
    procedure, pass(self) :: av_
    procedure, pass(self) :: ac_
    procedure, pass(self) :: ae_
    procedure, pass(self) :: aq_
    procedure, pass(self) :: a_check_
    procedure, pass(self) :: a_print_
    procedure, pass(self) :: a_copy_
    procedure, pass(self) :: a_copyd_
    procedure, pass(self) :: a_set_
    procedure, pass(self) :: a_setd_
    final :: a_destructor

    generic, public :: ar => ar_
    generic, public :: as => as_
    generic, public :: ao => ao_
    generic, public :: ah => ah_
    generic, public :: av => av_
    generic, public :: ac => ac_
    generic, public :: ae => ae_
    generic, public :: aq => aq_
    generic, public :: a_check => a_check_
    generic, public :: a_print => a_print_
    generic, public :: a_copy => a_copy_
    generic, public :: a_copyd => a_copyd_
    generic, public :: a_set => a_set_
    generic, public :: a_setd => a_setd_

end type a_T

! the constructor routine for this class
interface a_T
  module procedure a_constructor
end interface a_T

type, public :: v_T
private
  real(kind=sgl)    :: v(3)
  real(kind=dbl)    :: vd(3)

  contains
  private

    procedure, pass(self) :: vr_
    procedure, pass(self) :: vs_
    procedure, pass(self) :: vo_
    procedure, pass(self) :: vh_
    procedure, pass(self) :: va_
    procedure, pass(self) :: vc_
    procedure, pass(self) :: ve_
    procedure, pass(self) :: vq_
    procedure, pass(self) :: v_check_
    procedure, pass(self) :: v_print_
    procedure, pass(self) :: v_copy_
    procedure, pass(self) :: v_copyd_
    procedure, pass(self) :: v_set_
    procedure, pass(self) :: v_setd_
    final :: v_destructor

    generic, public :: vr => vr_
    generic, public :: vs => vs_
    generic, public :: vo => vo_
    generic, public :: vh => vh_
    generic, public :: va => va_
    generic, public :: vc => vc_
    generic, public :: ve => ve_
    generic, public :: vq => vq_
    generic, public :: v_check => v_check_
    generic, public :: v_print => v_print_
    generic, public :: v_copy => v_copy_
    generic, public :: v_copyd => v_copyd_
    generic, public :: v_set => v_set_
    generic, public :: v_setd => v_setd_

end type v_T

! the constructor routine for this class
interface v_T
  module procedure v_constructor
end interface v_T

type, public :: c_T
private
  real(kind=sgl)    :: c(3)
  real(kind=dbl)    :: cd(3)

  contains
  private

    procedure, pass(self) :: cr_
    procedure, pass(self) :: cs_
    procedure, pass(self) :: co_
    procedure, pass(self) :: ch_
    procedure, pass(self) :: ca_
    procedure, pass(self) :: cv_
    procedure, pass(self) :: ce_
    procedure, pass(self) :: cq_
    procedure, pass(self) :: c_check_
    procedure, pass(self) :: c_print_
    procedure, pass(self) :: c_copy_
    procedure, pass(self) :: c_copyd_
    procedure, pass(self) :: c_set_
    procedure, pass(self) :: c_setd_
    final :: c_destructor

    generic, public :: cr => cr_
    generic, public :: cs => cs_
    generic, public :: co => co_
    generic, public :: ch => ch_
    generic, public :: ca => ca_
    generic, public :: cv => cv_
    generic, public :: ce => ce_
    generic, public :: cq => cq_
    generic, public :: c_check => c_check_
    generic, public :: c_print => c_print_
    generic, public :: c_copy => c_copy_
    generic, public :: c_copyd => c_copyd_
    generic, public :: c_set => c_set_
    generic, public :: c_setd => c_setd_

end type c_T

! the constructor routine for this class
interface c_T
  module procedure c_constructor
end interface c_T

type, public :: e_T
private
  real(kind=sgl)    :: e(3)
  real(kind=dbl)    :: ed(3)

  contains
  private

    procedure, pass(self) :: er_
    procedure, pass(self) :: es_
    procedure, pass(self) :: eo_
    procedure, pass(self) :: eh_
    procedure, pass(self) :: ea_
    procedure, pass(self) :: ev_
    procedure, pass(self) :: ec_
    procedure, pass(self) :: eq_
    procedure, pass(self) :: e_check_
    procedure, pass(self) :: e_print_
    procedure, pass(self) :: e_copy_
    procedure, pass(self) :: e_copyd_
    procedure, pass(self) :: e_set_
    procedure, pass(self) :: e_setd_
    final :: e_destructor

    generic, public :: er => er_
    generic, public :: es => es_
    generic, public :: eo => eo_
    generic, public :: eh => eh_
    generic, public :: ea => ea_
    generic, public :: ev => ev_
    generic, public :: ec => ec_
    generic, public :: eq => eq_
    generic, public :: e_check => e_check_
    generic, public :: e_print => e_print_
    generic, public :: e_copy => e_copy_
    generic, public :: e_copyd => e_copyd_
    generic, public :: e_set => e_set_
    generic, public :: e_setd => e_setd_

end type e_T

! the constructor routine for this class
interface e_T
  module procedure e_constructor
end interface e_T

type, public :: q_T
private
  real(kind=sgl)    :: q(4)
  real(kind=dbl)    :: qd(4)

  contains
  private

    procedure, pass(self) :: qr_
    procedure, pass(self) :: qs_
    procedure, pass(self) :: qo_
    procedure, pass(self) :: qh_
    procedure, pass(self) :: qa_
    procedure, pass(self) :: qv_
    procedure, pass(self) :: qc_
    procedure, pass(self) :: qe_
    procedure, pass(self) :: q_check_
    procedure, pass(self) :: q_print_
    procedure, pass(self) :: q_copy_
    procedure, pass(self) :: q_copyd_
    procedure, pass(self) :: q_set_
    procedure, pass(self) :: q_setd_
    final :: q_destructor

    generic, public :: qr => qr_
    generic, public :: qs => qs_
    generic, public :: qo => qo_
    generic, public :: qh => qh_
    generic, public :: qa => qa_
    generic, public :: qv => qv_
    generic, public :: qc => qc_
    generic, public :: qe => qe_
    generic, public :: q_check => q_check_
    generic, public :: q_print => q_print_
    generic, public :: q_copy => q_copy_
    generic, public :: q_copyd => q_copyd_
    generic, public :: q_set => q_set_
    generic, public :: q_setd => q_setd_

end type q_T

! the constructor routine for this class
interface q_T
  module procedure q_constructor
end interface q_T

! DLL Export statements

!!DEC$ ATTRIBUTES DLLEXPORT :: cvtoRadians
!!DEC$ ATTRIBUTES DLLEXPORT :: cvtoDegrees
!!DEC$ ATTRIBUTES DLLEXPORT :: init_orientation

! We also define an orientation class that contains, for a given orientation, all the equivalent representations
! This class uses the nine classes defined above for all conversions.  The class has a constructor and
! some output options.
type, public :: orientation_T
private
    type(e_T) :: e ! Bunge Euler angles in radians
    type(o_T) :: o ! 3x3 rotation matrix
    type(a_T) :: a ! axis-angle pair (angle in rad, component 4; axis in direction cosines)
    type(r_T) :: r ! Rodrigues vector (stored as direction cosines and length, to allow for Infinity)
    type(q_T) :: q ! quaternion representation (q(1) is scalar part, q(2:4) vector part)
    type(h_T) :: h ! homochoric representation according to Frank's paper
    type(c_T) :: c ! cubic grid representation (derived from homochoric)
    type(s_T) :: s ! 3D stereographic  [added 10/05/17]
    type(v_T) :: v ! rotation vector [added 10/25/19]

  contains
  private

    procedure, pass(self) :: print_orientation_
    procedure, pass(self) :: getClass_e_
    procedure, pass(self) :: getClass_o_
    procedure, pass(self) :: getClass_a_
    procedure, pass(self) :: getClass_r_
    procedure, pass(self) :: getClass_q_
    procedure, pass(self) :: getClass_h_
    procedure, pass(self) :: getClass_s_
    procedure, pass(self) :: getClass_c_
    procedure, pass(self) :: getClass_v_
    procedure, pass(self) :: get_e_
    procedure, pass(self) :: get_o_
    procedure, pass(self) :: get_a_
    procedure, pass(self) :: get_r_
    procedure, pass(self) :: get_q_
    procedure, pass(self) :: get_h_
    procedure, pass(self) :: get_s_
    procedure, pass(self) :: get_c_
    procedure, pass(self) :: get_v_
    procedure, pass(self) :: get_ed_
    procedure, pass(self) :: get_od_
    procedure, pass(self) :: get_ad_
    procedure, pass(self) :: get_rd_
    procedure, pass(self) :: get_qd_
    procedure, pass(self) :: get_hd_
    procedure, pass(self) :: get_sd_
    procedure, pass(self) :: get_cd_
    procedure, pass(self) :: get_vd_
    ! final :: orientation_destructor

    generic, public :: print_orientation => print_orientation_
    generic, public :: getClass_e => getClass_e_
    generic, public :: getClass_o => getClass_o_
    generic, public :: getClass_a => getClass_a_
    generic, public :: getClass_r => getClass_r_
    generic, public :: getClass_q => getClass_q_
    generic, public :: getClass_h => getClass_h_
    generic, public :: getClass_s => getClass_s_
    generic, public :: getClass_c => getClass_c_
    generic, public :: getClass_v => getClass_v_
    generic, public :: get_e => get_e_
    generic, public :: get_o => get_o_
    generic, public :: get_a => get_a_
    generic, public :: get_r => get_r_
    generic, public :: get_q => get_q_
    generic, public :: get_h => get_h_
    generic, public :: get_s => get_s_
    generic, public :: get_c => get_c_
    generic, public :: get_v => get_v_
    generic, public :: get_ed => get_ed_
    generic, public :: get_od => get_od_
    generic, public :: get_ad => get_ad_
    generic, public :: get_rd => get_rd_
    generic, public :: get_qd => get_qd_
    generic, public :: get_hd => get_hd_
    generic, public :: get_sd => get_sd_
    generic, public :: get_cd => get_cd_
    generic, public :: get_vd => get_vd_

end type orientation_T

! the constructor routine for this class
interface orientation_T
  module procedure orientation_constructor
end interface orientation_T

! finally we have a method to extract a quaternion class from an arbitrary class
! using unlimited polymorphic variables
public :: getQfromClass

!--------------------------------------------------------------------------

contains

!--------------------------------------------------------------------------
type(r_T) function r_constructor( rinp, rdinp ) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: r_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the r_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: rinp(4)
real(kind=dbl),INTENT(IN),OPTIONAL   :: rdinp(4)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(rdinp)) r%rd = rdinp
else
  if (present(rinp)) r%r = rinp
end if

if (rotationRangeCheck) ierr = r%r_check()

end function r_constructor

!--------------------------------------------------------------------------
subroutine r_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: r_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the r_T Class

IMPLICIT NONE

type(r_T), INTENT(INOUT)  :: self

! call reportDestructor('r_T')

end subroutine r_destructor

!--------------------------------------------------------------------------
type(s_T) function s_constructor( sinp, sdinp ) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: s_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the s_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: sinp(3)
real(kind=dbl),INTENT(IN),OPTIONAL   :: sdinp(3)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(sdinp)) s%sd = sdinp
else
  if (present(sinp)) s%s = sinp
end if

if (rotationRangeCheck) ierr = s%s_check()

end function s_constructor

!--------------------------------------------------------------------------
subroutine s_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: s_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the s_T Class

IMPLICIT NONE

type(s_T), INTENT(INOUT)  :: self

! call reportDestructor('s_T')

end subroutine s_destructor

!--------------------------------------------------------------------------
type(o_T) function o_constructor( oinp, odinp ) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: o_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the o_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: oinp(3,3)
real(kind=dbl),INTENT(IN),OPTIONAL   :: odinp(3,3)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(odinp)) o%od = odinp
else
  if (present(oinp)) o%o = oinp
end if

if (rotationRangeCheck) ierr = o%o_check()

end function o_constructor

!--------------------------------------------------------------------------
subroutine o_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: o_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the o_T Class

IMPLICIT NONE

type(o_T), INTENT(INOUT)  :: self

! call reportDestructor('o_T')

end subroutine o_destructor

!--------------------------------------------------------------------------
type(h_T) function h_constructor( hinp, hdinp ) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: h_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the h_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: hinp(3)
real(kind=dbl),INTENT(IN),OPTIONAL   :: hdinp(3)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(hdinp)) h%hd = hdinp
else
  if (present(hinp)) h%h = hinp
end if

if (rotationRangeCheck) ierr = h%h_check()

end function h_constructor

!--------------------------------------------------------------------------
subroutine h_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: h_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the h_T Class

IMPLICIT NONE

type(h_T), INTENT(INOUT)  :: self

! call reportDestructor('h_T')

end subroutine h_destructor

!--------------------------------------------------------------------------
type(a_T) function a_constructor( ainp, adinp ) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: a_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the a_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: ainp(4)
real(kind=dbl),INTENT(IN),OPTIONAL   :: adinp(4)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(adinp)) a%ad = adinp
else
  if (present(ainp)) a%a = ainp
end if

if (rotationRangeCheck) ierr = a%a_check()

end function a_constructor

!--------------------------------------------------------------------------
subroutine a_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: a_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the a_T Class

IMPLICIT NONE

type(a_T), INTENT(INOUT)  :: self

! call reportDestructor('a_T')

end subroutine a_destructor

!--------------------------------------------------------------------------
type(v_T) function v_constructor( vinp, vdinp ) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: v_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the v_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: vinp(3)
real(kind=dbl),INTENT(IN),OPTIONAL   :: vdinp(3)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(vdinp)) v%vd = vdinp
else
  if (present(vinp)) v%v = vinp
end if

if (rotationRangeCheck) ierr = v%v_check()

end function v_constructor

!--------------------------------------------------------------------------
subroutine v_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: v_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the v_T Class

IMPLICIT NONE

type(v_T), INTENT(INOUT)  :: self

! call reportDestructor('v_T')

end subroutine v_destructor

!--------------------------------------------------------------------------
type(c_T) function c_constructor( cinp, cdinp ) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: c_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the c_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: cinp(3)
real(kind=dbl),INTENT(IN),OPTIONAL   :: cdinp(3)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(cdinp)) c%cd = cdinp
else
  if (present(cinp)) c%c = cinp
end if

if (rotationRangeCheck) ierr = c%c_check()

end function c_constructor

!--------------------------------------------------------------------------
subroutine c_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: c_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the c_T Class

IMPLICIT NONE

type(c_T), INTENT(INOUT)  :: self

! call reportDestructor('c_T')

end subroutine c_destructor

!--------------------------------------------------------------------------
type(e_T) function e_constructor( einp, edinp ) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: e_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the e_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: einp(3)
real(kind=dbl),INTENT(IN),OPTIONAL   :: edinp(3)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(edinp)) e%ed = edinp
else
  if (present(einp)) e%e = einp
end if

if (rotationRangeCheck) ierr = e%e_check()

end function e_constructor

!--------------------------------------------------------------------------
subroutine e_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: e_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the e_T Class

IMPLICIT NONE

type(e_T), INTENT(INOUT)  :: self

! call reportDestructor('e_T')

end subroutine e_destructor

!--------------------------------------------------------------------------
type(q_T) function q_constructor( qinp, qdinp ) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: q_constructor
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! constructor for the q_T Class

IMPLICIT NONE

real(kind=sgl),INTENT(IN),OPTIONAL   :: qinp(4)
real(kind=dbl),INTENT(IN),OPTIONAL   :: qdinp(4)

integer(kind=irg)                    :: ierr

if (rotdoubleprecision) then
  if (present(qdinp)) q%qd = qdinp
else
  if (present(qinp)) q%q = qinp
end if

if (rotationRangeCheck) ierr = q%q_check()

end function q_constructor

!--------------------------------------------------------------------------
subroutine q_destructor(self)
!DEC$ ATTRIBUTES DLLEXPORT :: q_destructor
!! author: MDG
!! version: 1.0
!! date: 02/02/20
!!
!! destructor for the q_T Class

IMPLICIT NONE

type(q_T), INTENT(INOUT)  :: self

! call reportDestructor('q_T')

end subroutine q_destructor

!--------------------------------------------------------------------------
type(orientation_T) function orientation_constructor( p ) result(or)
!DEC$ ATTRIBUTES DLLEXPORT :: orientation_constructor
!! author: MDG
!! version: 1.0
!! date: 01/18/20
!!
!! constructor for the orientation_T Class

class(*), INTENT(INOUT)      :: p

select type (p)
  class is (e_T)
    if (rotdoubleprecision) then
      or%e = e_T( edinp = p%ed )
    else
      or%e = e_T( einp = p%e )
    end if
    or%o = or%e%eo()
    or%q = or%e%eq()
    or%r = or%e%er()
    or%a = or%e%ea()
    or%h = or%e%eh()
    or%c = or%e%ec()
    or%s = or%e%es()
    or%v = or%e%ev()
  class is (o_T)
    if (rotdoubleprecision) then
      or%o = o_T( odinp = p%od )
    else
      or%o = o_T( oinp = p%o )
    end if
    or%e = or%o%oe()
    or%q = or%o%oq()
    or%r = or%o%or()
    or%a = or%o%oa()
    or%h = or%o%oh()
    or%c = or%o%oc()
    or%s = or%o%os()
    or%v = or%o%ov()
  class is (a_T)
    if (rotdoubleprecision) then
      or%a = a_T( adinp = p%ad )
    else
      or%a = a_T( ainp = p%a )
    end if
    or%v = or%a%av()
    or%e = or%a%ae()
    or%o = or%a%ao()
    or%s = or%a%as()
    or%q = or%a%aq()
    or%h = or%a%ah()
    or%c = or%a%ac()
    or%r = or%a%ar()
  class is (r_T)
    if (rotdoubleprecision) then
      or%r = r_T( rdinp = p%rd )
    else
      or%r = r_T( rinp = p%r )
    end if
    or%e = or%r%re()
    or%o = or%r%ro()
    or%q = or%r%rq()
    or%a = or%r%ra()
    or%h = or%r%rh()
    or%c = or%r%rc()
    or%s = or%r%rs()
    or%v = or%r%rv()
  class is (q_T)
    if (rotdoubleprecision) then
      or%q = q_T( qdinp = p%qd )
    else
      or%q = q_T( qinp = p%q )
    end if
    or%v = or%q%qv()
    or%e = or%q%qe()
    or%o = or%q%qo()
    or%s = or%q%qs()
    or%a = or%q%qa()
    or%h = or%q%qh()
    or%c = or%q%qc()
    or%r = or%q%qr()
  class is (h_t)
    if (rotdoubleprecision) then
      or%h = h_T( hdinp = p%hd )
    else
      or%h = h_T( hinp = p%h )
    end if
    or%v = or%h%hv()
    or%e = or%h%he()
    or%o = or%h%ho()
    or%q = or%h%hq()
    or%a = or%h%ha()
    or%c = or%h%hc()
    or%s = or%h%hs()
    or%r = or%h%hr()
  class is (c_T)
    if (rotdoubleprecision) then
      or%c = c_T( cdinp = p%cd )
    else
      or%c = c_T( cinp = p%c )
    end if
    or%v = or%c%cv()
    or%e = or%c%ce()
    or%o = or%c%co()
    or%q = or%c%cq()
    or%a = or%c%ca()
    or%h = or%c%ch()
    or%s = or%c%cs()
    or%r = or%c%cr()
  class is (s_T)
    if (rotdoubleprecision) then
      or%s = s_T( sdinp = p%sd )
    else
      or%s = s_T( sinp = p%s)
    end if
    or%v = or%s%sv()
    or%e = or%s%se()
    or%o = or%s%so()
    or%q = or%s%sq()
    or%a = or%s%sa()
    or%h = or%s%sh()
    or%c = or%s%sc()
    or%r = or%s%sr()
  class is (v_T)
    if (rotdoubleprecision) then
      or%v = v_T( vdinp = p%vd )
    else
      or%v = v_T( vinp = p%v )
    end if
    or%a = or%v%va()
    or%e = or%v%ve()
    or%o = or%v%vo()
    or%s = or%v%vs()
    or%q = or%v%vq()
    or%h = or%v%vh()
    or%c = or%v%vc()
    or%r = or%v%vr()
  class default
end select

end function orientation_constructor

! this is commented out because the gfortran 6.3.1 compiler produces an internal compiler error
! f951: internal compiler error: in generate_finalization_wrapper, at fortran/class.c:1974

! f951: internal compiler error: Abort trap: 6
! gfortran: internal compiler error: Abort trap: 6 (program f951)

! !--------------------------------------------------------------------------
! subroutine orientation_destructor(self)
! !! author: MDG
! !! version: 1.0
! !! date: 02/02/20
! !!
! !! destructor for the orientation_T Class

! IMPLICIT NONE

! type(orientation_T), INTENT(INOUT)  :: self

! ! call reportDestructor('orientation_T')

! end subroutine orientation_destructor

!--------------------------------------------------------------------------
function getQfromClass( p ) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: getQfromClass
!! author: MDG
!! version: 1.0
!! date: 01/18/20
!!
!! take an arbitrary rotation class and convert it to the q_T class

use mod_quaternions

class(*), INTENT(INOUT)      :: p

type(Quaternion_T)           :: q
type(q_T)                    :: qq

select type (p)
  class is (e_T)
    qq = p%eq()
  class is (a_T)
    qq = p%aq()
  class is (o_T)
    qq = p%oq()
  class is (r_T)
    qq = p%rq()
  class is (h_T)
    qq = p%hq()
  class is (c_T)
    qq = p%cq()
  class is (s_T)
    qq = p%sq()
  class is (v_T)
    qq = p%vq()
  class is (q_T)
    qq = p
  class default
end select

q = Quaternion_T( qd = qq%q_copyd() )

end function getQfromClass

!--------------------------------------------------------------------------
recursive subroutine print_orientation_(self, degrad)
!DEC$ ATTRIBUTES DLLEXPORT :: print_orientation_
 !! author: MDG
 !! version: 1.0
 !! date: 01/18/20
 !!
 !! prints a complete orientationtype record

use mod_io

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
character(1),INTENT(IN)                 :: degrad

type(IO_T)                              :: Message
real(kind=sgl)                          :: ioreal(4)

! print the entire record with all representations
  if (degrad.eq.'d') then
    call Message%printMessage('Angles in degrees')

    call toDegrees(self%e)
    call self%e%e_print('Euler angles                     : ')
    call toRadians(self%e)

    call toDegrees(self%a)
    call self%a%a_print('Axis angle pair [n; angle]       : ')
    call toRadians(self%a)
  else
    call Message%printMessage('Angles in radians')

    call self%e%e_print('Euler angles                     : ')

    call self%a%a_print('Axis angle pair [n; angle]       : ')
  end if

  call self%r%r_print('Rodrigues vector                 : ')
  call self%h%h_print('Homochoric representation        : ')
  call self%c%c_print('Cubochoric representation        : ')
  call self%q%q_print('Quaternion                       : ')
  call self%s%s_print('Stereographic                    : ')
  call self%v%v_print('Rotation vector                  : ')
  call self%o%o_print('Orientation Matrix               : ')

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

end subroutine print_orientation_

!--------------------------------------------------------------------------
recursive function getClass_e_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_e_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(e_T)                               :: e

e = self%e

end function getClass_e_

!--------------------------------------------------------------------------
recursive function getClass_o_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_o_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(o_T)                               :: o

o = self%o

end function getClass_o_

!--------------------------------------------------------------------------
recursive function getClass_a_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_a_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(a_T)                               :: a

a = self%a

end function getClass_a_

!--------------------------------------------------------------------------
recursive function getClass_r_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_r_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(r_T)                               :: r

r = self%r

end function getClass_r_

!--------------------------------------------------------------------------
recursive function getClass_q_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT ::  getClass_q_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(q_T)                               :: q

q = self%q

end function getClass_q_

!--------------------------------------------------------------------------
recursive function getClass_h_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_h_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(h_T)                               :: h

h = self%h

end function getClass_h_

!--------------------------------------------------------------------------
recursive function getClass_c_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_c_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(c_T)                               :: c

c = self%c

end function getClass_c_

!--------------------------------------------------------------------------
recursive function getClass_s_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_s_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(s_T)                               :: s

s = self%s

end function getClass_s_

!--------------------------------------------------------------------------
recursive function getClass_v_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: getClass_v_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
type(v_T)                               :: v

v = self%v

end function getClass_v_

!--------------------------------------------------------------------------
recursive function get_e_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: get_e_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: e(3)

e = self%e%e

end function get_e_

!--------------------------------------------------------------------------
recursive function get_ed_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: get_ed_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: e(3)

e = self%e%ed

end function get_ed_

!--------------------------------------------------------------------------
recursive function get_o_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: get_o_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: o(3,3)

o = self%o%o

end function get_o_

!--------------------------------------------------------------------------
recursive function get_od_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: get_od_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: o(3,3)

o = self%o%od

end function get_od_

!--------------------------------------------------------------------------
recursive function get_a_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: get_a_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: a(4)

a = self%a%a

end function get_a_

!--------------------------------------------------------------------------
recursive function get_ad_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: get_ad_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: a(4)

a = self%a%ad

end function get_ad_

!--------------------------------------------------------------------------
recursive function get_r_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: get_r_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: r(4)

r = self%r%r

end function get_r_

!--------------------------------------------------------------------------
recursive function get_rd_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: get_rd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: r(4)

r = self%r%rd

end function get_rd_

!--------------------------------------------------------------------------
recursive function get_q_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: get_q_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: q(4)

q = self%q%q

end function get_q_

!--------------------------------------------------------------------------
recursive function get_qd_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: get_qd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: q(4)

q = self%q%qd

end function get_qd_

!--------------------------------------------------------------------------
recursive function get_h_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: get_h_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: h(3)

h = self%h%h

end function get_h_

!--------------------------------------------------------------------------
recursive function get_hd_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: get_hd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: h(3)

h = self%h%hd

end function get_hd_

!--------------------------------------------------------------------------
recursive function get_c_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: get_c_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: c(3)

c = self%c%c

end function get_c_

!--------------------------------------------------------------------------
recursive function get_cd_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: get_cd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: c(3)

c = self%c%cd

end function get_cd_

!--------------------------------------------------------------------------
recursive function get_s_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: get_s_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: s(3)

s = self%s%s

end function get_s_

!--------------------------------------------------------------------------
recursive function get_sd_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: get_sd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: s(3)

s = self%s%sd

end function get_sd_

!--------------------------------------------------------------------------
recursive function get_v_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: get_v_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=sgl)                          :: v(3)

v = self%v%v

end function get_v_

!--------------------------------------------------------------------------
recursive function get_vd_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: get_vd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(orientation_T),INTENT(INOUT)      :: self
real(kind=dbl)                          :: v(3)

v = self%v%vd

end function get_vd_

!--------------------------------------------------------------------------
recursive function e_copy_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: e_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(e_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: e(3)

e = self%e

end function e_copy_

!--------------------------------------------------------------------------
recursive function e_copyd_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: e_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(e_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: e(3)

e = self%ed

end function e_copyd_

!--------------------------------------------------------------------------
recursive function o_copy_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: o_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(o_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: o(3,3)

o = self%o

end function o_copy_

!--------------------------------------------------------------------------
recursive function o_copyd_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: o_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(o_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: o(3,3)

o = self%od

end function o_copyd_

!--------------------------------------------------------------------------
recursive function a_copy_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: a_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(a_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: a(4)

a = self%a

end function a_copy_

!--------------------------------------------------------------------------
recursive function a_copyd_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: a_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(a_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: a(4)

a = self%ad

end function a_copyd_

!--------------------------------------------------------------------------
recursive function r_copy_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: r_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(r_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: r(4)

r = self%r

end function r_copy_

!--------------------------------------------------------------------------
recursive function r_copyd_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: r_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(r_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: r(4)

r = self%rd

end function r_copyd_

!--------------------------------------------------------------------------
recursive function q_copy_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: q_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(q_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: q(4)

q = self%q

end function q_copy_

!--------------------------------------------------------------------------
recursive function q_copyd_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: q_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(q_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: q(4)

q = self%qd

end function q_copyd_

!--------------------------------------------------------------------------
recursive function h_copy_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: h_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(h_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: h(3)

h = self%h

end function h_copy_

!--------------------------------------------------------------------------
recursive function h_copyd_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: h_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(h_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: h(3)

h = self%hd

end function h_copyd_

!--------------------------------------------------------------------------
recursive function c_copy_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: c_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(c_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: c(3)

c = self%c

end function c_copy_

!--------------------------------------------------------------------------
recursive function c_copyd_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: c_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(c_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: c(3)

c = self%cd

end function c_copyd_

!--------------------------------------------------------------------------
recursive function s_copy_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: s_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(s_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: s(3)

s = self%s

end function s_copy_

!--------------------------------------------------------------------------
recursive function s_copyd_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: s_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(s_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: s(3)

s = self%sd

end function s_copyd_

!--------------------------------------------------------------------------
recursive function v_copy_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: v_copy_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(v_T),INTENT(INOUT)      :: self
real(kind=sgl)                :: v(3)

v = self%v

end function v_copy_

!--------------------------------------------------------------------------
recursive function v_copyd_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: v_copyd_
 !! author: MDG
 !! version: 1.0
 !! date: 01/20/20
 !!
 !! extract a member from the orientations class

IMPLICIT NONE

class(v_T),INTENT(INOUT)      :: self
real(kind=dbl)                :: v(3)

v = self%vd

end function v_copyd_

!--------------------------------------------------------------------------
recursive subroutine r_set_(self, r)
!DEC$ ATTRIBUTES DLLEXPORT :: r_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(r_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: r(4)

self%r = r

end subroutine r_set_

!--------------------------------------------------------------------------
recursive subroutine r_setd_(self, r)
!DEC$ ATTRIBUTES DLLEXPORT :: r_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(r_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: r(4)

self%rd = r

end subroutine r_setd_

!--------------------------------------------------------------------------
recursive subroutine v_set_(self, v)
!DEC$ ATTRIBUTES DLLEXPORT :: v_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(v_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: v(3)

self%v = v

end subroutine v_set_

!--------------------------------------------------------------------------
recursive subroutine v_setd_(self, v)
!DEC$ ATTRIBUTES DLLEXPORT :: v_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(v_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: v(3)

self%vd = v

end subroutine v_setd_

!--------------------------------------------------------------------------
recursive subroutine a_set_(self, a)
!DEC$ ATTRIBUTES DLLEXPORT :: a_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(a_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: a(4)

self%a = a

end subroutine a_set_

!--------------------------------------------------------------------------
recursive subroutine a_setd_(self, a)
!DEC$ ATTRIBUTES DLLEXPORT :: a_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(a_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: a(4)

self%ad = a

end subroutine a_setd_

!--------------------------------------------------------------------------
recursive subroutine q_set_(self, q)
!DEC$ ATTRIBUTES DLLEXPORT :: q_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(q_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: q(4)

self%q = q

end subroutine q_set_

!--------------------------------------------------------------------------
recursive subroutine q_setd_(self, q)
!DEC$ ATTRIBUTES DLLEXPORT :: q_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(q_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: q(4)

self%qd = q

end subroutine q_setd_

!--------------------------------------------------------------------------
recursive subroutine s_set_(self, s)
!DEC$ ATTRIBUTES DLLEXPORT :: s_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(s_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: s(3)

self%s = s

end subroutine s_set_

!--------------------------------------------------------------------------
recursive subroutine s_setd_(self, s)
!DEC$ ATTRIBUTES DLLEXPORT :: s_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(s_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: s(3)

self%sd = s

end subroutine s_setd_

!--------------------------------------------------------------------------
recursive subroutine h_set_(self, h)
!DEC$ ATTRIBUTES DLLEXPORT :: h_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(h_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: h(3)

self%h = h

end subroutine h_set_

!--------------------------------------------------------------------------
recursive subroutine h_setd_(self, h)
!DEC$ ATTRIBUTES DLLEXPORT :: h_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(h_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: h(3)

self%hd = h

end subroutine h_setd_

!--------------------------------------------------------------------------
recursive subroutine c_set_(self, c)
!DEC$ ATTRIBUTES DLLEXPORT :: c_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(c_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: c(3)

self%c = c

end subroutine c_set_

!--------------------------------------------------------------------------
recursive subroutine c_setd_(self, c)
!DEC$ ATTRIBUTES DLLEXPORT :: c_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(c_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: c(3)

self%cd = c

end subroutine c_setd_

!--------------------------------------------------------------------------
recursive subroutine e_set_(self, e)
!DEC$ ATTRIBUTES DLLEXPORT :: e_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(e_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: e(3)

self%e = e

end subroutine e_set_

!--------------------------------------------------------------------------
recursive subroutine e_setd_(self, e)
!DEC$ ATTRIBUTES DLLEXPORT :: e_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(e_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: e(3)

self%ed = e

end subroutine e_setd_

!--------------------------------------------------------------------------
recursive subroutine o_set_(self, o)
!DEC$ ATTRIBUTES DLLEXPORT :: o_set_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(o_T),INTENT(INOUT)      :: self
real(kind=sgl),INTENT(IN)     :: o(3,3)

self%o = o

end subroutine o_set_

!--------------------------------------------------------------------------
recursive subroutine o_setd_(self, o)
!DEC$ ATTRIBUTES DLLEXPORT :: o_setd_
 !! author: MDG
 !! version: 1.0
 !! date: 02/17/20
 !!
 !! set a rotation value

IMPLICIT NONE

class(o_T),INTENT(INOUT)      :: self
real(kind=dbl),INTENT(IN)     :: o(3,3)

self%od = o

end subroutine o_setd_

!--------------------------------------------------------------------------
recursive subroutine toDegrees(self)
!DEC$ ATTRIBUTES DLLEXPORT :: toDegrees
 !! author: MDG
 !! version: 1.0
 !! date: 01/18/20
 !!
 !! convert the representation to degrees; uses an unlimited polymorphic entity
 !!
 !! the only representations that actually use angles are Euler and axis-angle

IMPLICIT NONE

class(*), intent(inout)  :: self

select type(self)
  class is (e_T)
    if (rotdoubleprecision) then
      self%ed = self%ed * rtod
    else
      self%e = self%e * sngl(rtod)
    end if

  class is (a_T)
    if (rotdoubleprecision) then
      self%ad(4) = self%ad(4) * rtod
    else
      self%a(4) = self%a(4) * sngl(rtod)
    end if

  class default
end select

end subroutine toDegrees

!--------------------------------------------------------------------------
recursive subroutine toRadians(self)
!DEC$ ATTRIBUTES DLLEXPORT :: toRadians
 !! author: MDG
 !! version: 1.0
 !! date: 01/18/20
 !!
 !! convert the representation to radians; uses an unlimited polymorphic entity
 !!
 !! the only representations that actually use angles are Euler and axis-angle

IMPLICIT NONE

class(*), intent(inout)  :: self

select type(self)
  class is (e_T)
    if (rotdoubleprecision) then
      self%ed = self%ed * dtor
    else
      self%e = self%e * sngl(dtor)
    end if

  class is (a_T)
    if (rotdoubleprecision) then
      self%ad(4) = self%ad(4) * dtor
    else
      self%a(4) = self%a(4) * sngl(dtor)
    end if

  class default
end select

end subroutine toRadians

!--------------------------------------------------------------------------
recursive function toDegrees_scalard( r ) result(d)
!DEC$ ATTRIBUTES DLLEXPORT :: toDegrees_scalard
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to degrees (double precision)

IMPLICIT NONE

real(kind=dbl), INTENT(IN)    :: r
real(kind=dbl)                :: d

d = r * rtod

end function toDegrees_scalard

!--------------------------------------------------------------------------
recursive function toDegrees_scalars( r ) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: toDegrees_scalars
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to degrees (single precision)

IMPLICIT NONE

real(kind=sgl), INTENT(IN)    :: r
real(kind=sgl)                :: s

s = r * sngl(rtod)

end function toDegrees_scalars

!--------------------------------------------------------------------------
recursive function toRadians_scalard( d ) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: toRadians_scalard
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to radians (double precision)

IMPLICIT NONE

real(kind=dbl), INTENT(IN)    :: d
real(kind=dbl)                :: r

r = d * dtor

end function toRadians_scalard

!--------------------------------------------------------------------------
recursive function toRadians_scalars( d ) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: toRadians_scalars
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to radians (single precision)

IMPLICIT NONE

real(kind=sgl), INTENT(IN)    :: d
real(kind=sgl)                :: s

s = d * sngl(dtor)

end function toRadians_scalars

!--------------------------------------------------------------------------
recursive function toDegrees_vectord( r ) result(d)
!DEC$ ATTRIBUTES DLLEXPORT :: toDegrees_vectord
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to degrees (double precision)

IMPLICIT NONE

real(kind=dbl), INTENT(IN)    :: r(:)
real(kind=dbl)                :: d(size(r))

d = r * rtod

end function toDegrees_vectord

!--------------------------------------------------------------------------
recursive function toDegrees_vectors( r ) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: toDegrees_vectors
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to degrees (double precision)

IMPLICIT NONE

real(kind=sgl), INTENT(IN)    :: r(:)
real(kind=sgl)                :: s(size(r))

s = r * sngl(rtod)

end function toDegrees_vectors

!--------------------------------------------------------------------------
recursive function toRadians_vectord( d ) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: toRadians_vectord
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to radians (double precision)

IMPLICIT NONE

real(kind=dbl), INTENT(IN)    :: d(:)
real(kind=dbl)                :: r(size(d))

r = d * dtor

end function toRadians_vectord

!--------------------------------------------------------------------------
recursive function toRadians_vectors( d ) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: toRadians_vectors
 !! author: MDG
 !! version: 1.0
 !! date: 01/19/20
 !!
 !! convert single angle to radians (single precision)

IMPLICIT NONE

real(kind=sgl), INTENT(IN)    :: d(:)
real(kind=sgl)                :: s(size(d))

s = d * sngl(dtor)

end function toRadians_vectors

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! validation routines for each class
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!------------------------------------------
recursive function r_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: r_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for Rodrigues vector representation (normalizes the unit vector)

use mod_io

IMPLICIT NONE

class(r_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r
real(kind=dbl)             :: rd

res = 1

if (rotdoubleprecision) then
  if (self%rd(4).lt.0.D0) then
     call Message%printMessage('rotations:r_check: Rodrigues-Frank vector has negative length')
  endif
  rd = dsqrt(sum(self%rd(1:3)*self%rd(1:3)))
  self%rd(1:3) = self%rd(1:3) / rd
  res = 0
else
  if (self%r(4).lt.0.0) then
     call Message%printMessage('rotations:r_check: Rodrigues-Frank vector has negative length')
  endif
  r = sqrt(sum(self%r(1:3)*self%r(1:3)))
  self%r(1:3) = self%r(1:3) / r
  res = 0
end if

end function r_check_

!------------------------------------------
recursive function s_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: s_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for stereographic vector representation

use mod_io

IMPLICIT NONE

class(s_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r
real(kind=sgl), parameter  :: eps = 1.e-7
real(kind=sgl)             :: rd
real(kind=sgl), parameter  :: epsd = 1.d-15

res = 1

if (rotdoubleprecision) then
  rd = sqrt(sum(self%sd*self%sd))
  if (rd.gt.(1.D0+epsd)) then
     call Message%printMessage('rotations:s_check: stereographic vector must have norm <= unity')
  endif
  res = 0
else
  r = sqrt(sum(self%s*self%s))
  if (r.gt.(1.0+eps)) then
     call Message%printMessage('rotations:s_check: stereographic vector must have norm <= unity')
  endif
  res = 0
end if

end function s_check_

!------------------------------------------
recursive function o_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: o_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for rotation matrix representation

use mod_io

IMPLICIT NONE

class(o_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r, det
real(kind=sgl), parameter  :: eps = 1.e-6
real(kind=sgl)             :: rd, detd
real(kind=sgl), parameter  :: epsd = 1.d-15
integer(kind=irg)          :: i

res = 1

if (rotdoubleprecision) then
  ! compute the determinant (must be +1)
  detd = self%od(1,1)*self%od(2,2)*self%od(3,3) + self%od(1,2)*self%od(2,3)*self%od(3,1) + &
         self%od(1,3)*self%od(2,1)*self%od(3,2) - self%od(1,3)*self%od(2,2)*self%od(3,1) - &
         self%od(1,2)*self%od(2,1)*self%od(3,3) - self%od(1,1)*self%od(2,3)*self%od(3,2)
  if (detd.lt.0.D0) then
     call Message%printMessage('rotations:o_check: Determinant of rotation matrix must be positive')
  endif
  if (abs(detd-1.D0).gt.epsd) then
     call Message%printMessage('rotations:o_check: Determinant of rotation matrix must be unity')
  endif

  ! next check the row and column sums
  rd = sum(abs(matmul(self%od,transpose(self%od))))
  if (abs(rd-3.D0).gt.epsd) then
     call Message%printMessage('rotations:o_check: rotation matrix times transpose must be identity matrix')
  endif
  res = 0
else
  ! compute the determinant (must be +1)
  det = self%o(1,1)*self%o(2,2)*self%o(3,3) + self%o(1,2)*self%o(2,3)*self%o(3,1) + &
        self%o(1,3)*self%o(2,1)*self%o(3,2) - self%o(1,3)*self%o(2,2)*self%o(3,1) - &
        self%o(1,2)*self%o(2,1)*self%o(3,3) - self%o(1,1)*self%o(2,3)*self%o(3,2)
  if (det.lt.0.0) then
     call Message%printMessage('rotations:o_check: Determinant of rotation matrix must be positive')
  endif
  if (abs(det-1.0).gt.eps) then
     call Message%printMessage('rotations:o_check: Determinant of rotation matrix must be unity')
  endif

  ! next check the row and column sums
  r = sum(abs(matmul(self%o,transpose(self%o))))
  if (abs(r-3.0).gt.eps) then
     call Message%printMessage('rotations:o_check: rotation matrix times transpose must be identity matrix')
  endif
  res = 0
end if

end function o_check_

!------------------------------------------
recursive function h_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: h_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for homochoric vector representation

use mod_io

IMPLICIT NONE

class(h_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r
real(kind=dbl)             :: rd

res = 1
if (rotdoubleprecision) then
  rd = sqrt(sum(self%hd*self%hd))
  if (rd.gt.LPs%R1) then
     call Message%printMessage('rotations:h_check: homochoric vector outside homochoric ball')
  endif
  res = 0
else
  r = sqrt(sum(self%h*self%h))
  if (r.gt.sngl(LPs%R1)) then
     call Message%printMessage('rotations:h_check: homochoric vector outside homochoric ball')
  endif
  res = 0
end if

end function h_check_

!------------------------------------------
recursive function a_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: a_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for axis angle pair representation

use mod_io

IMPLICIT NONE

class(a_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r
real(kind=sgl), parameter  :: eps = 1.e-7
real(kind=sgl)             :: rd
real(kind=sgl), parameter  :: epsd = 1.d-15

res = 1

if (rotdoubleprecision) then
  rd = sqrt(sum(self%ad(1:3)*self%ad(1:3)))
  if ((self%ad(4).lt.0.D0).or.(self%ad(4).gt.cPi)) then
     call Message%printMessage('rotations:a_check: angle must be in range [0,pi]')
  endif
  if (abs(rd-1.D0).gt.epsd) then
     call Message%printMessage('rotations:a_check: axis-angle axis vector must have unit norm')
  endif
  res = 0
else
  r = sqrt(sum(self%a(1:3)*self%a(1:3)))
  if ((self%a(4).lt.0.0).or.(self%a(4).gt.sngl(cPi))) then
     call Message%printMessage('rotations:a_check: angle must be in range [0,pi]')
  endif
  if (abs(r-1.0).gt.eps) then
     call Message%printMessage('rotations:a_check: axis-angle axis vector must have unit norm')
  endif
  res = 0
end if

end function a_check_

!------------------------------------------
recursive function v_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: v_check_
 !! author: Saransh Singh/MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for rotation vector representation

use mod_io

IMPLICIT NONE

class(v_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=dbl)             :: r
real(kind=dbl), parameter  :: eps = 1.e-7
real(kind=dbl)             :: rd
real(kind=dbl), parameter  :: epsd = 1.d-10

res = 1

if (rotdoubleprecision) then
  rd = sqrt(sum(self%vd*self%vd))
  write (*,*) rd, cPi, rd-cPi
  if ((rd-cPi).ge.epsd) then
     call Message%printMessage('rotations:v_check: magnitude must be in range [0,pi]')
  endif
  res = 0
else
  r = sqrt(sum(self%v*self%v))
  if ((r-sngl(cPi)).ge.eps) then
     call Message%printMessage('rotations:v_check: magnitude must be in range [0,pi]')
  endif
  res = 0
end if

end function v_check_

!------------------------------------------
recursive function c_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: c_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for cubochoric vector representation

use mod_io

IMPLICIT NONE

class(c_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r
real(kind=dbl)             :: rd

res = 1

if (rotdoubleprecision) then
  rd = maxval(abs(self%cd))
  if (rd.gt.LPs%ap/2.D0) then
     call Message%printMessage('rotations:c_check: cubochoric vector outside cube')
  endif
  res = 0
else
  r = maxval(abs(self%c))
  if (r.gt.sngl(LPs%ap/2.D0)) then
     call Message%printMessage('rotations:c_check: cubochoric vector outside cube')
  endif
  res = 0
end if

end function c_check_

!------------------------------------------
recursive function e_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: e_check_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for Euler angles representation

use mod_io

IMPLICIT NONE

class(e_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_t)                 :: Message

res = 1

if (rotdoubleprecision) then
  if ((self%ed(1).lt.0.D0).or.(self%ed(1).gt.(2.D0*cPi))) then
     call Message%printMessage('rotations:e_check: phi1 Euler angle outside of valid range [0,2pi]')
  endif
  if ((self%ed(2).lt.0.D0).or.(self%ed(2).gt.cPi)) then
     call Message%printMessage('rotations:e_check: Phi  Euler angle outside of valid range [0,pi]')
  endif
  if ((self%ed(3).lt.0.D0).or.(self%ed(3).gt.(2.D0*cPi))) then
     call Message%printMessage('rotations:e_check: phi2 Euler angle outside of valid range [0,2pi]')
  endif
  res = 0
else
  if ((self%e(1).lt.0.0).or.(self%e(1).gt.(2.0*sngl(cPi)))) then
     call Message%printMessage('rotations:e_check: phi1 Euler angle outside of valid range [0,2pi]')
  endif
  if ((self%e(2).lt.0.0).or.(self%e(2).gt.cPi)) then
     call Message%printMessage('rotations:e_check: Phi  Euler angle outside of valid range [0,pi]')
  endif
  if ((self%e(3).lt.0.0).or.(self%e(3).gt.(2.0*sngl(cPi)))) then
     call Message%printMessage('rotations:e_check: phi2 Euler angle outside of valid range [0,2pi]')
  endif
  res = 0
end if

end function e_check_

!------------------------------------------
recursive function q_check_(self) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: q_check_

 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Validity check for quaternion representation; we enforce normalization here

use mod_io

IMPLICIT NONE

class(q_T), intent(inout)  :: self
integer(kind=irg)          :: res

type(IO_T)                 :: Message
real(kind=sgl)             :: r
real(kind=dbl)             :: rd

res = 1

if (rotdoubleprecision) then
  rd = dsqrt(sum(self%qd*self%qd))
  self%qd = self%qd/rd
  res = 0
else
  r = sqrt(sum(self%q*self%q))
  self%q = self%q/r
  res = 0
end if

end function q_check_

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! print routines for each class
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!--------------------------------------------------------------------------
subroutine r_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: r_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the r_T Class

use mod_io

IMPLICIT NONE

class(r_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(4)
real(kind=dbl)                      :: io_dble(4)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%rd
    call Message%WriteValue(str2, io_dble, 4, frm="(3(F16.10,' '),F16.10)")
else
    io_sngl = self%r
    call Message%WriteValue(str2, io_sngl, 4, frm="(3(F12.6,' '),F12.6)")
end if

end subroutine r_print_

!--------------------------------------------------------------------------
subroutine s_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: s_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the s_T Class

use mod_io

IMPLICIT NONE

class(s_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(3)
real(kind=dbl)                      :: io_dble(3)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%sd
    call Message%WriteValue(str2, io_dble, 3, frm="(2(F16.10,' '),F16.10)")
else
    io_sngl = self%s
    call Message%WriteValue(str2, io_sngl, 3, frm="(2(F12.6,' '),F12.6)")
end if

end subroutine s_print_

!--------------------------------------------------------------------------
subroutine o_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: o_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the o_T Class

use mod_io

IMPLICIT NONE

class(o_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(3)
real(kind=dbl)                      :: io_dble(3)
integer(kind=irg)                   :: i
character(fnlen)                    :: str2

str2 = trim(str)

call Message%printMessage(str)
if (rotdoubleprecision) then
  do i=1,3
    io_dble = self%od(i,1:3)
    call Message%WriteValue('', io_dble, 3, frm="(2(F16.10,' '),F16.10)")
  end do
else
  do i=1,3
    io_sngl = self%o(i,1:3)
    call Message%WriteValue('', io_sngl, 3, frm="(2(F12.6,' '),F12.6)")
  end do
end if

end subroutine o_print_

!--------------------------------------------------------------------------
subroutine h_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: h_print_

!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the h_T Class

use mod_io

IMPLICIT NONE

class(h_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(3)
real(kind=dbl)                      :: io_dble(3)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%hd
    call Message%WriteValue(str2, io_dble, 3, frm="(2(F16.10,' '),F16.10)")
else
    io_sngl = self%h
    call Message%WriteValue(str2, io_sngl, 3, frm="(2(F12.6,' '),F12.6)")
end if

end subroutine h_print_

!--------------------------------------------------------------------------
subroutine a_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: a_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the a_T Class

use mod_io

IMPLICIT NONE

class(a_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(4)
real(kind=dbl)                      :: io_dble(4)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%ad
    call Message%WriteValue(str2, io_dble, 4, frm="(3(F16.10,' '),F16.10)")
else
    io_sngl = self%a
    call Message%WriteValue(str2, io_sngl, 4, frm="(3(F12.6,' '),F12.6)")
end if

end subroutine a_print_

!--------------------------------------------------------------------------
subroutine v_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: v_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the v_T Class

use mod_io

IMPLICIT NONE

class(v_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(3)
real(kind=dbl)                      :: io_dble(3)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%vd
    call Message%WriteValue(str2, io_dble, 3, frm="(2(F16.10,' '),F16.10)")
else
    io_sngl = self%v
    call Message%WriteValue(str2, io_sngl, 3, frm="(2(F12.6,' '),F12.6)")
end if

end subroutine v_print_

!--------------------------------------------------------------------------
subroutine c_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: c_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the c_T Class

use mod_io

IMPLICIT NONE

class(c_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(3)
real(kind=dbl)                      :: io_dble(3)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%cd
    call Message%WriteValue(str2, io_dble, 3, frm="(2(F16.10,' '),F16.10)")
else
    io_sngl = self%c
    call Message%WriteValue(str2, io_sngl, 3, frm="(2(F12.6,' '),F12.6)")
end if

end subroutine c_print_

!--------------------------------------------------------------------------
subroutine e_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: e_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the e_T Class

use mod_io

IMPLICIT NONE

class(e_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(3)
real(kind=dbl)                      :: io_dble(3)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%ed
    call Message%WriteValue(str2, io_dble, 3, frm="(2(F16.10,' '),F16.10)")
else
    io_sngl = self%e
    call Message%WriteValue(str2, io_sngl, 3, frm="(2(F12.6,' '),F12.6)")
end if

end subroutine e_print_

!--------------------------------------------------------------------------
subroutine q_print_(self, str)
!DEC$ ATTRIBUTES DLLEXPORT :: q_print_
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! print routine for the q_T Class

use mod_io

IMPLICIT NONE

class(q_T), intent(inout)           :: self
character(*), intent(in)            :: str

type(IO_T)                          :: Message
real(kind=sgl)                      :: io_sngl(4)
real(kind=dbl)                      :: io_dble(4)
character(fnlen)                    :: str2

str2 = trim(str)

if (rotdoubleprecision) then
    io_dble = self%qd
    call Message%WriteValue(str2, io_dble, 4, frm="(3(F16.10,' '),F16.10)")
else
    io_sngl = self%q
    call Message%WriteValue(str2, io_sngl, 4, frm="(3(F12.6,' '),F12.6)")
end if

end subroutine q_print_

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! comparison routines
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
recursive function close_enough(a,b) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: close_enough
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! compares two reals and returns .TRUE. is they are closer than E-8 ! machine precision

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

!--------------------------------------------------------------------------
recursive function close_enough_d(a,b) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: close_enough_d
!! author: MDG
!! version: 1.0
!! date: 01/17/20
!!
!! compares two doubles and returns .TRUE. is they are closer than E-12 ! machine precision

IMPLICIT NONE

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

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

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

end function close_enough_d

!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! the actual conversion routines for each class
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------

!------------------------------------------
recursive function rs_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: rs_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to stereographic vector

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(s_T)                  :: s

type(q_T)                  :: q

q = self%rq()
s = q%qs()

end function rs_

!------------------------------------------
recursive function ro_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: ro_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to rotation matrix

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(o_T)                  :: o

type(a_T)                  :: a

a = self%ra()
o = a%ao()

end function ro_

!------------------------------------------
recursive function rh_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: rh_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to homochoric vector

use mod_math, only: infty, inftyd

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(h_T)                  :: h

real(kind=sgl)             :: rv, f, t
real(kind=dbl)             :: rvd, fd, td

if (rotdoubleprecision) then
  rvd = sum(self%rd(1:3)*self%rd(1:3))
  if (close_enough_d(rvd,0.D0)) then
          h%hd = (/ 0.D0, 0.D0, 0.D0 /)
          return
  end if

  if (self%rd(4).eq.inftyd()) then
          fd = 0.75D0 * cPi
  else
          td = 2.D0*datan(self%rd(4))
          fd = 0.75D0*(td - dsin(td))
  end if

  h%hd(1:3) = self%rd(1:3) * fd**(1.D0/3.D0)
else
  rv = sum(self%r(1:3)*self%r(1:3))
  if (close_enough(rv,0.0)) then
          h%h = (/ 0.0, 0.0, 0.0 /)
          return
  end if

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

  h%h(1:3) = self%r(1:3) * f**(1.0/3.0)
end if

end function rh_

!------------------------------------------
recursive function ra_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: ra_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to axis angle pair

use mod_math, only: infty, inftyd

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(a_T)                  :: a

real(kind=sgl)             :: ta, angle
real(kind=dbl)             :: tad, angled

if (rotdoubleprecision) then
  tad = self%rd(4)

  if (close_enough_d(tad,0.D0)) then
    a%ad = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
    return
  end if

  if (tad.eq.inftyd()) then
    a%ad = (/ self%rd(1), self%rd(2), self%rd(3), cPi /)
  else
    angled = 2.D0*datan(tad)
    tad = 1.D0/dsqrt(sum(self%rd(1:3)*self%rd(1:3)))
    a%ad = (/ self%rd(1)*tad, self%rd(2)*tad, self%rd(3)*tad, angled /)
  end if
else
  ta = self%r(4)

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

  if (ta.eq.infty()) then
    a%a = (/ self%r(1), self%r(2), self%r(3), sngl(cPi) /)
  else
    angle = 2.0*atan(ta)
    ta = 1.0/sqrt(sum(self%r(1:3)*self%r(1:3)))
    a%a = (/ self%r(1)*ta, self%r(2)*ta, self%r(3)*ta, angle /)
  end if
end if

end function ra_

!------------------------------------------
recursive function rv_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: rv_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to rotation vector

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(v_T)                  :: v

type(e_T)                  :: e

e = self%re()
v = e%ev()

end function rv_

!------------------------------------------
recursive function rc_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: rc_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to cubochoric vector

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(c_T)                  :: c

type(h_T)                  :: h

h = self%rh()
c = h%hc()

end function rc_

!------------------------------------------
recursive function re_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: re_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to Euler angles

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(e_T)                  :: e

type(o_T)                  :: o
integer(kind=irg)          :: i, j
real(kind=sgl)             :: rr(3), s, d, eps = 1.0e-8
real(kind=dbl)             :: rrd(3), sd, dd, epsd = 1.0D-12
real(kind=sgl), parameter  :: pivals(4) = (/ 1.570796326794, 3.141592653589, 4.712388980384, 6.283185307179 /)
real(kind=dbl), parameter  :: pivalsd(4) = (/ cPi*0.5D0, cPi, 3.D0*cPi*0.5D0, 2.D0*cPi /)

if (rotdoubleprecision) then
  o = self%ro()
  e = o%oe()
  do i=1,3
    if (abs(e%ed(i)).lt.epsd) e%ed(i) = 0.D0
    do j=1,4
      if (abs(e%ed(i)-pivalsd(j)).lt.epsd) e%ed(i) = pivalsd(j)
    end do
  end do
else
  o = self%ro()
  e = o%oe()
  do i=1,3
    if (abs(e%e(i)).lt.eps) e%e(i) = 0.0
    do j=1,4
      if (abs(e%e(i)-pivals(j)).lt.eps) e%e(i) = pivals(j)
    end do
  end do
end if

end function re_

!------------------------------------------
recursive function rq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: rq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Rodrigues vector to quaternion

IMPLICIT NONE

class(r_T), intent(inout)  :: self
type(q_T)                  :: q

type(a_T)                  :: a
real(kind=sgl)             :: n, x(4)
real(kind=dbl)             :: nd, xd(4)

a = self%ra()
q = a%aq()

! make sure the quaternion is normalized
if (rotdoubleprecision) then
    xd = q%q_copyd()
    nd = dsqrt(sum(xd**2))
    q = q_T( qdinp = xd/nd )
else
    x = q%q_copy()
    n = sqrt(sum(x**2))
    q = q_T( qinp = x/n )
end if

end function rq_

!------------------------------------------
recursive function sr_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: sr_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to Rodrigues vector

use mod_math, only: infty, inftyd

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(r_T)                  :: r

real(kind=sgl)             :: l, tmp(3)
real(kind=dbl)             :: ld, tmpd(3)

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
     tmpd = self%sd/ld
     if ( close_enough_d(ld,1.D0) ) then
          r%rd = (/ tmpd(1), tmpd(2), tmpd(3), inftyd() /)
     else
          r%rd = (/ tmpd(1), tmpd(2), tmpd(3), dtan(2.D0*datan(ld)) /)
     end if
  else ! return the identity orientation
     r%rd = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
  end if
else
  l = sqrt(sum(self%s*self%s))

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

end function sr_

!------------------------------------------
recursive function so_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: so_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to rotation matrix

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(o_T)                  :: o

real(kind=sgl)             :: l, tmp(3)
real(kind=dbl)             :: ld, tmpd(3)
type(a_T)                  :: ax

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
     tmpd = self%sd/ld
     if ( close_enough_d(ld,1.D0) ) then
          ax%ad = (/ tmpd(1), tmpd(2), tmpd(3), cPi /)
     else
          ax%ad = (/ tmpd(1), tmpd(2), tmpd(3), 4.D0*datan(ld) /)
     end if
     o = ax%ao()
  else ! return the identity matrix
     o%od = 0.D0
     o%od(1,1) = 1.D0
     o%od(2,2) = 1.D0
     o%od(3,3) = 1.D0
  end if
else
  l = sqrt(sum(self%s*self%s))

  if (l.gt.0.0) then ! not the identity rotation
     tmp = self%s/l
     if ( close_enough(l,1.0) ) then
          ax%a = (/ tmp(1), tmp(2), tmp(3), sngl(cPi) /)
     else
          ax%a = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
     end if
     o = ax%ao()
  else ! return the identity matrix
     o%o = 0.0
     o%o(1,1) = 1.0
     o%o(2,2) = 1.0
     o%o(3,3) = 1.0
  end if
end if

end function so_

!------------------------------------------
recursive function sh_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: sh_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to homochoric vector

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(h_T)                  :: h

real(kind=sgl)             :: l, tmp(3), angle
real(kind=dbl)             :: ld, tmpd(3), angled

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
    tmpd = self%sd/ld
    angled = 4.D0*datan(ld)
    h%hd = tmpd * (3.D0 * ( angled - dsin(angled) ) / 4.D0) ** (1.D0/3.D0)
  else ! return the identity orientation
    h%hd = (/ 0.D0, 0.D0, 0.D0 /)
  end if
else
  l = sqrt(sum(self%s*self%s))

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

end function sh_

!------------------------------------------
recursive function sa_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: sa_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to axis angle pair

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(a_T)                  :: a

real(kind=sgl)             :: l, tmp(3)
real(kind=dbl)             :: ld, tmpd(3)

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
     tmpd = self%sd/ld
     if ( close_enough_d(ld,1.D0) ) then
          a%ad = (/ tmpd(1), tmpd(2), tmpd(3), cPi /)
     else
          a%ad = (/ tmpd(1), tmpd(2), tmpd(3), 4.D0*datan(ld) /)
     end if
  else ! return the identity orientation
     a%ad = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
  end if
else
  l = sqrt(sum(self%s*self%s))

  if (l.gt.0.0) then ! not the identity rotation
     tmp = self%s/l
     if ( close_enough(l,1.0) ) then
          a%a = (/ tmp(1), tmp(2), tmp(3), sngl(cPi) /)
     else
          a%a = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
     end if
  else ! return the identity orientation
     a%a = (/ 0.0, 0.0, 1.0, 0.0 /)
  end if
end if

end function sa_

!------------------------------------------
recursive function sv_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: sv_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to rotation vector

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(v_T)                  :: v

type(e_T)                  :: e

e = self%se()
v = e%ev()

end function sv_

!------------------------------------------
recursive function sc_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: sc_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to cubochoric vector

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(c_T)                  :: c

real(kind=sgl)             :: l, tmp(3), angle
real(kind=dbl)             :: ld, tmpd(3), angled
type(h_T)                  :: ho

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
    tmpd = self%sd/ld
    angled = 4.D0*datan(ld)
    ho%hd = tmpd * (3.D0 * ( angled - dsin(angled) ) / 4.D0) ** (1.D0/3.D0)
    c = ho%hc()
  else ! return the identity orientation
    c%cd = (/ 0.D0, 0.D0, 0.D0 /)
  end if
else
  l = sqrt(sum(self%s*self%s))

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

end function sc_

!------------------------------------------
recursive function se_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: se_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to Euler angles

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(e_T)                  :: e

real(kind=sgl)             :: l, tmp(3)
real(kind=dbl)             :: ld, tmpd(3)
type(a_T)                  :: ax

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
     tmpd = self%sd/ld
     if ( close_enough_d(ld,1.D0) ) then
          ax%ad = (/ tmpd(1), tmpd(2), tmpd(3), cPi /)
     else
          ax%ad = (/ tmpd(1), tmpd(2), tmpd(3), 4.D0*datan(ld) /)
     end if
     e = ax%ae()
  else ! return the identity orientation
     e%ed = 0.D0
  end if
else
  l = sqrt(sum(self%s*self%s))

  if (l.gt.0.0) then ! not the identity rotation
     tmp = self%s/l
     if ( close_enough(l,1.0) ) then
          ax%a = (/ tmp(1), tmp(2), tmp(3), sngl(cPi) /)
     else
          ax%a = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
     end if
     e = ax%ae()
  else ! return the identity orientation
     e%e = 0.0
  end if
end if

end function se_

!------------------------------------------
recursive function sq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: sq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from stereographic vector to quaternion

IMPLICIT NONE

class(s_T), intent(inout)  :: self
type(q_T)                  :: q

real(kind=sgl)             :: l, tmp(3)
real(kind=dbl)             :: ld, tmpd(3)
type(a_T)                  :: ax

if (rotdoubleprecision) then
  ld = dsqrt(sum(self%sd*self%sd))

  if (ld.gt.0.D0) then ! not the identity rotation
     tmpd = self%sd/ld
     if ( close_enough_d(ld,1.D0) ) then
          ax%ad = (/ tmpd(1), tmpd(2), tmpd(3), cPi /)
     else
          ax%ad = (/ tmpd(1), tmpd(2), tmpd(3), 4.D0*datan(ld) /)
     end if
     q = ax%aq()
  else ! return the identity orientation
     q%qd = (/ 1.D0, 0.D0, 0.D0, 0.D0 /)
  end if
else
  l = sqrt(sum(self%s*self%s))

  if (l.gt.0.0) then ! not the identity rotation
     tmp = self%s/l
     if ( close_enough(l,1.0) ) then
          ax%a = (/ tmp(1), tmp(2), tmp(3), sngl(cPi) /)
     else
          ax%a = (/ tmp(1), tmp(2), tmp(3), 4.0*atan(l) /)
     end if
     q = ax%aq()
  else ! return the identity orientation
     q%q = (/ 1.0, 0.0, 0.0, 0.0 /)
  end if
end if

end function sq_

!------------------------------------------
recursive function or_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: or_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to Rodrigues vector

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(r_T)                  :: r

type(e_T)                  :: e

e = self%oe()
r = e%er()

end function or_

!------------------------------------------
recursive function os_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: os_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to stereographic vector

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(s_T)                  :: s

type(q_T)                  :: q

q = self%oq()
s = q%qs()

end function os_

!------------------------------------------
recursive function oh_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: oh_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to homochoric vector

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(h_T)                  :: h

type(a_T)                  :: a

a = self%oa()
h = a%ah()

end function oh_

!------------------------------------------
recursive function oa_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: oa_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to axis angle pair

use mod_io

IMPLICIT NONE

class(o_T), intent(inout)   :: self
type(a_T)                   :: a

type(IO_T)                  :: Message
integer(kind=irg)           :: i
real(kind=sgl)              :: t, omega, qq(4), o(3,3), o2(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

real(kind=dbl)              :: td, omegad, qqd(4), od(3,3), od2(3,3)
real(kind=dbl)              :: VLD(3,3), VRD(3,3), WrD(3), WiD(3), WORKD(20)
complex(kind=dbl)           :: evd
complex(kind=dbl),parameter :: coned = cmplx(1.D0,0.D0)
real(kind=dbl),parameter    :: thrd = 1.0D-14

if (rotdoubleprecision) then
   od = self%od
   od2 = od

  ! first get the rotation angle
   td = 0.5D0*(od(1,1)+od(2,2)+od(3,3) - 1.D0)
   if (td.gt.1.D0) td = 1.D0
   if (td.lt.-1.D0) td = -1.D0
   a%ad(4) = dacos(td)

  if (close_enough_d(a%ad(4),0.D0)) then
    a%ad(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

  ! call the eigenvalue solver
    call dgeev(JOBVL,JOBVR,nn,od,LDA,WrD,WiD,VLD,LDVL,VRD,LDVR,WORKD,LWORK,INFO)
    if (INFO.ne.0) call Message%printError('Error in oa_/dgeev : ','DGEEV return not zero')

  ! next, find the eigenvalue cmplx(1,0)
   do i=1,3
      if ((abs(WrD(i)-1.D0).lt.thrd).and.(abs(WiD(i)).lt.thrd)) then
        a%ad(1:3) = VRD(1:3,i)
        if ((od2(2,3)-od2(3,2)).ne.0.D0) a%ad(1) = dsign(a%ad(1),-epsijkd*(od2(2,3)-od2(3,2)))
        if ((od2(3,1)-od2(1,3)).ne.0.D0) a%ad(2) = dsign(a%ad(2),-epsijkd*(od2(3,1)-od2(1,3)))
        if ((od2(1,2)-od2(2,1)).ne.0.D0) a%ad(3) = dsign(a%ad(3),-epsijkd*(od2(1,2)-od2(2,1)))
        return
      end if
    end do
  end if
else
   o = self%o
   o2 = o

  ! first get the rotation angle
   t = 0.5*(o(1,1)+o(2,2)+o(3,3) - 1.D0)
   if (t.gt.1.0) t = 1.0
   if (t.lt.-1.0) t = -1.0
   a%a(4) = acos(t)

  if (close_enough(a%a(4),0.0)) then
    a%a(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 SGEEV routines
   JOBVL = 'N'   ! do not compute the left eigenvectors
   JOBVR = 'V'   ! do compute the right eigenvectors
   LWORK = 20

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

  ! next, find the eigenvalue cmplx(1,0)
   do i=1,3
      if ((abs(Wr(i)-1.0).lt.thr).and.(abs(Wi(i)).lt.thr)) then
        a%a(1:3) = VR(1:3,i)
        if ((o2(2,3)-o2(3,2)).ne.0.0) a%a(1) = sign(a%a(1),-epsijk*(o2(2,3)-o2(3,2)))
        if ((o2(3,1)-o2(1,3)).ne.0.0) a%a(2) = sign(a%a(2),-epsijk*(o2(3,1)-o2(1,3)))
        if ((o2(1,2)-o2(2,1)).ne.0.0) a%a(3) = sign(a%a(3),-epsijk*(o2(1,2)-o2(2,1)))
        return
      end if
    end do
  end if
end if

end function oa_

!------------------------------------------
recursive function ov_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: ov_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to rotation vector

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(v_T)                  :: v

type(q_T)                  :: q

q = self%oq()
v = q%qv()

end function ov_

!------------------------------------------
recursive function oc_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: oc_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to cubochoric vector

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(c_T)                  :: c

type(h_T)                  :: h

h = self%oh()
c = h%hc()

end function oc_

!------------------------------------------
recursive function oe_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: oe_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to Euler angles

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(e_T)                  :: e

real(kind=sgl)             :: zeta
real(kind=dbl)             :: zetad
real(kind=sgl),parameter   :: thr = 1.0E-6
real(kind=dbl),parameter   :: thrd = 1.0D-8

if (rotdoubleprecision) then
  if (.not.close_enough_d(dabs(self%od(3,3)),1.D0)) then
          e%ed(2) = dacos(self%od(3,3))
          zetad = 1.D0/dsqrt(1.D0-self%od(3,3)**2)
          e%ed(1) = datan2(self%od(3,1)*zetad,-self%od(3,2)*zetad)
          e%ed(3) = datan2(self%od(1,3)*zetad, self%od(2,3)*zetad)
  else
  ! we arbitrarily assign the entire angle to phi_1
          if (close_enough_d(self%od(3,3),1.D0)) then
                  e%ed(1) = datan2( self%od(1,2),self%od(1,1))
                  e%ed(2) = 0.D0
                  e%ed(3) = 0.D0
          else
                  e%ed(1) =-datan2(-self%od(1,2),self%od(1,1))
                  e%ed(2) = cPi
                  e%ed(3) = 0.D0
          end if
  end if

  ! reduce Euler angles to definition ranges (and positive values only)
  if (e%ed(1).lt.0.D0) e%ed(1) = dmod(e%ed(1)+100.D0*cPi,2.D0*cPi)
  if (e%ed(2).lt.0.D0) e%ed(2) = dmod(e%ed(2)+100.D0*cPi,cPi)
  if (e%ed(3).lt.0.D0) e%ed(3) = dmod(e%ed(3)+100.D0*cPi,2.D0*cPi)
else
  if (.not.close_enough(abs(self%o(3,3)),1.0)) then
          e%e(2) = acos(self%o(3,3))
          zeta = 1.D0/sqrt(1.D0-self%o(3,3)**2)
          e%e(1) = atan2(self%o(3,1)*zeta,-self%o(3,2)*zeta)
          e%e(3) = atan2(self%o(1,3)*zeta, self%o(2,3)*zeta)
  else
  ! we arbitrarily assign the entire angle to phi_1
          if (close_enough(self%o(3,3),1.0)) then
                  e%e(1) = atan2( self%o(1,2),self%o(1,1))
                  e%e(2) = 0.0
                  e%e(3) = 0.0
          else
                  e%e(1) =-atan2(-self%o(1,2),self%o(1,1))
                  e%e(2) = sngl(cPi)
                  e%e(3) = 0.0
          end if
  end if

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

end function oe_

!------------------------------------------
recursive function oq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: oq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation matrix to quaternion

IMPLICIT NONE

class(o_T), intent(inout)  :: self
type(q_T)                  :: q

type(a_T)                  :: oax
real(kind=sgl)             :: s, s1, s2, s3
real(kind=dbl)             :: sd, s1d, s2d, s3d
real(kind=dbl),parameter   :: thr = 1.0E-7
real(kind=dbl),parameter   :: thrd = 1.0D-10

if (rotdoubleprecision) then
  sd = self%od(1,1) + self%od(2,2) + self%od(3,3) + 1.D0
  if (abs(sd).lt.thrd) sd = 0.D0
  sd = dsqrt(sd)

  s1d = self%od(1,1) - self%od(2,2) - self%od(3,3) + 1.D0
  if (abs(s1d).lt.thrd) s1d = 0.D0
  s1d = dsqrt(s1d)

  s2d = -self%od(1,1) + self%od(2,2) - self%od(3,3) + 1.D0
  if (dabs(s2d).lt.thrd) s2d = 0.D0
  s2d = dsqrt(s2d)

  s3d = -self%od(1,1) - self%od(2,2) + self%od(3,3) + 1.D0
  if (dabs(s3d).lt.thrd) s3d = 0.D0
  s3d = sqrt(s3d)

  q%qd = (/ sd, s1d, s2d, s3d /) * 0.5D0

  ! verify the signs (q0 always positive)
  if (self%od(3,2).lt.self%od(2,3)) q%qd(2) = -epsijkd * q%qd(2)
  if (self%od(1,3).lt.self%od(3,1)) q%qd(3) = -epsijkd * q%qd(3)
  if (self%od(2,1).lt.self%od(1,2)) q%qd(4) = -epsijkd * q%qd(4)

  ! normalize
  sd = sqrt(sum(q%qd*q%qd))
  if (sd.ne.0.D0) q%qd = q%qd/sd

  ! 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 = self%oa()
  if (oax%ad(1)*q%qd(2).lt.0.D0) q%qd(2) = -q%qd(2)
  if (oax%ad(2)*q%qd(3).lt.0.D0) q%qd(3) = -q%qd(3)
  if (oax%ad(3)*q%qd(4).lt.0.D0) q%qd(4) = -q%qd(4)
else
  s = self%o(1,1) + self%o(2,2) + self%o(3,3) + 1.0
  if (abs(s).lt.thr) s = 0.0
  s = sqrt(s)

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

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

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

  q%q = (/ s, s1, s2, s3 /) * 0.5

  ! verify the signs (q0 always positive)
  if (self%o(3,2).lt.self%o(2,3)) q%q(2) = -epsijk * q%q(2)
  if (self%o(1,3).lt.self%o(3,1)) q%q(3) = -epsijk * q%q(3)
  if (self%o(2,1).lt.self%o(1,2)) q%q(4) = -epsijk * q%q(4)

  ! normalize
  s = sqrt(sum(q%q*q%q))
  if (s.ne.0.0) q%q = q%q/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 = self%oa()
  if (oax%a(1)*q%q(2).lt.0.0) q%q(2) = -q%q(2)
  if (oax%a(2)*q%q(3).lt.0.0) q%q(3) = -q%q(3)
  if (oax%a(3)*q%q(4).lt.0.0) q%q(4) = -q%q(4)
end if

end function oq_

!------------------------------------------
recursive function hr_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: hr_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to Rodrigues vector

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(r_T)                  :: r

type(a_T)                  :: a

a = self%ha()
r = a%ar()

end function hr_

!------------------------------------------
recursive function hs_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: hs_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to stereographic vector

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(s_T)                  :: s

type(q_T)                  :: q

q = self%hq()
s = q%qs()

end function hs_

!------------------------------------------
recursive function ho_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: ho_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to rotation matrix

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(o_T)                  :: o

type(a_T)                  :: a

a = self%ha()
o = a%ao()

end function ho_

!------------------------------------------
recursive function ha_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: ha_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to axis angle pair

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(a_T)                  :: a

integer(kind=irg)          :: i
real(kind=sgl)             :: hn(3), hmag, s, hm
real(kind=dbl)             :: hnd(3), hmagd, sd, hmd
real(kind=sgl),parameter   :: thr = 1.0E-6
real(kind=dbl),parameter   :: thrd = 1.0E-6

if (rotdoubleprecision) then
! normalize h and store the magnitude
  hmagd = sum(self%hd*self%hd)
  if (close_enough_d(hmagd,0.D0)) then
    a%ad = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
  else
    hmd = hmagd
    hnd = self%hd/sqrt(hmagd)

! convert the magnitude to the rotation angle
    sd = LPs%tfit(1) + LPs%tfit(2) * hmagd
    do i=3,21
      hmd = hmd*hmagd
      sd = sd + LPS%tfit(i) * hmd
    end do

    sd = 2.D0*dacos(sd)
    if (abs(sd-cPi).lt.thrd) then
     a%ad = (/ hnd(1), hnd(2), hnd(3), cPi /)
    else
     a%ad = (/ hnd(1), hnd(2), hnd(3), sd /)
    end if
  end if
else
! normalize h and store the magnitude
  hmag = sum(self%h*self%h)
  if (close_enough(hmag,0.0)) then
    a%a = (/ 0.0, 0.0, 1.0, 0.0 /)
  else
    hm = hmag
    hn = self%h/sqrt(hmag)

! convert the magnitude to the rotation angle
    s = LPs%tfit(1) + LPs%tfit(2) * hmag
    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
     a%a = (/ hn(1), hn(2), hn(3), sngl(cPi) /)
    else
     a%a = (/ hn(1), hn(2), hn(3), s /)
    end if
  end if
end if

end function ha_

!------------------------------------------
recursive function hv_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: hv_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to rotation vector

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(v_T)                  :: v

type(e_T)                  :: e

e = self%he()
v = e%ev()

end function hv_

!------------------------------------------
recursive function hc_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: hc_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to cubochoric vector

use mod_Lambert

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(c_T)                  :: c

type(Lambert_T)            :: Lambert
integer(kind=irg)          :: ierr

if (rotdoubleprecision) then
  Lambert = Lambert_T( xyzd=self%hd )
  ierr = Lambert%LambertBallToCube(c%cd)
else
  Lambert = Lambert_T( xyz=self%h )
  ierr = Lambert%LambertBallToCube(c%c)
end if

end function hc_

!------------------------------------------
recursive function he_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: he_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to Euler angles

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(e_T)                  :: e

type(a_T)                  :: a

a = self%ha()
e = a%ae()

end function he_

!------------------------------------------
recursive function hq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: hq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from homochoric vector to quaternion

IMPLICIT NONE

class(h_T), intent(inout)  :: self
type(q_T)                  :: q

type(a_T)                  :: a

a = self%ha()
q = a%aq()

end function hq_

!------------------------------------------
recursive function ar_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: ar_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to Rodrigues vector

use mod_math, only: infty, inftyd

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(r_T)                  :: r

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

if (rotdoubleprecision) then
  if (close_enough_d(self%ad(4),0.D0)) then
    r%rd = (/ 0.D0, 0.D0, epsijkd, 0.D0 /)
    return
  end if

  r%rd(1:3) =  self%ad(1:3)

  ! we need to deal with the 180 degree case
  if (dabs(self%ad(4)-cPi).lt.thrd) then
  !if (close_enough(abs(a(4)-sngl(cPi)),0.0)) then
    r%rd(4) = inftyd()
  else
    r%rd(4) = dtan( self%ad(4) * 0.5D0 )
  end if
else
  if (close_enough(self%a(4),0.0)) then
    r%r = (/ 0.0, 0.0, epsijk, 0.0 /)
    return
  end if

  r%r(1:3) =  self%a(1:3)

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

end function ar_

!------------------------------------------
recursive function as_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: as_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to stereographic vector

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(s_T)                  :: s

type(q_T)                  :: q

q = self%aq()
s = q%qs()

end function as_

!------------------------------------------
recursive function ao_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: ao_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to rotation matrix

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(o_T)                  :: o

real(kind=sgl)             :: q, c, s, omc
real(kind=dbl)             :: qd, cd, sd, omcd
integer(kind=irg)          :: i

if (rotdoubleprecision) then
  cd = dcos(self%ad(4))
  sd = dsin(self%ad(4))
  omcd = 1.D0-cd

  do i=1,3
    o%od(i,i) = self%ad(i)**2*omcd + cd
  end do

  qd = omcd*self%ad(1)*self%ad(2)
  o%od(1,2) = qd + sd*self%ad(3)
  o%od(2,1) = qd - sd*self%ad(3)

  qd = omcd*self%ad(2)*self%ad(3)
  o%od(2,3) = qd + sd*self%ad(1)
  o%od(3,2) = qd - sd*self%ad(1)

  qd = omcd*self%ad(3)*self%ad(1)
  o%od(3,1) = qd + sd*self%ad(2)
  o%od(1,3) = qd - sd*self%ad(2)

  if (epsijkd.eq.1.D0) o%od = transpose(o%od)
else
  c = cos(self%a(4))
  s = sin(self%a(4))
  omc = 1.0-c

  do i=1,3
    o%o(i,i) = self%a(i)**2*omc + c
  end do

  q = omc*self%a(1)*self%a(2)
  o%o(1,2) = q + s*self%a(3)
  o%o(2,1) = q - s*self%a(3)

  q = omc*self%a(2)*self%a(3)
  o%o(2,3) = q + s*self%a(1)
  o%o(3,2) = q - s*self%a(1)

  q = omc*self%a(3)*self%a(1)
  o%o(3,1) = q + s*self%a(2)
  o%o(1,3) = q - s*self%a(2)

  if (epsijk.eq.1.0) o%o = transpose(o%o)
end if

end function ao_

!------------------------------------------
recursive function ah_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: ah_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to homochoric vector

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(h_T)                  :: h

real(kind=sgl)             :: f
real(kind=dbl)             :: fd

if (rotdoubleprecision) then
  fd = 0.75D0 * ( self%ad(4) - dsin(self%ad(4)) )
  fd = fd**(1.D0/3.D0)

  h%hd = self%ad(1:3) * fd
else
  f = 0.75 * ( self%a(4) - sin(self%a(4)) )
  f = f**(1.0/3.0)

  h%h = self%a(1:3) * f
end if

end function ah_

!------------------------------------------
recursive function av_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: av_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to rotation vector

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(v_T)                  :: v

if (rotdoubleprecision) then
  v%vd = self%ad(1:3) * self%ad(4)
else
  v%v = self%a(1:3) * self%a(4)
end if

end function av_

!------------------------------------------
recursive function ac_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: ac_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to cubochoric vector

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(c_T)                  :: c

type(h_T)                  :: h

h = self%ah()
c = h%hc()

end function ac_

!------------------------------------------
recursive function ae_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: ae_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to Euler angles

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(e_T)                  :: e

type(o_T)                  :: o

o = self%ao()
e = o%oe()

end function ae_

!------------------------------------------
recursive function aq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: aq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from axis angle pair to quaternion

IMPLICIT NONE

class(a_T), intent(inout)  :: self
type(q_T)                  :: q

real(kind=sgl)             :: c, s
real(kind=dbl)             :: cd, sd

if (rotdoubleprecision) then
  if (close_enough_d(self%ad(4),0.D0)) then
          q%qd = (/ 1.D0, 0.D0, 0.D0, 0.D0 /)
  else
          cd = dcos(self%ad(4)*0.5D0)
          sd = dsin(self%ad(4)*0.5D0)
          q%qd = (/ cd, self%ad(1)*sd, self%ad(2)*sd, self%ad(3)*sd /)
  end if
else
  if (close_enough(self%a(4),0.0)) then
          q%q = (/ 1.0, 0.0, 0.0, 0.0 /)
  else
          c = cos(self%a(4)*0.5)
          s = sin(self%a(4)*0.5)
          q%q = (/ c, self%a(1)*s, self%a(2)*s, self%a(3)*s /)
  end if
end if

end function aq_

!------------------------------------------
recursive function vr_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: vr_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to Rodrigues vector

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(r_T)                  :: r

type(a_T)                  :: a

a = self%va()
r = a%ar()

end function vr_

!------------------------------------------
recursive function vs_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: vs_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to stereographic vector

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(s_T)                  :: s

type(a_T)                  :: a

a = self%va()
s = a%as()

end function vs_

!------------------------------------------
recursive function vo_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: vo_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to rotation matrix

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(o_T)                  :: o

type(a_T)                  :: a

a = self%va()
o = a%ao()

end function vo_

!------------------------------------------
recursive function vh_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: vh_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to homochoric vector

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(h_T)                  :: h

type(a_T)                  :: a

a = self%va()
h = a%ah()

end function vh_

!------------------------------------------
recursive function va_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: va_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to axis angle pair

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(a_T)                  :: a

real(kind=sgl)             :: an, n(3)
real(kind=sgl), parameter  :: tol = 1.0E-7
real(kind=dbl)             :: and, nd(3)
real(kind=dbl), parameter  :: told = 1.0D-10

if (rotdoubleprecision) then
  and = dsqrt(sum(self%vd**2))

  if(and .gt. told) then
          nd = self%vd / and
  else
          nd = (/0.D0, 0.D0, 1.D0/)
          and = 0.D0
  end if
  a%ad = (/ nd, and /)
else
  an = sqrt(sum(self%v**2))

  if(an .gt. tol) then
          n = self%v / an
  else
          n = (/0.0, 0.0, 1.0/)
          an = 0.0
  end if
  a%a = (/ n, an /)
end if

end function va_

!------------------------------------------
recursive function vc_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: vc_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to cubochoric vector

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(c_T)                  :: c

type(a_T)                  :: a

a = self%va()
c = a%ac()

end function vc_

!------------------------------------------
recursive function ve_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: ve_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to Euler angles

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(e_T)                  :: e

type(a_T)                  :: a

a = self%va()
e = a%ae()

end function ve_

!------------------------------------------
recursive function vq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: vq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from rotation vector to quaternion

IMPLICIT NONE

class(v_T), intent(inout)  :: self
type(q_T)                  :: q

type(a_T)                  :: a

a = self%va()
q = a%aq()

end function vq_

!------------------------------------------
recursive function cr_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: cr_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to Rodrigues vector

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(r_T)                  :: r

type(h_T)                  :: h

h = self%ch()
r = h%hr()

end function cr_

!------------------------------------------
recursive function cs_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: cs_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to stereographic vector

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(s_T)                  :: s

type(q_T)                  :: q

q = self%cq()
s = q%qs()

end function cs_

!------------------------------------------
recursive function co_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: co_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to rotation matrix

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(o_T)                  :: o

type(h_T)                  :: h

h = self%ch()
o = h%ho()

end function co_

!------------------------------------------
recursive function ch_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: ch_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to homochoric vector

use mod_Lambert

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(h_T)                  :: h

integer(kind=irg)          :: ierr
type(Lambert_T)            :: Lambert

if (rotdoubleprecision) then
    Lambert = Lambert_T( xyzd=self%cd )
    ierr = Lambert%LambertCubeToBall(h%hd)
else
    Lambert = Lambert_T( xyz=self%c )
    ierr = Lambert%LambertCubeToBall(h%h)
end if

end function ch_

!------------------------------------------
recursive function ca_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: ca_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to axis angle pair

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(a_T)                  :: a

type(h_T)                  :: h

h = self%ch()
a = h%ha()

end function ca_

!------------------------------------------
recursive function cv_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: cv_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to rotation vector

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(v_T)                  :: v

type(e_T)                  :: e

e = self%ce()
v = e%ev()

end function cv_

!------------------------------------------
recursive function ce_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: ce_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to Euler angles

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(e_T)                  :: e

type(h_T)                  :: h

h = self%ch()
e = h%he()

end function ce_

!------------------------------------------
recursive function cq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: cq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from cubochoric vector to quaternion

IMPLICIT NONE

class(c_T), intent(inout)  :: self
type(q_T)                  :: q

type(h_T)                  :: h

h = self%ch()
q = h%hq()

end function cq_

!------------------------------------------
recursive function er_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: er_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to Rodrigues vector

use mod_math

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(r_T)                  :: r

type(a_T)                  :: a
real(kind=sgl)             :: t
real(kind=dbl)             :: td
real(kind=sgl),parameter   :: thr = 1.0E-7
real(kind=dbl),parameter   :: thrd = 1.0D-10

! first go to the axis-angle representation
a = self%ea()

if (rotdoubleprecision) then

! then adjust the fourth component to be tan(omega/2)
  td = a%ad(4)
  if (abs(td-cPi).lt.thrd) then
    a%ad(4) = inftyd()
    r%rd = a%ad
    return
  end if

  if (close_enough_d(td,0.D0)) then
    a%ad = (/ 0.D0, 0.D0, epsijkd, 0.D0 /)
  else
    a%ad(4) = dtan(td*0.5D0)
  end if
! and convert to Rodrigues vector
  r%rd = a%ad
else
! then adjust the fourth component to be tan(omega/2)
  t = a%a(4)
  if (abs(t-sngl(cPi)).lt.thr) then
    a%a(4) = infty()
    return
  end if

  if (close_enough(t,0.0)) then
    a%a = (/ 0.0, 0.0, epsijk, 0.0 /)
  else
    a%a(4) = tan(t*0.5)
  end if
! and convert to Rodrigues vector
  r%r = a%a
end if

end function er_

!------------------------------------------
recursive function es_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: es_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to stereographic vector

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(s_T)                  :: s

type(q_T)                  :: q

q = self%eq()
s = q%qs()

end function es_

!------------------------------------------
recursive function eo_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: eo_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to rotation matrix

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(o_T)                  :: o

integer(kind=irg)          :: i,j
real(kind=sgl)             :: c1, c2, c3, s1, s2, s3
real(kind=dbl)             :: cd1, cd2, cd3, sd1, sd2, sd3
real(kind=sgl),parameter   :: thr = 1.0E-8
real(kind=dbl),parameter   :: thrd = 1.0D-10

if (rotdoubleprecision) then
  cd1 = dcos(self%ed(1))
  cd2 = dcos(self%ed(2))
  cd3 = dcos(self%ed(3))
  sd1 = dsin(self%ed(1))
  sd2 = dsin(self%ed(2))
  sd3 = dsin(self%ed(3))

  o%od(1,1) = cd1*cd3-sd1*sd3*cd2
  o%od(1,2) = sd1*cd3+cd1*sd3*cd2
  o%od(1,3) = sd3*sd2
  o%od(2,1) = -cd1*sd3-sd1*cd3*cd2
  o%od(2,2) = -sd1*sd3+cd1*cd3*cd2
  o%od(2,3) = cd3*sd2
  o%od(3,1) = sd1*sd2
  o%od(3,2) = -cd1*sd2
  o%od(3,3) = cd2

  do i=1,3
    do j=1,3
      if (dabs(o%od(i,j)).lt.thrd) o%od(i,j) = 0.D0
    end do
  end do
else
  c1 = cos(self%e(1))
  c2 = cos(self%e(2))
  c3 = cos(self%e(3))
  s1 = sin(self%e(1))
  s2 = sin(self%e(2))
  s3 = sin(self%e(3))

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

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

end function eo_

!------------------------------------------
recursive function eh_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: eh_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to homochoric vector

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(h_T)                  :: h

type(a_T)                  :: a

a = self%ea()
h = a%ah()

end function eh_

!------------------------------------------
recursive function ea_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: ea_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to axis angle pair

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(a_T)                  :: a

real(kind=sgl)             :: t, del, tau, alpha, sig
real(kind=dbl)             :: deld, td, taud, alphad, sigd
real(kind=sgl),parameter   :: thr = 1.0E-6
real(kind=dbl),parameter   :: thrd = 1.0D-10

if (rotdoubleprecision) then
  td = dtan(self%ed(2)*0.5D0)
  sigd = 0.5D0*(self%ed(1)+self%ed(3))
  deld = 0.5D0*(self%ed(1)-self%ed(3))
  taud = dsqrt(td*td+dsin(sigd)**2)

  if (close_enough_d(sigd,cPi*0.5D0)) then  ! Infinity
    alphad = cPi
  else
    alphad = 2.D0 * datan(taud/dcos(sigd))
  end if
  if (abs(alphad).lt.thrd) then
  ! return a default identity axis-angle pair
          a%ad = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
  else
  ! passive axis-angle pair so a minus sign in front
          a%ad(1:3) = - epsijkd * (/ td*dcos(deld), td*dsin(deld), dsin(sigd) /) / taud
          a%ad(4) = alphad

  ! make sure alpha is positive
          if (alphad.lt.0.D0) a%ad = -a%ad
  end if
else
  if (close_enough(self%e(2),sngl(cPi))) then
    t = sngl( dtan(cPi*0.5D0) )
  else
    t = tan(self%e(2)*0.5)
  end if
  sig = 0.5*(self%e(1)+self%e(3))
  del = 0.5*(self%e(1)-self%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
          a%a = (/ 0.0, 0.0, 1.0, 0.0 /)
  else
  ! passive axis-angle pair so a minus sign in front
          a%a(1:3) = - epsijk * (/ t*cos(del), t*sin(del), sin(sig) /) / tau
          a%a(4) = alpha

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

end function ea_

!------------------------------------------
recursive function ev_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: ev_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to rotation vector

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(v_T)                  :: v
type(a_T)                  :: ax

ax = self%ea()

if (rotdoubleprecision) then
    v%vd = ax%ad(1:3) * ax%ad(4)
else
    v%v = ax%a(1:3) * ax%a(4)
end if

end function ev_

!------------------------------------------
recursive function ec_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: ec_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to cubochoric vector

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(c_T)                  :: c

type(h_T)                  :: h

h = self%eh()
c = h%hc()

end function ec_

!------------------------------------------
recursive function eq_(self) result(q)
!DEC$ ATTRIBUTES DLLEXPORT :: eq_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from Euler angles to quaternion

IMPLICIT NONE

class(e_T), intent(inout)  :: self
type(q_T)                  :: q

real(kind=sgl)             :: ee(3), cPhi, cp, cm, sPhi, sp, sm
real(kind=dbl)             :: eed(3), cPhid, cpd, cmd, sPhid, spd, smd

if (rotdoubleprecision) then
  cPhid = dcos(self%ed(2)*0.5D0)
  sPhid = dsin(self%ed(2)*0.5D0)
  cmd = dcos((self%ed(1)-self%ed(3))*0.5D0)
  smd = dsin((self%ed(1)-self%ed(3))*0.5D0)
  cpd = dcos((self%ed(1)+self%ed(3))*0.5D0)
  spd = dsin((self%ed(1)+self%ed(3))*0.5D0)

  ! passive quaternion
  q%qd = (/ cPhid*cpd, -epsijkd*sPhid*cmd, -epsijkd*sPhid*smd, -epsijkd*cPhid*spd /)

  ! first component must be positive
  if (q%qd(1).lt.0.D0) q%qd = -q%qd
else
  cPhi = cos(self%e(2)*0.5)
  sPhi = sin(self%e(2)*0.5)
  cm = cos((self%e(1)-self%e(3))*0.5)
  sm = sin((self%e(1)-self%e(3))*0.5)
  cp = cos((self%e(1)+self%e(3))*0.5)
  sp = sin((self%e(1)+self%e(3))*0.5)

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

  ! first component must be positive
  if (q%q(1).lt.0.0) q%q = -q%q
end if

end function eq_

!------------------------------------------
recursive function qr_(self) result(r)
!DEC$ ATTRIBUTES DLLEXPORT :: qr_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to Rodrigues vector

use mod_math, only: infty, inftyd

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(r_T)                  :: r

real(kind=sgl)             :: omega, t, s
real(kind=dbl)             :: omegad, td, sd
real(kind=sgl),parameter   :: thr = 1.0E-8
real(kind=dbl),parameter   :: thrd = 1.0E-10

if (rotdoubleprecision) then
  r%rd(1:3) = self%qd(2:4)
  r%rd(4) = 0.D0

  if (self%qd(1).lt.thrd) then
    r%rd(4)=inftyd()
    return
  end if

  sd = sqrt(sum(r%rd(1:3)*r%rd(1:3)))
  if (sd.lt.thrd) then
    r%rd = (/ 0.D0, 0.D0, epsijkd, 0.D0 /)
    return
  else
    td = dtan(dacos(self%qd(1)))
    r%rd = (/ r%rd(1)/sd, r%rd(2)/sd, r%rd(3)/sd, td /)
  end if
else
  r%r(1:3) = self%q(2:4)
  r%r(4) = 0.0

  if (self%q(1).lt.thr) then
    r%r(4)=infty()
    return
  end if

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

end function qr_

!------------------------------------------
recursive function qs_(self) result(s)
!DEC$ ATTRIBUTES DLLEXPORT :: qs_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to stereographic vector

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(s_T)                  :: s

if (rotdoubleprecision) then
  s%sd(1:3) = self%qd(2:4)
  if (self%qd(1).ne.0.D0) then
     s%sd = s%sd / (1.D0 + self%qd(1))
  end if
else
  s%s(1:3) = self%q(2:4)
  if (self%q(1).ne.0.0) then
     s%s = s%s / (1.0 + self%q(1))
  end if
end if

end function qs_

!------------------------------------------
recursive function qo_(self) result(o)
!DEC$ ATTRIBUTES DLLEXPORT :: qo_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to rotation matrix

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(o_T)                  :: o

real(kind=sgl)             :: qq, qc(4)
real(kind=dbl)             :: qqd, qcd(4)

if (rotdoubleprecision) then
  qqd=self%qd(1)*self%qd(1)-(self%qd(2)*self%qd(2)+self%qd(3)*self%qd(3)+self%qd(4)*self%qd(4))

  qcd = self%qd

  o%od(1,1) = qqd+2.D0*qcd(2)*qcd(2)
  o%od(2,2) = qqd+2.D0*qcd(3)*qcd(3)
  o%od(3,3) = qqd+2.D0*qcd(4)*qcd(4)

  o%od(1,2) = 2.D0*(qcd(2)*qcd(3)-qcd(1)*qcd(4))
  o%od(2,3) = 2.D0*(qcd(3)*qcd(4)-qcd(1)*qcd(2))
  o%od(3,1) = 2.D0*(qcd(4)*qcd(2)-qcd(1)*qcd(3))
  o%od(2,1) = 2.D0*(qcd(3)*qcd(2)+qcd(1)*qcd(4))
  o%od(3,2) = 2.D0*(qcd(4)*qcd(3)+qcd(1)*qcd(2))
  o%od(1,3) = 2.D0*(qcd(2)*qcd(4)+qcd(1)*qcd(3))

  if (epsijkd.ne.1.D0) o%od = transpose(o%od)
else
  qq=self%q(1)*self%q(1)-(self%q(2)*self%q(2)+self%q(3)*self%q(3)+self%q(4)*self%q(4))

  qc = self%q

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

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

  if (epsijk.ne.1.0) o%o = transpose(o%o)
end if

end function qo_

!------------------------------------------
recursive function qh_(self) result(h)
!DEC$ ATTRIBUTES DLLEXPORT :: qh_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to homochoric vector

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(h_T)                  :: h

real(kind=sgl)             :: omega, s, f
real(kind=dbl)             :: omegad, sd, fd

if (rotdoubleprecision) then
  omegad = 2.D0 * dacos(self%qd(1))
  if (close_enough_d(omegad,0.D0)) then
          h%hd = (/ 0.D0, 0.D0, 0.D0 /)
  else
          h%hd = self%qd(2:4)
          sd = 1.D0/dsqrt(sum(h%hd**2))
          h%hd = h%hd * sd
          fd = 0.75D0 * ( omegad - dsin(omegad) )
          h%hd = h%hd * fd**(1.D0/3.D0)
  end if
else
  omega = 2.0 * acos(self%q(1))
  if (close_enough(omega,0.0)) then
          h%h = (/ 0.0, 0.0, 0.0 /)
  else
          h%h = self%q(2:4)
          s = 1.0/sqrt(sum(h%h**2))
          h%h = h%h * s
          f = 0.75 * ( omega - sin(omega) )
          h%h = h%h * f**(1.0/3.0)
  end if
end if

end function qh_

!------------------------------------------
recursive function qa_(self) result(a)
!DEC$ ATTRIBUTES DLLEXPORT :: qa_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to axis angle pair

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(a_T)                  :: a
real(kind=sgl)             :: omega, s
real(kind=dbl)             :: omegad, sd

if (rotdoubleprecision) then
  omegad = 2.D0 * dacos(self%qd(1))
  ! if the angle equals zero, then we return the rotation axis as [001]
  if (close_enough_d(omegad,0.D0)) then
    a%ad = (/ 0.D0, 0.D0, 1.D0, 0.D0 /)
  else
    if (self%qd(1).ne.0.D0) then
      sd =  (self%qd(1)/dabs(self%qd(1)))/dsqrt(self%qd(2)**2+self%qd(3)**2+self%qd(4)**2)
      a%ad = (/ self%qd(2)*sd, self%qd(3)*sd, self%qd(4)*sd, omegad /)
    else
      a%ad = (/ self%qd(2), self%qd(3), self%qd(4), cPi /)
    end if
  end if
else
  omega = 2.0 * acos(self%q(1))
  ! if the angle equals zero, then we return the rotation axis as [001]
  if (close_enough(omega,0.0)) then
    a%a = (/ 0.0, 0.0, 1.0, 0.0 /)
  else
    if (self%q(1).ne.0.0) then
      s =  (self%q(1)/abs(self%q(1)))/sqrt(self%q(2)**2+self%q(3)**2+self%q(4)**2)
      a%a = (/ self%q(2)*s, self%q(3)*s, self%q(4)*s, omega /)
    else
      a%a = (/ self%q(2), self%q(3), self%q(4), sngl(cPi) /)
    end if
  end if
end if

end function qa_

!------------------------------------------
recursive function qv_(self) result(v)
!DEC$ ATTRIBUTES DLLEXPORT :: qv_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to rotation vector

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(v_T)                  :: v

type(e_T)                  :: e

e = self%qe()
v = e%ev()

end function qv_

!------------------------------------------
recursive function qc_(self) result(c)
!DEC$ ATTRIBUTES DLLEXPORT :: qc_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to cubochoric vector

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(c_T)                  :: c

type(h_T)                  :: h

h = self%qh()
c = h%hc()

end function qc_

!------------------------------------------
recursive function qe_(self) result(e)
!DEC$ ATTRIBUTES DLLEXPORT :: qe_
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! Conversion from quaternion to Euler angles

IMPLICIT NONE

class(q_T), intent(inout)  :: self
type(e_T)                  :: e

real(kind=sgl)             :: q12, q03, chi, Phi, phi1, phi2
real(kind=dbl)             :: qd12, qd03, chid, Phid, phid1, phid2

if (rotdoubleprecision) then
  qd03 = self%qd(1)**2+self%qd(4)**2
  qd12 = self%qd(2)**2+self%qd(3)**2
  chid = sqrt(qd03*qd12)

  if (close_enough_d(chid,0.D0)) then
    if (close_enough_d(qd12,0.D0)) then
      Phid  = 0.D0
      phid2 = 0.D0                  ! arbitrarily due to degeneracy
      phid1 = datan2(-epsijkd*2.D0*self%qd(1)*self%qd(4),self%qd(1)**2-self%qd(4)**2)
    else
      Phid  = cPi
      phid2 = 0.D0                  ! arbitrarily due to degeneracy
      phid1 = datan2(2.0*self%qd(2)*self%qd(3),self%qd(2)**2-self%qd(3)**2)
    end if
  else            ! this is not a special degenerate case
      Phid  = datan2( 2.D0*chid, qd03-qd12 )
      chid  = 1.D0/chid
      phid1 = datan2( (-epsijkd*self%qd(1)*self%qd(3)+self%qd(2)*self%qd(4))*chid, &
                      (-epsijkd*self%qd(1)*self%qd(2)-self%qd(3)*self%qd(4))*chid )
      phid2 = datan2( ( epsijkd*self%qd(1)*self%qd(3)+self%qd(2)*self%qd(4))*chid, &
                      (-epsijkd*self%qd(1)*self%qd(2)+self%qd(3)*self%qd(4))*chid )
  end if

  e%ed = (/ phid1, Phid, phid2 /)

  ! reduce Euler angles to definition ranges (and positive values only)
  if (e%ed(1).lt.0.D0) e%ed(1) = dmod(e%ed(1)+100.D0*cPi,2.D0*cPi)
  if (e%ed(2).lt.0.D0) e%ed(2) = dmod(e%ed(2)+100.D0*cPi,     cPi)
  if (e%ed(3).lt.0.D0) e%ed(3) = dmod(e%ed(3)+100.D0*cPi,2.D0*cPi)
else
  q03 = self%q(1)**2+self%q(4)**2
  q12 = self%q(2)**2+self%q(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*self%q(1)*self%q(4),self%q(1)**2-self%q(4)**2)
    else
      Phi = sngl(cPi)
      phi2 = 0.0                  ! arbitrarily due to degeneracy
      phi1 = atan2(2.0*self%q(2)*self%q(3),self%q(2)**2-self%q(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*self%q(1)*self%q(3)+self%q(2)*self%q(4))*chi, &
                    (-epsijk*self%q(1)*self%q(2)-self%q(3)*self%q(4))*chi )
      phi2 = atan2( (epsijk*self%q(1)*self%q(3)+self%q(2)*self%q(4))*chi, &
                    (-epsijk*self%q(1)*self%q(2)+self%q(3)*self%q(4))*chi )
  end if

  e%e = (/ phi1, Phi, phi2 /)

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

end function qe_

!------------------------------------------
subroutine setRotationPrecision(c)
!DEC$ ATTRIBUTES DLLEXPORT :: setRotationPrecision

IMPLICIT NONE

character(*), INTENT(IN)    :: c

select case(trim(c))
 case('d')
    rotdoubleprecision = .TRUE.
 case('double')
    rotdoubleprecision = .TRUE.
 case('Double')
    rotdoubleprecision = .TRUE.
 case('s')
    rotdoubleprecision = .FALSE.
 case('single')
    rotdoubleprecision = .FALSE.
 case('Single')
    rotdoubleprecision = .FALSE.
end select

end subroutine setRotationPrecision

!------------------------------------------
function getRotationPrecision() result(p)
!DEC$ ATTRIBUTES DLLEXPORT :: getRotationPrecision

IMPLICIT NONE

character(1)     :: p

p = 's'
if (rotdoubleprecision) p = 'd'

end function getRotationPrecision

!--------------------------------------------------------------------------
recursive function RodriguesProduct(rA,rB) result(rC)
!DEC$ ATTRIBUTES DLLEXPORT :: RodriguesProduct
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! multiply two Rodrigues vectors

use mod_math, only: cross3, vecnorm

type(r_T),INTENT(IN)       :: rA
type(r_T),INTENT(IN)       :: rB

type(r_T)                  :: rC
real(kind=sgl)             :: vsA(3), vsB(3), vsC(3), l
real(kind=dbl)             :: vdA(3), vdB(3), vdC(3), ld

if (rotdoubleprecision) then
  vdA = rA%rd(1:3) * rA%rd(4)
  vdB = rB%rd(1:3) * rB%rd(4)
  vdC = (vdA + vdB - cross3(vdA,vdB))/(1.D0 - DOT_PRODUCT(vdA, vdB))
  ld = vecnorm(vdC)
  rC%rd(1:3) = vdC(1:3)/ld
  rC%rd(4) = ld
else
  vsA = rA%r(1:3) * rA%r(4)
  vsB = rB%r(1:3) * rB%r(4)
  vsC = (vsA + vsB - cross3(vsA,vsB))/(1.0 - DOT_PRODUCT(vsA, vsB))
  ld = vecnorm(vsC)
  rC%r(1:3) = vsC(1:3)/l
  rC%r(4) = l
end if

end function RodriguesProduct

!--------------------------------------------------------------------------
recursive function quat_average(qlist, numq, qstdev) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: quat_average
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! computes the geometrical mean of a list of quaternions using the quaternion logarithm

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

type(q_T)                       :: q
type(a_T)                       :: a
integer(kind=irg)               :: i
real(kind=sgl)                  :: lsum(3), ax(4), qv, sqv, dfm(3)
real(kind=sgl)                  :: axanglist(3,numq)

! convert each one to a logarithm, which is really the unit rotation vector multiplied by half the rotation angle
do i=1,numq
! convert each quaternion to an axis angle pair
  q = q_T( qinp = qlist(1:4,i) )
  a = q%qa()
  ax = a%a
  axanglist(1:3,i) =  ax(1:3)*0.5*ax(4)
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 function quat_average

!--------------------------------------------------------------------------
recursive function quat_average_d(qlist, numq, qstdev) result(res)
!DEC$ ATTRIBUTES DLLEXPORT :: quat_average_d
 !! author: MDG
 !! version: 1.0
 !! date: 01/17/20
 !!
 !! computes the geometrical mean of a list of quaternions using the quaternion logarithm

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

type(q_T)                       :: q
type(a_T)                       :: a
integer(kind=irg)               :: i
real(kind=dbl)                  :: lsum(3), ax(4), qv, sqv, dfm(3)
real(kind=dbl)                  :: axanglist(3,numq)

! convert each one to a logarithm, which is really the unit rotation vector multiplied by half the rotation angle
do i=1,numq
! convert the quaternion to an axis angle pair
  q = q_T( qdinp = qlist(1:4,i) )
  a = q%qa()
  ax = a%ad
  axanglist(1:3,i) =  ax(1:3)*0.5D0*ax(4)
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 function quat_average_d

end module mod_rotations