C
C Grid travel time tracing: second-order method for the first arrivals
C in smooth models.  Testing 2-D version based on the NET program.
C
C Version: 3.00
C Date: 1996, June 18
C
C Author:
C     Ludek Klimes
C             Department of Geophysics, Charles University Prague
C             Ke Karlovu 3
C             121 16  Praha 2,  Czech Republic
C             http://sw3d.cz/staff/klimes.htm
C
C To be linked with 'net.for' version 3.00 or later.
C
C Reference:
C     Klimes, L. (1996):  Grid travel-time tracing: second-order method
C             for the first arrivals in smooth media.
C             PAGEOPH, 148, 539-563.
C
C=======================================================================
C
      SUBROUTINE TTTSRC()
C
C Auxiliary subroutine to SOURCE.
C
C Date: 1996, June 18
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Common blocks /GRID/ /FS/ /NODE/ /SRCC/ are required here:
      INCLUDE 'net.inc'
      INCLUDE 'netnode.inc'
C
C-----------------------------------------------------------------------
C
      INTEGER I1,I2,I
      REAL U2,UG1,UG2,AUX0,AUX1,AUX2
C
C.......................................................................
C
C     Annulling second slowness-vector components:
      DO 10 I=1,NL1*NL2*NL3
        RAM(IP20+I)=0.
   10 CONTINUE
C
C     Slowness gradient:
      IF(0.LT.IPOS1) THEN
        IF(IPOS1.LT.NL1-1) THEN
          UG1=(RAM(IP10+IPOS+1)-RAM(IP10+IPOS-1))/(DSX1+DSX1)
        ELSE
          UG1=(RAM(IP10+IPOS)  -RAM(IP10+IPOS-1))/ DSX1
        END IF
      ELSE
        IF(IPOS1.LT.NL1-1) THEN
          UG1=(RAM(IP10+IPOS+1)-RAM(IP10+IPOS)  )/ DSX1
        ELSE
          UG1=0.
        END IF
      END IF
      IF(0.LT.IPOS2) THEN
        IF(IPOS2.LT.NL2-1) THEN
          UG2=(RAM(IP10+IPOS+NL1)-RAM(IP10+IPOS-NL1))/(DSX2+DSX2)
        ELSE
          UG2=(RAM(IP10+IPOS)    -RAM(IP10+IPOS-NL1))/ DSX2
        END IF
      ELSE
        IF(IPOS1.LT.NL1-1) THEN
          UG2=(RAM(IP10+IPOS+NL1)-RAM(IP10+IPOS)    )/ DSX2
        ELSE
          UG2=0.
        END IF
      END IF
C
C     Loop over forward star of size 1:
      DO 22 I2=MAX0(-IPOS2,-1),MIN0(NL2-1-IPOS2,1)
        DO 21 I1=MAX0(-IPOS1,-1),MIN0(NL1-1-IPOS1,1)
            I=IPOS+I1+NL1*I2
            U2=RAM(IP10+I)
            AUX1=FLOAT(I1)*DSX1-DPOS1
            AUX2=FLOAT(I2)*DSX2-DPOS2
            AUX0=SQRT(AUX1*AUX1+AUX2*AUX2)
            RAM(ITT0+I)=TTI+0.5*(PI+U2)*AUX0
            IF(AUX0.NE.0.) THEN
C             AUX1=0.5*((PI+U2)*AUX1/AUX0+UG1*AUX0)
C             AUX2=0.5*((PI+U2)*AUX2/AUX0+UG2*AUX0)
              AUX0=AUX0*AUX0/(PI+U2)
              AUX1=AUX1+UG1*AUX0
              AUX2=AUX2+UG2*AUX0
              AUX0=SQRT(AUX1*AUX1+AUX2*AUX2)
              RAM(IP10+I)=U2*AUX1/AUX0
              RAM(IP20+I)=U2*AUX2/AUX0
            ELSE
              RAM(IP10+I)=U2
              RAM(IP20+I)=0.
            END IF
C           Updating queue by adding new node as Q(MAXQ)
            MAXQ=MAXQ+1
            IRAM(IPOSQ0+MAXQ)=I
          IF(I1.EQ.0.AND.I2.EQ.0) THEN
            RAM(ITT0+I)=-RAM(ITT0+I)
          END IF
   21   CONTINUE
   22 CONTINUE
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE TTTUPD()
C
C This subroutine performs the loop over the grid-line-neighbour nodes.
C
C Auxiliary subroutine to GENER.
C
C Date: 1996, June 18
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Common blocks /GRID/ /FS/ /NODE/ are required here:
      INCLUDE 'net.inc'
      INCLUDE 'netnode.inc'
