      SUBROUTINE COEF(STU,UC,ITRANS)
C
C  ROUTINE FOR THE COMPUTATION OF REFLECTION/TRANSMISSION COEFFICIENTS
C  FOR GENERAL ISOTROPIC/ANISOTROPIC MEDIA
C
C  INPUT PARAMETERS:
C  STU(1-3)... CARTESIAN COMPONENTS OF THE DISPLACEMENT VECTOR
C  STU(4-6)... CARTESIAN COMPONETS OF THE TRACTION VECTOR
C  ITRANS... ITRANS=O: REFLECTION
C            ITRANS=1: TRANSMISSION
C            ITRANS=999: SURFACE CONVERSION
C
C  OUTPUT PARAMETERS:
C  UC(1-3)...  RAY-CENTERED COMPONENTS OF THE DISPLACEMENT VECTOR
C
      COMPLEX A(6,6),C(6,6),COA(3,3),COC(3,3),AA(6),TAU(3),P(3),U(3),
     1CP1,CP2,CP3,DETA,DETC,UC(3),STU(6),cab
      DIMENSION Y(18),UN(3)
      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 /ZERO/ RNULL
C
      INDI=0
      IF(ITRANS.Eq.999) THEN
        ITRANS=0
        INDI=1
      END IF
      I1=1
      I2=3
      LAY1=IS(1,IREF)
      LAY=IS(7,IREF)
      DO 910 K=1,6
      IF(K.GT.3) GOTO 900
      UN(K)=DS(K,IREF)
  900 Y(K)=AY(K+1,N)
  910 CONTINUE
      IF(ICOEF.GT.0)
     1WRITE(LOUT,'(A,/,3(3F14.7,/),3I5)')'COEF: Y(1)-Y(6),UN,IREF,LAY,
     2ITYPE',(Y(K),K=1,6),UN,IREF,LAY,ITYPE
      CALL PARDIS (Y,0)
C
C  DISPLACEMENT AND STRESS VECTOR OF INCIDENT WAVE
C
      BSTU=SQRT(REAL(STU(1)*CONJG(STU(1))+STU(2)*CONJG(STU(2))
     1               +STU(3)*CONJG(STU(3))))
      do 950 k=1,3
      P(k)=PS(k,7,IREF)
      STU(k)=STU(k)/BSTU
      U(k)=STU(k)
  950 continue
      CALL STRESS (P,UN,U,TAU)
      do 960 k=1,3
      STU(k+3)=TAU(k)
  960 continue
      IF(ICOEF.GT.0)
     1WRITE(LOUT,'(A,/,6(2F14.7,/))') 'COEF: INCIDENT U,TAU',U,TAU
 1000 IF(IANI(LAY).EQ.0) GOTO 3000
C
C  COMPUTATION OF STRESS-DISPLACEMENT-VECTORS FOR GENERATED WAVES
C
C  ANISOTROPIC CASE
C
 1010 IF(I1.GT.3)CALL PARDIS(Y,0)
      DO 1020 K=I1,I2
      DO 1030 L=1,3
      P(L)=PS(L,K,IREF)
 1030 CONTINUE
C
C  EVALUATION OF DISPLACEMENT VECTOR (MAY BE COMPLEX)
C
      IF(I1.LE.3)MC=IS(5,IREF)
      IF(I1.GT.3)MC=IS(6,IREF)
      CALL DISPL(P,U,K)
      CALL STRESS(P,UN,U,TAU)
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,/,9(2F14.7,/))')'COEF: P,U,TAU'
     1,P,U,TAU
      DO 1060 L=1,3
      A(K,L)=U(L)
      A(K,L+3)=TAU(L)
 1060 CONTINUE
 1020 CONTINUE
      IF(INDI.EQ.1) GOTO 5000
      IF(I2.EQ.6) GOTO 4000
      I1=4
      I2=6
      LAY=IS(8,IREF)
      IF(LAY.EQ.0) GOTO 5000
      IF(IANI(LAY).NE.0) GOTO 1010
