Index of Functions: A  B  C  D  E  F  G  H  I  J  K  L  M  N  O  P  Q  R  S  T  U  V  W  X 
Index Page
xf2eul

Table of contents
Procedure
Abstract
Required_Reading
Keywords
Declarations
Brief_I/O
Detailed_Input
Detailed_Output
Parameters
Exceptions
Files
Particulars
Examples
Restrictions
Literature_References
Author_and_Institution
Version

Procedure

     XF2EUL ( State transformation to Euler angles )

     SUBROUTINE XF2EUL ( XFORM, AXISA, AXISB, AXISC, EULANG, UNIQUE )

Abstract

     Convert a state transformation matrix to Euler angles and their
     derivatives, given a specified set of axes.

Required_Reading

     PCK
     ROTATION

Keywords

     ANGLES
     DERIVATIVES
     STATE

Declarations

     IMPLICIT NONE

     DOUBLE PRECISION      XFORM  ( 6, 6 )
     INTEGER               AXISA
     INTEGER               AXISB
     INTEGER               AXISC
     DOUBLE PRECISION      EULANG ( 6 )
     LOGICAL               UNIQUE

Brief_I/O

     VARIABLE  I/O  DESCRIPTION
     --------  ---  --------------------------------------------------
     XFORM      I   A state transformation matrix.
     AXISA      I   Axis A of the Euler angle factorization.
     AXISB      I   Axis B of the Euler angle factorization.
     AXISC      I   Axis C of the Euler angle factorization.
     EULANG     O   An array of Euler angles and their derivatives.
     UNIQUE     O   Indicates if EULANG is a unique representation.

