C                                                            <HTML><PRE>
C Subroutine file 'an.for': Applications and processing of the results
C of complete ray tracing of anisotropic rays in anisotropic media.
C
C Version: 7.10
C Date: 2014, February 5
C Coded by Ludek Klimes
C
C This file contains subroutines designed to modify the output of
C subroutines of file <A HREF="ap.for" TYPE="text/html">ap.for</A>
C for anisotropic rays calculated in anisotropic media.
C
C This file consists of the following external procedures:
C     AN03... Subroutine designed to correct the covariant and
C             contravariant components of the basis vectors of the
C             intrinsic ray-centred coordinate system in anisotropic
C             media, calculated by subroutine AP03.
C             <A HREF="#AN03">AN03</A>
C
C=======================================================================
C
C     <A NAME="AN03"></A>
C
      SUBROUTINE AN03(ICB,Y,H)
      INTEGER ICB
      REAL Y(8),H(18)
C
C Subroutine AP03, originally designed for isotropic models, can be used
C also for anisotropic rays in anisotropic models.  Subroutine AP03 then
C calculates covariant and contravariant components (with respect to the
C Riemannian model metric) of the first two contravariant (with respect
C to the Finslerian wave-propagation metric) basis vectors of the
C ray-centred coordinate system and of the third covariant (with respect
C to the Finslerian wave-propagation metric) basis vector.
C
C Subroutine AN03 converts these components into the covariant
C components (with respect to the Riemannian model metric) of the
C covariant (with respect to the Finslerian wave-propagation metric)
C basis vectors and into the contravariant components (with respect to
C the Riemannian model metric) of the contravariant (with respect to
C the Finslerian wave-propagation metric) basis vectors.
C
C Note that if the model coordinates are Cartesian, the Riemannian model
C metric tensor simplifies to the identity matrix.
C
C Example of using subroutines
C <A HREF="ap.for#AP03" TYPE="text/html">AP03</A> and AN03
C for a point O/F which is stored in array Y of common block POINTC:
C     CALL AP03(0,HI,H,HUI)
C     CALL AN03(ICB1I,YI,HI)
C     CALL AN03(ICB1,Y,H)
C where ICB1I, YI, ICB1 and Y are located in common block
C <A HREF="pointc.inc" TYPE="text/html">/POINTC/</A>.
C Another example of using subroutines AP03 and AN03
C for a point O/F which is stored in array YF of common block POINTC:
C     CALL APYYF
C     CALL AP03(0,HI,H,HUI)
C     CALL APYYF
C     CALL AN03(ICB1I,YI,HI)
C     CALL AN03(ICB1F,YF,H)
C
C Input:
C     ICB...  Index of the complex block in which the point of a ray is
C             situated, supplemented by a sign '+' for P wave and sign
C             '-' for S wave.
C     Y...    Quantities describing the point of a ray.
C     H...    Covariant (H(1:9)) and contravariant (H(10:18)) components
C             (with respect to the Riemannian model metric) of the basis
C             vectors of the intrinsic ray-centred coordinate system at
C             the given point.
C             With respect to the Finslerian wave-propagation metric,
C             the first two basis vectors are contravariant while the
C             third one is covariant.
C             Array H should be the output of subroutine AP03 called
C             with IUSER=0.
C
C Output:
C     H...    Covariant (H(1:9)) components (with respect to the
C             Riemannian model metric) of the covariant basis vectors
C             (with respect to the Finslerian wave-propagation metric),
C             and contravariant (H(10:18)) components (with respect to
C             the Riemannian model metric) of the contravariant basis
C             vectors (with respect to the Finslerian wave-propagation
C             metric) of the intrinsic ray-centred coordinate system at
C             the given point.
C             The contravariant basis vectors are normalized with
C             respect to the Riemannian model metric.
C
C Subroutines and external functions required:
      EXTERNAL PARM3,HDER
C     PARM3.. File 'parm.for' of the package 'MODEL'.
C     HDER... File 'hder.for' of the package 'FORMS'.
*     INTEGER KOOR
*     EXTERNAL KOOR,METRIC
C     KOOR,METRIC... File 'metric.for' of the package 'MODEL'.
C
C Date: 2014, February 5
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations for local model parameters:
      REAL A(10,21),RHO,Q(21)
C     Auxiliary storage locations for the Hamiltonian derivatives:
      INTEGER IERR
      REAL HHP,HHS,HH,HH1,HH2,HH3,HH4,HH5,HH6
      REAL HH11,HH12,HH22,HH13,HH23,HH33,HH14,HH24,HH34,HH44
      REAL HH15,HH25,HH35,HH45,HH55,HH16,HH26,HH36,HH46,HH56,HH66
C     Auxiliary storage locations for the eigenvectors of the reference
C     Christoffel matrix:
      REAL E(9)
C     Norm of a vector:
      REAL P
C     Auxiliary storage locations for curvilinear coordinates:
*     REAL GSQRD,G(12),GAMMA(18)
C
C.......................................................................
C
C     Material parameters and the derivatives of the Hamiltonian:
      CALL PARM3(IABS(ICB),Y(3),A,RHO,Q)
      CALL HDER(ICB,A,Y(6),Y(7),Y(8),
     *          HHP,HHS,HH,HH1,HH2,HH3,HH4,HH5,HH6,
     *          HH11,HH12,HH22,HH13,HH23,HH33,HH14,HH24,HH34,HH44,
     *          HH15,HH25,HH35,HH45,HH55,HH16,HH26,HH36,HH46,HH56,HH66,
     *          E,IERR)
C
C     Correcting the basis vectors:
      P=SQRT(Y(6)**2+Y(7)**2+Y(8)**2)
      H(16)=HH4*P
      H(17)=HH5*P
      H(18)=HH6*P
      H(1)=H(14)*H(18)-H(17)*H(15)
      H(2)=H(15)*H(16)-H(18)*H(13)
      H(3)=H(13)*H(17)-H(16)*H(14)
      H(4)=H(17)*H(12)-H(11)*H(18)
      H(5)=H(18)*H(10)-H(12)*H(16)
      H(6)=H(16)*H(11)-H(10)*H(17)
      P=SQRT(H(16)**2+H(17)**2+H(18)**2)
      H(7)=H(7)*P
      H(8)=H(8)*P
      H(9)=H(9)*P
      H(16)=H(16)/P
      H(17)=H(17)/P
      H(18)=H(18)/P
*     IF(KOOR().NE.0) THEN
C       Curvilinear coordinates:
*       CALL METRIC(Y(3),GSQRD,G,GAMMA)
*       H(1)=H(1)*GSQRD
*       H(2)=H(2)*GSQRD
*       H(3)=H(3)*GSQRD
*       H(4)=H(4)*GSQRD
*       H(5)=H(5)*GSQRD
*       H(6)=H(6)*GSQRD
*     END IF
      RETURN
      END
C
C=======================================================================
C