C
C  ISOTROPIC CASE
C
 3000 IF(I1.GT.3) CALL PARDIS(Y,0)
      IF(I1.LE.3) MC=IS(5,IREF)
      IF(I1.GT.3) MC=IS(6,IREF)
      DO 3010 L=1,3
      P(L)=PS(L,I1,IREF)
 3010 CONTINUE
      CP1=P(1)
      CP2=P(2)
      ivert=0
      if(cabs(cp1).lt..0000001.and.cabs(cp2).lt..0000001)ivert=1
      if(ivert.eq.1)then
        u(1)=1.
        u(2)=0.
        u(3)=0.
        go to 3020
      end if  
      cp3=-(CP1*CP1+CP2*CP2)
      CP1=cP1*p(3)
      CP2=cP2*p(3)
      cab=SQRT(REAL(cp1*CONJG(cp1)+cp2*CONJG(cp2)+cp3*CONJG(cp3)))
      U(1)=CP1/cab
      U(2)=CP2/cab
      U(3)=cp3/cab
 3020 continue
      CALL STRESS(P,UN,U,TAU)
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,/,9(2F14.7/))')'COEF: P,U,TAU'
     1,P,U,TAU
      DO 3030 L=1,3
      A(I1,L)=U(L)
      A(I1,L+3)=TAU(L)
 3030 CONTINUE
      if(ivert.eq.1)then
        u(1)=0.
        u(2)=1.
        if(real(p(3)).lt.0.)u(2)=-1.
        u(3)=0.
        go to 3040
      end if  
      CP1=-P(2)
      CP2=P(1)
      CP3=CMPLX(0.,0.)
      cab=SQRT(REAL(cp1*CONJG(cp1)+cp2*CONJG(cp2)+cp3*CONJG(cp3)))
      U(1)=CP1/cab
      U(2)=CP2/cab
      U(3)=cp3/cab
 3040 continue
      CALL STRESS (P,UN,U,TAU)
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,/,9(2F14.7/))')'COEF: P,U,TAU'
     1,P,U,TAU
      DO 3050 L=1,3
      A(I1+1,L)=U(L)
      A(I1+1,L+3)=TAU(L)
 3050 CONTINUE
      DO 3210 L=1,3
      P(L)=PS(L,I2,IREF)
 3210 CONTINUE
      CP1=P(1)
      CP2=P(2)
      CP3=P(3)
      cab=SQRT(REAL(cp1*CONJG(cp1)+cp2*CONJG(cp2)+cp3*CONJG(cp3)))
      U(1)=CP1/cab
      U(2)=CP2/cab
      U(3)=cp3/cab
      CALL STRESS (P,UN,U,TAU)
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,/,9(2F14.7/))')'COEF: P,U,TAU'
     1,P,U,TAU
      DO 3220 L=1,3
      A(I2,L)=U(L)
      A(I2,L+3)=TAU(L)
3220  CONTINUE
      IF(INDI.EQ.1) GOTO 5000
      IF(I2.EQ.6)GOTO 4000
      I1=4
      I2=6
      LAY=IS(8,IREF)
      IF(LAY.EQ.0) GOTO 5000
      GOTO 1000
C
C  REVERSE OF SIGNS FOR REFLECTIONS
C
 4000 DO 4010 L=1,3
      DO 4010 K=1,6
      A(L,K)=-A(L,K)
 4010 CONTINUE
      IF(ICOEF.EQ.0) GOTO 4012
      WRITE(LOUT,'(//,A)') 'COEF: MATRIX A'
      DO 4011 K=1,6
      WRITE(LOUT,'(6(12F10.5))') (A(L,K),L=1,6)
 4011 CONTINUE