Detailed_Input

     XFORM    is a state transformation matrix from some frame FRAME1
              to another frame FRAME2. Pictorially, XFORM has the
              structure shown here.

                 .-             -.
                 |       |       |
                 |   R   |   0   |
                 |       |       |
                 |-------+-------|
                 |       |       |
                 | dR/dt |   R   |
                 |       |       |
                 `-             -'

              where R is a rotation matrix that varies with respect to
              time and dR/dt is its time derivative.

              More specifically, if S1 is the state of some object
              in FRAME1, then S2, the state of the same object
              relative to FRAME2 is given by

                 S2 = XFORM * S1

              where "*" denotes the matrix vector product.

     AXISA,
     AXISB,
     AXISC    are the axes desired for the factorization of R.

              All must be in the range from 1 to 3. Moreover
              it must be the case that AXISA and AXISB are distinct
              and that AXISB and AXISC are distinct.

              Every rotation matrix can be represented as a product
              of three rotation matrices about the principal axes
              of a reference frame.

                 R =  [ ALPHA ]      [ BETA ]      [ GAMMA ]
                               AXISA         AXISB          AXISC

              The value 1 corresponds to the X axis.
              The value 2 corresponds to the Y axis.
              The value 3 corresponds to the Z axis.

Detailed_Output

     EULANG   is the set of Euler angles corresponding to the
              specified factorization.

              If we represent R as shown here:

                 R =  [ ALPHA ]      [ BETA ]      [ GAMMA ]
                               AXISA         AXISB          AXISC

              then

                 EULANG(1) = ALPHA
                 EULANG(2) = BETA
                 EULANG(3) = GAMMA
                 EULANG(4) = dALPHA/dt
                 EULANG(5) = dBETA/dt
                 EULANG(6) = dGAMMA/dt

              The range of ALPHA and GAMMA is (-pi, pi].

              The range of BETA depends on the exact set of
              axes used for the factorization. For
              factorizations in which the first and third axes
              are the same, the range of BETA is [0, pi].

              For factorizations in which the first and third
              axes are different, the range of BETA is
              [-pi/2, pi/2].

              For rotations such that ALPHA and GAMMA are not
              uniquely determined, ALPHA and dALPHA/dt will
              always be set to zero; GAMMA and dGAMMA/dt are
              then uniquely determined.

     UNIQUE   is a logical that indicates whether or not the
              values in EULANG are uniquely determined. If
              the values are unique then UNIQUE will be set to
              .TRUE. If the values are not unique and some
              components ( EULANG(1) and EULANG(4) ) have been set
              to zero, then UNIQUE will have the value .FALSE.

Parameters

     None.

Exceptions

     1)  If any of AXISA, AXISB, or AXISC do not have values in

            { 1, 2, 3 }

         an error is signaled by a routine in the call tree of this
         routine.

     2)  If AXISB is equal to AXISC or AXISA, an error is signaled by a
         routine in the call tree of this routine. An arbitrary
         rotation matrix cannot be expressed using a sequence of Euler
         angles unless the second rotation axis differs from the other
         two.

     3)  If the input matrix XFORM is not a rotation matrix, an error
         is signaled by a routine in the call tree of this routine.

     4)  If EULANG(1) and EULANG(3) are not uniquely determined,
         EULANG(1) is set to zero, and EULANG(3) is determined.

Files

     None.

Particulars

     A word about notation: the symbol

        [ x ]
             i

     indicates a coordinate system rotation of x radians about the
     ith coordinate axis. To be specific, the symbol

        [ x ]
             1

     indicates a coordinate system rotation of x radians about the
     first, or x-, axis; the corresponding matrix is

        .-                    -.
        |  1      0       0    |
        |                      |
        |  0    cos(x)  sin(x) |
        |                      |
        |  0   -sin(x)  cos(x) |
        `-                    -'

     Remember, this is a COORDINATE SYSTEM rotation by x radians; this
     matrix, when applied to a vector, rotates the vector by -x
     radians, not x radians. Applying the matrix to a vector yields
     the vector's representation relative to the rotated coordinate
     system.

     The analogous rotation about the second, or y-, axis is
     represented by

        [ x ]
             2

     which symbolizes the matrix

        .-                    -.
        | cos(x)   0   -sin(x) |
        |                      |
        |  0       1      0    |
        |                      |
        | sin(x)   0    cos(x) |
        `-                    -'

     and the analogous rotation about the third, or z-, axis is
     represented by

        [ x ]
             3

     which symbolizes the matrix

        .-                    -.
        |  cos(x)  sin(x)   0  |
        |                      |
        | -sin(x)  cos(x)   0  |
        |                      |
        |  0        0       1  |
        `-                    -'

     The input matrix is assumed to be the product of three
     rotation matrices, each one of the form

        .-                    -.
        |  1      0       0    |
        |                      |
        |  0    cos(r)  sin(r) |     (rotation of r radians about the
        |                      |      x-axis),
        |  0   -sin(r)  cos(r) |
        `-                    -'


        .-                    -.
        | cos(s)   0   -sin(s) |
        |                      |
        |  0       1      0    |     (rotation of s radians about the
        |                      |      y-axis),
        | sin(s)   0    cos(s) |
        `-                    -'

     or

        .-                    -.
        |  cos(t)  sin(t)   0  |
        |                      |
        | -sin(t)  cos(t)   0  |     (rotation of t radians about the
        |                      |      z-axis),
        |  0        0       1  |
        `-                    -'

     where the second rotation axis is not equal to the first or
     third. Any rotation matrix can be factored as a sequence of
     three such rotations, provided that this last criterion is met.

     This routine is related to the routine EUL2XF which produces
     a state transformation from an input set of axes, Euler angles
     and derivatives.

     The two subroutine calls shown here will not change
     XFORM except for round off errors.

        CALL XF2EUL ( XFORM,  AXISA, AXISB, AXISC, EULANG, UNIQUE )
        CALL EUL2XF ( EULANG, AXISA, AXISB, AXISC, XFORM          )

     On the other hand the two calls

        CALL EUL2XF ( EULANG, AXISA, AXISB, AXISC, XFORM          )
        CALL XF2EUL ( XFORM,  AXISA, AXISB, AXISC, EULANG, UNIQUE )

     will leave EULANG unchanged only if the components of EULANG
     are in the range produced by XF2EUL and the Euler representation
     of the rotation component of XFORM is unique within that range.

Examples

     The numerical results shown for this example may differ across
     platforms. The results depend on the SPICE kernels used as
     input, the compiler and supporting libraries, and the machine
     specific arithmetic implementation.

     1) Determine the rate of change of the right ascension and
        declination of the pole of the moon, from the state
        transformation matrix that transforms J2000 states to object
        fixed states.

        Recall that the rotation component of the state transformation
        matrix is given by

           [W]  [HALFPI-DEC]  [RA+HALFPI]
              3             1            3


        Use the meta-kernel shown below to load the required SPICE
        kernels.


           KPL/MK

           File name: xf2eul_ex1.tm

           This meta-kernel is intended to support operation of SPICE
           example programs. The kernels shown here should not be
           assumed to contain adequate or correct versions of data
           required by SPICE-based user applications.

           In order for an application to use this meta-kernel, the
           kernels referenced here must be present in the user's
           current working directory.

           The names and contents of the kernels referenced
           by this meta-kernel are as follows:

              File name                     Contents
              ---------                     --------
              pck00010.tpc                  Planet orientation and
                                            radii
              naif0012.tls                  Leapseconds


           \begindata

              KERNELS_TO_LOAD = ( 'pck00010.tpc',
                                  'naif0012.tls'  )

           \begintext

           End of meta-kernel


        Example code begins here.


              PROGRAM XF2EUL_EX1
              IMPLICIT NONE

        C
        C     SPICELIB functions.
        C
              DOUBLE PRECISION      HALFPI

        C
        C     Local parameters.
        C
              CHARACTER*(*)         META
              PARAMETER           ( META   = 'xf2eul_ex1.tm' )

              CHARACTER*(*)         UTCSTR
              PARAMETER           ( UTCSTR = 'May 15, 2007' )

        C
        C     Local variables.
        C
              DOUBLE PRECISION      EULANG ( 6    )
              DOUBLE PRECISION      ET
              DOUBLE PRECISION      FTMTRX ( 6, 6 )

              INTEGER               I
              INTEGER               J

              LOGICAL               UNIQUE

        C
        C     Load SPICE kernels.
        C
              CALL FURNSH ( META )

        C
        C     Convert the input time to seconds past J2000 TDB.
        C
              CALL STR2ET ( UTCSTR, ET )

        C
        C     Get the transformation matrix from J2000 frame to
        C     IAU_MOON.
        C
              CALL SXFORM ( 'J2000', 'IAU_MOON', ET, FTMTRX )

        C
        C     Convert the transformation matrix to
        C     Euler angles (3-1-3).
        C
              CALL XF2EUL ( FTMTRX, 3, 1, 3, EULANG, UNIQUE )

        C
        C     Display the results.
        C
              IF ( UNIQUE ) THEN

                 WRITE(*,'(2A)') 'UTC: ', UTCSTR
                 WRITE(*,'(A,F20.16)') 'W       = ', EULANG(1)
                 WRITE(*,'(A,F20.16)') 'DEC     = ',
             .                  HALFPI() - EULANG(2)
                 WRITE(*,'(A,F20.16)') 'RA      = ',
             .                  EULANG(3) - HALFPI()
                 WRITE(*,'(A,F20.16)') 'dW/dt   = ', EULANG(4)
                 WRITE(*,'(A,F20.16)') 'dDEC/dt = ', EULANG(5)
                 WRITE(*,'(A,F20.16)') 'dRA/dt  = ', EULANG(6)

              ELSE

                 WRITE(*,*) 'The values in EULANG are not uniquely '
             .          //  'determined.'

              END IF

              END


        When this program was executed on a Mac/Intel/gfortran/64-bit
        platform, the output was:


        UTC: May 15, 2007
        W       =  -2.6490877296701645
        DEC     =   1.1869108599473206
        RA      =  -1.5496443908099826
        dW/dt   =   0.0000026578085601
        dDEC/dt =   0.0000000004021737
        dRA/dt  =   0.0000000039334471

Restrictions

     None.

Literature_References

     None.

Author_and_Institution

     N.J. Bachman       (JPL)
     J. Diaz del Rio    (ODC Space)
     W.L. Taber         (JPL)
     E.D. Wright        (JPL)

Version

    SPICELIB Version 2.1.0, 26-OCT-2021 (JDR)

        Added IMPLICIT NONE statement.

        Edited the header to comply with NAIF standard. Removed
        unnecessary $Revisions section.

        Added complete code example based on existing fragment.
        Corrected input argument name in $Exceptions section.

    SPICELIB Version 2.0.1, 25-APR-2007 (EDW)

        Corrected code in EUL2EF entry point $Examples section, example
        showed a XF2EUL call:

           CALL XF2EUL ( XFORM,  1, 2, 3, RPYANG )

        The proper form of the call:

           CALL XF2EUL ( XFORM,  1, 2, 3, RPYANG, UNIQUE )

    SPICELIB Version 2.0.0, 31-OCT-2005 (NJB)

        Entry point EUL2XF was updated to allow axis sequences
        in which the second angle is not distinct from the first
        or third.

    SPICELIB Version 1.0.0, 31-JUL-1995 (WLT)
Fri Dec 31 18:37:08 2021