C
C-----------------------------------------------------------------------
C
      REAL GIANT
      PARAMETER (GIANT=1.E+10)
C
      INTEGER I,I1
      REAL TT0,P10,P20,TT1,P11,P21,PR2
C
C.......................................................................
C
C     Loop over gridline segments starting at node IPOS:
      TT0=RAM(ITT0+IPOS)
      P10=RAM(IP10+IPOS)
      P20=RAM(IP20+IPOS)
      IF(IPOS1.GT.0) THEN
        I1=IPOS-1
        TT1=RAM(ITT0+I1)
        P11=RAM(IP10+I1)
        P21=RAM(IP20+I1)
        IF(ABS(TT1).LE.TT0) THEN
          PR2=P11+P11-P10
          IF(IPOS1.GT.1) THEN
            IF(ABS(RAM(ITT0+IPOS-2)).LE.TT0) THEN
              PR2=RAM(IP10+IPOS-2)
            END IF
          END IF
          IF(IPOS2.GT.0) THEN
            I=I1  -NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P11,P21, DSX1,TT0,P10,P20,
     *         -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2)
            I=IPOS-NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P10,P20,-DSX1,TT1,P11,P21,
     *         -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2)
          END IF
          IF(IPOS2.LT.NL2-1) THEN
            I=I1  +NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P11,P21, DSX1,TT0,P10,P20,
     *          DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2)
            I=IPOS+NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P10,P20,-DSX1,TT1,P11,P21,
     *          DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2)
          END IF
        END IF
      END IF
      IF(IPOS1.LT.NL1-1) THEN
        I1=IPOS+1
        TT1=RAM(ITT0+I1)
        P11=RAM(IP10+I1)
        P21=RAM(IP20+I1)
        IF(ABS(TT1).LE.TT0) THEN
          PR2=P11+P11-P10
          IF(IPOS1.LT.NL1-2) THEN
            IF(ABS(RAM(ITT0+IPOS+2)).LE.TT0) THEN
              PR2=RAM(IP10+IPOS+2)
            END IF
          END IF
          IF(IPOS2.GT.0) THEN
            I=I1  -NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P11,P21,-DSX1,TT0,P10,P20,
     *         -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2)
            I=IPOS-NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P10,P20, DSX1,TT1,P11,P21,
     *         -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2)
          END IF
          IF(IPOS2.LT.NL2-1) THEN
            I=I1  +NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P11,P21,-DSX1,TT0,P10,P20,
     *          DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2)
            I=IPOS+NL1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P10,P20, DSX1,TT1,P11,P21,
     *          DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2)
          END IF
        END IF
      END IF
      IF(IPOS2.GT.0) THEN
        I1=IPOS-NL1
        TT1=RAM(ITT0+I1)
        P11=RAM(IP10+I1)
        P21=RAM(IP20+I1)
        IF(ABS(TT1).LE.TT0) THEN
          PR2=P21+P21-P20
          IF(IPOS2.GT.1) THEN
            IF(ABS(RAM(ITT0+IPOS-2*NL1)).LE.TT0) THEN
              PR2=RAM(IP20+IPOS-2*NL1)
            END IF
          END IF
          IF(IPOS1.GT.0) THEN
            I=I1  -1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P21,P11, DSX2,TT0,P20,P10,
     *         -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2)
            I=IPOS-1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P20,P10,-DSX2,TT1,P21,P11,
     *         -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2)
          END IF
          IF(IPOS1.LT.NL1-1) THEN
            I=I1  +1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P21,P11, DSX2,TT0,P20,P10,
     *          DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2)
            I=IPOS+1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P20,P10,-DSX2,TT1,P21,P11,
     *          DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2)
          END IF
        END IF
      END IF
      IF(IPOS2.LT.NL2-1) THEN
        I1=IPOS+NL1
        TT1=RAM(ITT0+I1)
        P11=RAM(IP10+I1)
        P21=RAM(IP20+I1)
        IF(ABS(TT1).LE.TT0) THEN
          PR2=P21+P21-P20
          IF(IPOS2.LT.NL2-2) THEN
            IF(ABS(RAM(ITT0+IPOS+2*NL1)).LE.TT0) THEN
              PR2=RAM(IP20+IPOS+2*NL1)
            END IF
          END IF
          IF(IPOS1.GT.0) THEN
            I=I1  -1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P21,P11,-DSX2,TT0,P20,P10,
     *         -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2)
            I=IPOS-1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P20,P10, DSX2,TT1,P21,P11,
     *         -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2)
          END IF
          IF(IPOS1.LT.NL1-1) THEN
            I=I1  +1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT1,P21,P11,-DSX2,TT0,P20,P10,
     *          DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2)
            I=IPOS+1
            IF(RAM(ITT0+I).GE.GIANT) THEN
              MAXQ=MAXQ+1
              IRAM(IPOSQ0+MAXQ)=I
            END IF
            CALL TTT(TT0,P20,P10, DSX2,TT1,P21,P11,
     *          DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2)
          END IF
        END IF
      END IF