C
C  SOLUTION OF SYSTEM OF LINAER EQUATIONS ( CRAMERS METHOD )
C
 4012 CALL DET6(A,DETA)
      do 4020 k=1,3
      UC(k)=CMPLX(0.,0.)
 4020 continue
      IF(CABS(DETA).LT.1.E-20) THEN
        WRITE(LOUT,'(A)')
     1  'COEF: MATRIX A IS SINGULAR, PROGRAM TERMINATES'
        RETURN
      END IF
      IF(IANI(LAY1).NE.0.OR.ITYPE.EQ.3)THEN
         L1=ITYPE
         IF(ITRANS.NE.0)L1=L1+3
         L2=L1
      END IF
      IF(IANI(LAY1).EQ.0.AND.ITYPE.NE.3)THEN
         L1=1
         IF(ITRANS.NE.0)L1=L1+3
         L2=L1+1
      END IF
      IF(ICOEF.NE.0) WRITE(LOUT,'(A,2I5)')'COEF: L1,L2',L1,L2
      DO 4044 L=L1,L2
      DO 4043 J=1,6
      DO 4042 K=1,6
      C(J,K)=A(J,K)
      IF(L.EQ.J)C(J,K)=STU(K)
 4042 CONTINUE
 4043 CONTINUE
      CALL DET6(C,DETC)
      AA(L)=DETC/DETA
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,2F12.6)') 'COEF: AA=',AA(L)
 4044 CONTINUE
      DO 4100 L=L1,L2
      LL=L
      IF(ITRANS.NE.0)LL=L-3
      UC(LL)=AA(L)*BSTU
 4100 CONTINUE
      RETURN
C
C  INTERACTION WITH THE FREE SURFACE 
C
 5000 DO 5010 L=1,3
      DO 5010 K=1,3
      COA(L,K)=-A(L,K+3)
 5010 CONTINUE
      IF(ICOEF.EQ.0)GO TO 5012
      WRITE(LOUT,'(//,A)')'COEF: MATRIX COA'
      WRITE(LOUT,'(3(6F10.5/))')((COA(L,K),L=1,3),K=1,3)
C
C  SOLUTION OF SYSTEM OF 3 LINEAR EQUATIONS (CRAMER'S METHOD)
C
 5012 CALL DET3(COA,DETA)
      IF(CABS(DETA).LT.1.-09)THEN
        WRITE(LOUT,'(A)')'COEF: MATRIX COA IS SINGULAR, 
     1  PROGRAM TERMINATES'
        STOP
      END IF
      DO 5044 L=1,3
      DO 5043 J=1,3
      DO 5042 K=1,3
      COC(J,K)=COA(J,K)
      IF(L.EQ.J)COC(J,K)=STU(K+3)
 5042 CONTINUE
 5043 CONTINUE
      CALL DET3(COC,DETC)
      AA(L)=DETC/DETA
      IF(ICOEF.GT.0)
     1WRITE(LOUT,'(A,2F12.6)')'COEF: AA=',AA(L)
 5044 CONTINUE
      if(indi.ne.1)GO TO 5200
C
C     CONVERSION AT THE FREE SURFACE
C
      do 5100 k=1,3
      U(k)=CMPLX(0.,0.)
      DO 5050 J=1,3
      U(k)=AA(J)*A(J,k)+U(k)
 5050 CONTINUE
      UC(k)=U(k)+STU(k)
 5100 continue
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,/,3(2F12.5/))') 'COEF: 
     1 NORMALIZED CONVERSION-VECTOR',UC
      do 5150 k=1,3
      UC(k)=UC(k)*BSTU
 5150 continue
      IF(ICOEF.GT.0)WRITE(LOUT,'(A,/,3(2F12.5/))') 'COEF: 
     1 CONVERSION-VECTOR',UC
      RETURN
C
C     REFLECTION FROM THE FREE SURFACE
C
 5200 L1=1
      IF(ITYPE.EQ.3)L1=3
      L2=2
      IF(ITYPE.EQ.3)L2=3
      do 5250 k=1,3
      UC(k)=CMPLX(0.,0.)
 5250 continue
      DO 5300 L=L1,L2
      UC(L)=AA(L)*BSTU
 5300 CONTINUE
      RETURN
      END