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