C
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE TTT
     *         (TT0,P10,P20,DX1,TT1,P11,P21,DX2,TT2,P12,P22,PR0,PR1,PR2)
      REAL      TT0,P10,P20,DX1,TT1,P11,P21,DX2,TT2,P12,P22,PR0,PR1,PR2
C
C Subroutine calculating, in 2-D rectangular grid, travel time of the
C wave propagating from the segment between 2 given gridpoints Y0,Y1 to
C the third given gridpoint Y2.  Diffracted waves from the gridpoints
C Y0,Y1 are also calculated at Y2 and the first arrival is considered.
C Travel time is between points y0 and y1 interpolated by means of the
C Aitken-Hermite polynomial interpolation of the third order.
C
C Input:
C     DX1,DX2... Grid steps in temporary Cartesian coordinates X1,X2
C             defined as follows:
C             (0,0)...   Point Y0
C             (DX1,0)... Point Y1
C             (0,DX2)... Point Y2
C     TT0,P10,P20... Travel time and slowness vector at point Y0.
C     TT1,P11,P21... Travel time and slowness vector at point Y1.
C                    TT1 may have the minus sign which is ignored.
C     TT2,P12,P22... Travel time and slowness vector at point Y2.
C     PR0,PR1,PR2... First slowness components at points Y0,Y1,2*Y1-Y0
C                    for Y0.GT.Y1, or Y1,Y0,2*Y0-Y1 for Y1.GT.Y0.
C                    The sign corresponds to the coordinate increasing
C                    from PR0 to PR2.
C
C Output:
C     TT2,P12,P22... Travel time and slowness vector at point Y2
C             calculated from points Y0,Y1, if it is less than input
C             value of TT2.  Otherwise unchanged input.
C
C No subroutines and external functions required.
C
C Date: 1996, December 22
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Common block /TTTPAR/ is required here:
      INCLUDE 'ttt.inc'
C
C-----------------------------------------------------------------------
C
      REAL ABSTT0,ABSTT1,U0,U1,U2,U,UG1,UG2,X1,TT,T1,T2,T11,T12,T22
      REAL P1,P2,A0,A1,A01,A001,A011,A0A1,AUX0,AUX1,AUX2,AUX3
      REAL P10P20,P11P21,X1C,X2C,X2CX2C,UG1X2C,UC,R10,R11
C
C     ABSTT0..ABS(TT0)
C     ABSTT1..ABS(TT1)
C     U0,U1,U2,U...Slownesses at points Y0,Y1,Y2,Y.
C     UG1,UG2... Slowness gradient.
C     X1...   X1 coordinate of point Y.
C     TT,T1,T2,T11,T12,T22... Travel time and its first and second
C             derivatives at point Y.
C     TT,P1,P2... Travel time and its first derivatives at point Y2.
C     A0,A1...Relative position of point Y with respect to points Y0,Y1.
C     A01,A001,A011,A0A1,AUX0,AUX1,AUX2,AUX3... Temporary storage
c             locations.
C
C.......................................................................
C
C     Travel times at points Y0,Y1:
      ABSTT0=ABS(TT0)
      ABSTT1=ABS(TT1)
C
C     Slownesses at points Y0,Y1,Y2:
      U0=SQRT(P10*P10+P20*P20)
      U1=SQRT(P11*P11+P21*P21)
      U2=SQRT(P12*P12+P22*P22)
C
C     Slowness gradient:
      UG1=(U1-U0)/DX1
      UG2=(U2-U0)/DX2
