SUBROUTINE FCT(X,Y,DERY) C C COMPUTATION OF THE RIGHT HAND SIDES OF THE RAY TRACING EQUATIONS C DIMENSION DERY(18),Y(18),AUX(2),AUXX(3,2),VX(3) DIMENSION G(3,3),GPP(3,3),GPX(3,3),GXX(3,3),GX(3),GP(3) DIMENSION GX1(3,3),GX2(3,3),GX3(3,3),GP1(3,3),GP2(3,3),GP3(3,3) 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/ E(21),EX(21),EY(21),EZ(21),EXX(21),EXY(21), 1 EXZ(21),EYY(21),EYZ(21),EZZ(21) COMMON /AUXI/ IANI(20),INTR,INT1,IOUT,KRE,IREFR,LAY,NDER,IPRINT, 1 MPRINT,NTR,ISQRT,NAUX,ISOUR,MAUX,MREG,MDIM,IPOL,MSCON,LOUT, 2 IAMP,MTRNS,ICOEF,IAD,IRHO,ISHEAR,IAC,IRT,mori INTEGER CODE COMMON /COD/ CODE(50,2),KREF,KC,ITYPE 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 /DJK/ D11,D12,D13,D22,D23,D33,DTR COMMON /DDJK/ DD11,DD12,DD13,DD22,DD23,DD33,DDTR C IF(IANI(LAY).NE.0) GOTO 20 CALL PARDIS(Y,0) IF(ITYPE.LT.3)ITT=16 IF(ITYPE.EQ.3)ITT=1 C C COMPUTATION OF RIGHT HAND SIDES OF RAY TRACING EQUATIONS C IN AN ISOTROPIC LAYER C C P-WAVE FOR ITT=1, S-WAVE FOR ITT=16 C V=E(ITT) VX(1)=EX(ITT) VX(2)=EY(ITT) VX(3)=EZ(ITT) DO 1 I=1,3 DERY(I)=V*Y(3+I) DERY(3+I)=-.5*VX(I)/V 1 CONTINUE IF(NDER.EQ.1)RETURN VXX=EXX(ITT) VXY=EXY(ITT) VXZ=EXZ(ITT) VYY=EYY(ITT) VYZ=EYZ(ITT) VZZ=EZZ(ITT) DO 3 J=1,2 AUX(J)=0. DO 2 I=1,3 II=3+I+3*J AUX(J)=AUX(J)+VX(I)*Y(II) 2 CONTINUE JJ=4+3*J AUXX(1,J)=VXX*Y(JJ)+VXY*Y(JJ+1)+VXZ*Y(JJ+2) AUXX(2,J)=VXY*Y(JJ)+VYY*Y(JJ+1)+VYZ*Y(JJ+2) AUXX(3,J)=VXZ*Y(JJ)+VYZ*Y(JJ+1)+VZZ*Y(JJ+2) 3 CONTINUE DO 4 I=1,3 DERY(I+6)=AUX(1)*Y(I+3)+V*Y(I+12) DERY(I+9)=AUX(2)*Y(I+3)+V*Y(I+15) DERY(I+12)=.5*(VX(I)*AUX(1)-V*AUXX(I,1))/V/V DERY(I+15)=.5*(VX(I)*AUX(2)-V*AUXX(I,2))/V/V 4 CONTINUE RETURN C C C COMPUTATION OF RIGHT HAND SIDES OF RAY TRACING EQUATIONS C IN AN ANISOTROPIC LAYER C C DETERMINATION OF PARAMETERS OF THE MEDIUM C 20 CALL PARDIS(Y,0) CALL CHRM2(Y,G,1) CALL DMAT(Y) if(ind.eq.10)return CALL PCHRM(Y,GP1,1,1) CALL PCHRM(Y,GP2,2,1) CALL PCHRM(Y,GP3,3,1) CALL CHRM2(Y,GX1,2) CALL CHRM2(Y,GX2,3) CALL CHRM2(Y,GX3,4) GP(1)=TR(GP1)/DTR GP(2)=TR(GP2)/DTR GP(3)=TR(GP3)/DTR GX(1)=TR(GX1)/DTR GX(2)=TR(GX2)/DTR GX(3)=TR(GX3)/DTR DO 5 I=1,3 DERY(I)=.5*GP(I) DERY(I+3)=-.5*GX(I) 5 CONTINUE IF(NDER.EQ.1)RETURN CALL CHRM2(Y,G,1) CALL DDMAT(GP1) GPP(1,1)=TRD(GP1)-GP(1)*DDTR GPP(1,2)=TRD(GP2)-GP(2)*DDTR GPP(1,3)=TRD(GP3)-GP(3)*DDTR GPX(1,1)=TRD(GX1)-GX(1)*DDTR GPX(1,2)=TRD(GX2)-GX(2)*DDTR GPX(1,3)=TRD(GX3)-GX(3)*DDTR CALL DDMAT(GP2) GPP(2,1)=TRD(GP1)-GP(1)*DDTR GPP(2,2)=TRD(GP2)-GP(2)*DDTR GPP(2,3)=TRD(GP3)-GP(3)*DDTR GPX(2,1)=TRD(GX1)-GX(1)*DDTR GPX(2,2)=TRD(GX2)-GX(2)*DDTR GPX(2,3)=TRD(GX3)-GX(3)*DDTR CALL DDMAT(GP3) GPP(3,1)=TRD(GP1)-GP(1)*DDTR GPP(3,2)=TRD(GP2)-GP(2)*DDTR GPP(3,3)=TRD(GP3)-GP(3)*DDTR GPX(3,1)=TRD(GX1)-GX(1)*DDTR GPX(3,2)=TRD(GX2)-GX(2)*DDTR GPX(3,3)=TRD(GX3)-GX(3)*DDTR CALL DDMAT(GX1) GXX(1,1)=TRD(GX1)-GX(1)*DDTR GXX(1,2)=TRD(GX2)-GX(2)*DDTR GXX(1,3)=TRD(GX3)-GX(3)*DDTR CALL DDMAT(GX2) GXX(2,1)=TRD(GX1)-GX(1)*DDTR GXX(2,2)=TRD(GX2)-GX(2)*DDTR GXX(2,3)=TRD(GX3)-GX(3)*DDTR CALL DDMAT(GX3) GXX(3,1)=TRD(GX1)-GX(1)*DDTR GXX(3,2)=TRD(GX2)-GX(2)*DDTR GXX(3,3)=TRD(GX3)-GX(3)*DDTR C DO 11 L=1,3 DO 11 M=L,3 CALL PPCHRM(G,L,M,1) AUX1=TR(G) GPP(L,M)=(GPP(L,M)+AUX1)/DTR IF(L.NE.M)GPP(M,L)=(GPP(M,L)+AUX1)/DTR 11 CONTINUE DO 12 L=1,3 CALL PCHRM(Y,G,L,2) GPX(L,1)=(GPX(L,1)+TR(G))/DTR CALL PCHRM(Y,G,L,3) GPX(L,2)=(GPX(L,2)+TR(G))/DTR CALL PCHRM(Y,G,L,4) GPX(L,3)=(GPX(L,3)+TR(G))/DTR 12 CONTINUE CALL CHRM2(Y,G,5) GXX(1,1)=(GXX(1,1)+TR(G))/DTR CALL CHRM2(Y,G,8) GXX(2,2)=(GXX(2,2)+TR(G))/DTR CALL CHRM2(Y,G,10) GXX(3,3)=(GXX(3,3)+TR(G))/DTR CALL CHRM2(Y,G,6) AUX1=(GXX(1,2)+TR(G))/DTR GXX(1,2)=AUX1 GXX(2,1)=AUX1 CALL CHRM2(Y,G,7) AUX1=(GXX(1,3)+TR(G))/DTR GXX(1,3)=AUX1 GXX(3,1)=AUX1 CALL CHRM2(Y,G,9) AUX1=(GXX(2,3)+TR(G))/DTR GXX(2,3)=AUX1 GXX(3,2)=AUX1 CALL CHRM2(Y,G,1) C DO 13 I=1,3 DERY(I+6)=0. DERY(I+9)=0. DERY(I+12)=0. DERY(I+15)=0. DO 13 K=1,3 DERY(I+6)=DERY(I+6)+.5*(GPX(I,K)*Y(K+6)+GPP(I,K)*Y(K+12)) DERY(I+9)=DERY(I+9)+.5*(GPX(I,K)*Y(K+9)+GPP(I,K)*Y(K+15)) DERY(I+12)=DERY(I+12)-.5*(GXX(I,K)*Y(K+6)+GPX(K,I)*Y(K+12)) DERY(I+15)=DERY(I+15)-.5*(GXX(I,K)*Y(K+9)+GPX(K,I)*Y(K+15)) 13 CONTINUE RETURN END