      SUBROUTINE PARDIS(Y,IAY)
      DIMENSION Y(3),DEP(6),B(21),E(21),EX(21),EY(21),EZ(21),EXX(21),
     1          EYY(21),EZZ(21),EXY(21),EXZ(21),EYZ(21)
      COMMON /APROX/ A11,A12,A13,A14,A15,A16,A22,A23,A24,A25,A26,A33,
     1               A34,A35,A36,A44,A45,A46,A55,A56,A66,
     1               DXA11,DXA12,DXA13,DXA14,DXA15,DXA16,DXA22,DXA23,
     1               DXA24,DXA25,DXA26,DXA33,DXA34,DXA35,DXA36,DXA44,
     1               DXA45,DXA46,DXA55,DXA56,DXA66,
     1               DYA11,DYA12,DYA13,DYA14,DYA15,DYA16,DYA22,DYA23,
     1               DYA24,DYA25,DYA26,DYA33,DYA34,DYA35,DYA36,DYA44,
     1               DYA45,DYA46,DYA55,DYA56,DYA66,
     1               DZA11,DZA12,DZA13,DZA14,DZA15,DZA16,DZA22,DZA23,
     1               DZA24,DZA25,DZA26,DZA33,DZA34,DZA35,DZA36,DZA44,
     1               DZA45,DZA46,DZA55,DZA56,DZA66,
     1               A2546,A1266,A1355,A1456,A3645,A2344
      COMMON /APROX1/ D(21),DX(21),DY(21),DZ(21),DXX(21),
     1          DXY(21),DXZ(21),DYY(21),DYZ(21),DZZ(21)
      COMMON /AUXI/  IANI(20),INTR,INT1,IOUT,KRE,IREFR,LAY,NDER,IPRINT,
     1 MPRINT,NTR,ISQRT,NAUX,ISOUR,MAUX,MREG,MDIM,IPOL,MSCON,LOU,
     2 IAMP,MTRNS,ICOEF,IAD,IRHO,ISHEAR,IAC,IRT,mori
      INTEGER CODE
      COMMON /COD/  CODE(50,2),KREF,KC,ITYPE
      COMMON /EPAR/  E66U(6,6,20),E66L(6,6,20)
      COMPLEX PS
      COMMON /RAY/   AY(28,400),DS(20,20),KINT(20),HHH(3,3),tmax,
     1               PS(3,7,20),IS(8,20),DINC,DTOLD,N,IREF,IND,IND1
      COMMON /RAY2/  DRY(3,400)
C
      EQUIVALENCE(E(1),A11),(E(2),A12),(E(3),A13),(E(4),A14),(E(5),A15)
     1           ,(E(6),A16),(E(7),A22),(E(8),A23),(E(9),A24)
     2     ,(E(10),A25),(E(11),A26),(E(12),A33),(E(13),A34),(E(14),A35)
     2     ,(E(15),A36),(E(16),A44),(E(17),A45),(E(18),A46),(E(19),A55)
     2     ,(E(20),A56),(E(21),A66)
     1          ,(EX(1),DXA11),(EX(2),DXA12),(EX(3),DXA13),(EX(4),DXA14)
     1          ,(EX(5),DXA15),(EX(6),DXA16),(EX(7),DXA22),(EX(8),DXA23)
     1       ,(EX(9),DXA24),(EX(10),DXA25),(EX(11),DXA26),(EX(12),DXA33)
     1      ,(EX(13),DXA34),(EX(14),DXA35),(EX(15),DXA36),(EX(16),DXA44)
     1      ,(EX(17),DXA45),(EX(18),DXA46),(EX(19),DXA55),(EX(20),DXA56)
     1      ,(EX(21),DXA66)
      EQUIVALENCE
     1           (EY(1),DYA11),(EY(2),DYA12),(EY(3),DYA13),(EY(4),DYA14)
     1          ,(EY(5),DYA15),(EY(6),DYA16),(EY(7),DYA22),(EY(8),DYA23)
     1       ,(EY(9),DYA24),(EY(10),DYA25),(EY(11),DYA26),(EY(12),DYA33)
     1      ,(EY(13),DYA34),(EY(14),DYA35),(EY(15),DYA36),(EY(16),DYA44)
     1      ,(EY(17),DYA45),(EY(18),DYA46),(EY(19),DYA55),(EY(20),DYA56)
     1      ,(EY(21),DYA66)
     1          ,(EZ(1),DZA11),(EZ(2),DZA12),(EZ(3),DZA13),(EZ(4),DZA14)
     1          ,(EZ(5),DZA15),(EZ(6),DZA16),(EZ(7),DZA22),(EZ(8),DZA23)
     1       ,(EZ(9),DZA24),(EZ(10),DZA25),(EZ(11),DZA26),(EZ(12),DZA33)
     1      ,(EZ(13),DZA34),(EZ(14),DZA35),(EZ(15),DZA36),(EZ(16),DZA44)
     1      ,(EZ(17),DZA45),(EZ(18),DZA46),(EZ(19),DZA55),(EZ(20),DZA56)
     1      ,(EZ(21),DZA66)