C
C     Diffraction at point Y0:
      AUX0=ABS(DX2)
      TT=ABSTT0+0.5*(U0+U2)*AUX0
      IF(TT.LT.TT2) THEN
        TT2=TT
C       AUX1= 0.
C       AUX2= DX2
C       AUX1=0.5*((U0+U2)*AUX1/AUX0+UG1*AUX0)
C       AUX2=0.5*((U0+U2)*AUX2/AUX0+UG2*AUX0)
C       AUX1=0.5*(                  UG1*AUX0)
C       AUX2=0.5*((U0+U2)* DX2/AUX0+UG2*AUX0)
        AUX0=AUX0*AUX0/(U0+U2)
        AUX1=     UG1*AUX0
        AUX2= DX2+UG2*AUX0
        AUX0=SQRT(AUX1*AUX1+AUX2*AUX2)
        P12=U2*AUX1/AUX0
        P22=U2*AUX2/AUX0
      END IF
C
C     Diffraction at point Y1:
      AUX0=SQRT(DX1*DX1+DX2*DX2)
      TT=ABSTT1+0.5*(U1+U2)*AUX0
      IF(TT.LT.TT2) THEN
        TT2=TT
        AUX1=-DX1
        AUX2= DX2
C       AUX1=0.5*((U1+U2)*AUX1/AUX0+UG1*AUX0)
C       AUX2=0.5*((U1+U2)*AUX2/AUX0+UG2*AUX0)
        AUX0=AUX0*AUX0/(U1+U2)
        AUX1=AUX1+UG1*AUX0
        AUX2=AUX2+UG2*AUX0
        AUX0=SQRT(AUX1*AUX1+AUX2*AUX2)
        P12=U2*AUX1/AUX0
        P22=U2*AUX2/AUX0
      END IF
C
C     Check for the vicinity of the point source:
      AUX1=0.20*(U0+U1)*ABS(DX1)
      IF(ABSTT0.LT.AUX1.OR.ABSTT1.LT.AUX1) THEN
C       Not updating inside very close vicinity of the point source
        RETURN
      END IF
C
C     Check for the travel-time ridge:
      AUX1=U1-U0
      AUX2=U2-U0
      IF(PR1-PR0.LT.
     *   RIDGE1*AMIN1(PR2-PR1,0.)-RIDGE2*SQRT(AUX1*AUX1+AUX2*AUX2)) THEN
        IF(P20/DX2.GT.0..AND.-P20/DX2.LE.P10/DX1.AND.
     *                                   P10/DX1.LE.0.) THEN
          T12= U*UG1         /P20
          T22=(U*UG2-P10*T12)/P20
          P1 =P10        +T12*DX2
          P2 =P20        +T22*DX2
          AUX0=SQRT(P1*P1+P2*P2)
          P1 =P1*U2/AUX0
          P2 =P2*U2/AUX0
          TT =ABSTT0+0.5* (P2+P20)*DX2
          IF(TT.LE.TT2) THEN
            TT2=TT
            P12=P1
            P22=P2
          END IF
        END IF
        IF(P21/DX2.GT.0..AND.-P21/DX2.LE.P11/DX1.AND.
     *                                   P11/DX1.LE.0.) THEN
          T12= U*UG1         /P21
          T22=(U*UG2-P11*T12)/P21
          P1 =P11        +T12*DX2
          P2 =P21-T12*DX1+T22*DX2
          AUX0=SQRT(P1*P1+P2*P2)
          P1 =P1*U2/AUX0
          P2 =P2*U2/AUX0
          TT =ABSTT1+0.5*((P2+P21)*DX2-(P1+P11)*DX1)
          IF(TT.LE.TT2) THEN
            TT2=TT
            P12=P1
            P22=P2
          END IF
        END IF
        RETURN
      END IF
C
C     Check for the direction of propagation (from Y0 and Y1 to Y2):
      IF(P20/DX2.LE..000001*U0/ABS(DX2).OR.
     *   P21/DX2.LE..000001*U1/ABS(DX2)) THEN
        RETURN
      END IF
C
C     Projecting points y0,y1 onto the parallel grid line through y2:
      P10P20=P10/P20
      P11P21=P11/P21
      A0=    DX2*P10P20
      A1=DX1+DX2*P11P21
C     Now:  A0,A1 are X1-coordinates of the projections of points Y0,Y1.
C
C     Check for the position of point Y2 between projections of Y0,Y1:
      IF(A0/DX1.GE.0..OR.A1/DX1.LE.0.) THEN
        RETURN
      END IF
C
C     Backprojecting point Y2 onto point Y at gridline through Y0,Y1:
      AUX0=A0-A1
      A0=A0/AUX0
      A1=A1/AUX0
      X1=A0*DX1
C     Now:  A0=(X1-X10)/(X11-X10),  A1=(X1-X11)/(X11-X10),  A0-A1=1,
C     where X1,X10,X11 are X1-coordinates of points Y,Y0,Y1.
C
C     Slowness at point Y:
C     U =A0*U1-A1*U0
      U =U0+UG1*X1
C
      IF(VER1*ABS(P10P20-P11P21).GE.1.) THEN
C
        X2C=DX1/(P10P20-P11P21)
        X1C=X2C*P10P20
C       Now:  X1C,X2C is the crosssection of two given slowness vectors.
C
C       Travel-time spherical correction
        UC=U0+UG1*X1C
        X2CX2C=X2C*X2C
        UG1X2C=UG1*X2CX2C
        AUX1=   -X1C
        AUX0=SQRT(AUX1*AUX1+X2CX2C)
        ABSTT0=ABSTT0-0.5*(AUX0*(U0+UC)-UG1X2C*ALOG(AUX0+AUX1))
        AUX1=DX1-X1C
        AUX0=SQRT(AUX1*AUX1+X2CX2C)
        ABSTT1=ABSTT1-0.5*(AUX0*(U1+UC)-UG1X2C*ALOG(AUX0+AUX1))
        AUX1= X1-X1C
        AUX0=SQRT(AUX1*AUX1+X2CX2C)
        TT    =       0.5*(AUX0*(U +UC)-UG1X2C*ALOG(AUX0+AUX1))
        T1    = U  *AUX1/AUX0
        T11   =(UG1*AUX1+U*X2CX2C/AUX0/AUX0)/AUX0
C
C       Travel-time cubic polynomial correction
        AUX0=ABSTT0-ABSTT1
        AUX1=6.*AUX0/DX1
        AUX2=1.-VER2
        TT =TT +AUX2*((A0+A0+1.)*A1*A1*AUX0 )+ABSTT1
        T1 =T1 +AUX2*(           A0*A1*AUX1 )
        T11=T11+AUX2*(          (A0+A1)*AUX1)/DX1
        TT =TT -VER2*A1*AUX0
        T1 =T1 -VER2*AUX1/6.
C
      ELSE
C
C       Interpolating travel-time and its derivatives at point Y by
C       means of the third-order interpolation from Y0,Y1:
        A01=A0+A1
        A001=A0+A01
        A011=A01+A1
        A0A1=A0*A1
        AUX0=ABSTT0-ABSTT1
        AUX1=6.*AUX0/DX1
        AUX3=VER2*((P10+P11)/2.+AUX1/6.)
        R10=     P10-AUX3
        R11=     P11-AUX3
        TT =(A0+A0+1.)*A1*A1*AUX0+ABSTT1+A0A1*(A1*R10+     A0*R11)*DX1
        T1 =           A0A1 *AUX1       + A001*A1*R10+A011*A0*R11
        T11=(          A01  *AUX1       +2.*(A011*R10+   A001*R11))/DX1
C
      END IF
C
C     Second-order Taylor expansion of travel time at point Y:
      T2=U*U-T1*T1
      IF(T2.LT.0.) THEN
        WRITE(*,'(1X,11F7.4)')
     *                       TT0,P10,P20,DX1,TT1,P11,P21,DX2,TT2,P12,P22
        WRITE(*,'(A)') ' TOO LARGE SLOWNESS COMPONENT'
        RETURN
      END IF
      T2=SIGN(SQRT(T2),DX2)
      T12=(U*UG1-T1*T11)/T2
      T22=(U*UG2-T1*T12)/T2
      P1 =T1-T11*X1+T12*DX2
      P2 =T2-T12*X1+T22*DX2
      AUX0=SQRT(P1*P1+P2*P2)
      P1=P1*U2/AUX0
      P2=P2*U2/AUX0
      TT =TT+0.5*((P2+T2)*DX2-(P1+T1)*X1)
      IF(TT.LE.TT2) THEN
        TT2=TT
        P12=P1
        P22=P2
      END IF
C
      RETURN
      END
C
C=======================================================================
C
C