C
      INTR1=INTR
      INTR=LAY
      CALL DISC(Y,DEP)
      Z1=DEP(1)
      DZX1=DEP(2)
      DZY1=DEP(3)
      IF(NDER.LE.1) GOTO 10
      DZXX1=DEP(4)
      DZXY1=DEP(5)
      DZYY1=DEP(6)
  10  INTR=LAY+1
      CALL DISC(Y,DEP)
      INTR=INTR1
      Z2=DEP(1)
      DZX2=DEP(2)
      DZY2=DEP(3)
      IF(NDER.LE.1) GOTO 20
      DZXX2=DEP(4)
      DZXY2=DEP(5)
      DZYY2=DEP(6)
  20  AUX1=Z2-Z1
      IF(AUX1.LE.0) THEN
      IND=20
      WRITE(LOU,'(A,5F12.6,2I5)')' Z1,Z2,X,Y,Z,LAY,IND',Z1,Z2,Y(1),
     1Y(2),Y(3),LAY,ind
      RETURN
      END IF
C
C  THE NEIGHBOURHOOD INTERFACES INTERSECT EACH OTHER
C
      AUX2=Y(3)-Z1
      AUX3=Y(3)-Z2
      AUX4X=DZX2-DZX1
      AUX4Y=DZY2-DZY1
      AU2=1./AUX1/AUX1
      AU3=AU2/AUX1
      AU3X=DZX1*AUX3
      AU3Y=DZY1*AUX3
      AU4X=DZX2*AUX2
      AU4Y=DZY2*AUX2
      AU5X=AU4X-AU3X
      AU5Y=AU4Y-AU3Y
      A1=AUX2/AUX1
      A2=-AU2*AU5X
      A3=-AU2*AU5Y
      A4=1./AUX1
      IF(NDER.EQ.1) GOTO 30
      A5=AU3*(2.*AUX4X*AU5X+AUX1*(DZXX1*AUX3-DZXX2*AUX2))
      A6=AU3*(2.*AUX4Y*AU5X+AUX1*(DZXY1*AUX3-DZXY2*AUX2+DZX2*DZY1-
     1DZX1*DZY2))
      A7=-AU2*AUX4X
      A8=AU3*(2.*AUX4Y*AU5Y+AUX1*(DZYY1*AUX3-DZYY2*AUX2))
      A9=-AU2*AUX4Y
  30  JJ=21
      JJJ=1
      IF(ISQRT.NE.0.and.iani(lay).eq.0) GOTO 37
C
C  INTERPOLATION OF ELASTIC PARAMETERS DIVIDED BY DENSITY
C  (CORRESPONDS TO THE INTERPOLATION IN SQUARES OF VELOCITY)
C
      IF(IANI(LAY).EQ.0) GOTO 33
      J1=0
      DO 31 L=1,6
      DO 32 J=L,6
      K1=J-L+1+J1
      E(K1)=E66U(J,L,LAY)
      B(K1)=E66L(J,L,LAY)-E(K1)
  32  CONTINUE
      J1=K1
  31  CONTINUE
      GOTO 52
  33  E(1)=E66U(1,1,LAY)
      B(1)=E66L(1,1,LAY)-E(1)
      E(16)=E66U(4,4,LAY)
      B(16)=E66L(4,4,LAY)-E(16)
      JJ=16
      JJJ=15
      GOTO 52
C
C  INTERPOLATION OF SQUARE ROOTS OF ELASTIC PARAMETERS
C  (CORRESPONDS TO THE INTERPOLATION OF VELOCITIES)
C  IT WORKS ONLY IN ISOTRPIC LAYERS
C
  37  E(1)=SQRT(E66U(1,1,LAY))
      B(1)=SQRT(E66L(1,1,LAY))-E(1)
      E(16)=SQRT(E66U(4,4,LAY))
      B(16)=SQRT(E66L(4,4,LAY))-E(16)
      JJ=16
      JJJ=15
C
C  ELASTIC PARAMETERS AND THEIR DERIVATIVES OBTAINED BY
C  INTERPOLATION IN VELOCITIES. ELASTIC PARAMETERS
C  ARE OBTAINED AS SQUARES OF INTERPOLATED QUANTITIES
C
   40 DO 50 J=1,JJ,JJJ
      BB=B(J)
C
C  ELASTIC PARAMETERS
C
      E(J)=E(J)+A1*BB
      EE=2.*E(J)
      E(J)=E(J)*E(J)
C
C  FIRST DERIVATIVES OF ELASTIC PARAMETERS
C
      EX(J)=A2*BB
      EEX=EX(J)
      EX(J)=EX(J)*EE
      EY(J)=A3*BB
      EEY=EY(J)
      EY(J)=EY(J)*EE
      EZ(J)=A4*BB
      EEZ=EZ(J)
      EZ(J)=EZ(J)*EE
      D(J)=E(J)
      DX(J)=EX(J)
      DY(J)=EY(J)
      DZ(J)=EZ(J)
      IF(NDER.LE.1) GOTO 50
C
C  SECOND DERIVATIVES OF ELASTIC PARAMETERS
C
      EXX(J)=A5*BB*EE+2.*EEX*EEX
      EXY(J)=A6*BB*EE+2.*EEX*EEY
      EXZ(J)=A7*BB*EE+2.*EEX*EEZ
      EYY(J)=A8*BB*EE+2.*EEY*EEY
      EYZ(J)=A9*BB*EE+2.*EEY*EEZ
      EZZ(J)=2.*EEZ*EEZ
      DXX(J)=EXX(J)
      DXY(J)=EXY(J)
      DXZ(J)=EXZ(J)
      DYY(J)=EYY(J)
      DYZ(J)=EYZ(J)
      DZZ(J)=EZZ(J)
  50  CONTINUE
      GOTO 59
C
C  ELASTIC PARAMETERS AND THEIR DERIVATIVES OBTAINED BY
C  INTERPOLATION IN VALUES OF ELASTIC PARAMETERS
C
  52  DO 55 J=1,JJ,JJJ
      BB=B(J)
C
C  ELASTIC PARAMETERS
C
      E(J)=E(J)+A1*BB
C
C  FIRST DERIVATIVES OF ELASTIC PARAMETERS
C
      EX(J)=A2*BB
      EY(J)=A3*BB
      EZ(J)=A4*BB
      D(J)=E(J)
      DX(J)=EX(J)
      DY(J)=EY(J)
      DZ(J)=EZ(J)
      IF(NDER.LE.1) GOTO 55
C
C  SECOND DERIVATIVES OF ELASTIC PARAMETERS
C
      EXX(J)=A5*BB
      EXY(J)=A6*BB
      EXZ(J)=A7*BB
      EYY(J)=A8*BB
      EYZ(J)=A9*BB
      EZZ(J)=0.
      DXX(J)=EXX(J)
      DXY(J)=EXY(J)
      DXZ(J)=EXZ(J)
      DYY(J)=EYY(J)
      DYZ(J)=EYZ(J)
      DZZ(J)=EZZ(J)
  55  CONTINUE
C
  59  IF(IANI(LAY).EQ.0) GOTO 90
      A2546=A25+A46
      A1266=A12+A66
      A1355=A13+A55
      A1456=A14+A56
      A3645=A36+A45
      A2344=A23+A44
      IF(IAY.EQ.0)RETURN
      DO 60 I=1,21,JJJ
  60  AY(I+7,N)=E(I)
      return
  90  if(iay.eq.0)return
      V=SQRT(A11)
      v2=2.*v
      ay(8,n)=v
      AY(9,N)=DXA11/V2
      AY(10,N)=DYA11/V2
      AY(11,N)=DZA11/V2
      V=SQRT(A44)
      v2=2.*v
      ay(12,n)=v
      AY(13,N)=DXA44/V2
      AY(14,N)=DYA44/V2
      AY(15,N)=DZA44/V2
      RETURN
      END
