      subroutine tkunde(trans,cod,beam,al,rho,kx,eps0)

      implicit none
      real*8 trans(6,12),cod(6),beam(21),trans1(6,6)
      real*8 al,rho,rho1,eps0
      real*8 dp,kx,kap1,kap2,kap3,ai,bee,cee,dee
      real*8 kei1,kei2,kei3
      real*8 cod1(6)
      real*8 v1,v2,v3,v4,v5,v6
      integer*4 i

      call tinitr(trans1)

      dp      = cod(6)
      rho1     = rho*(1+dp)

      kei1 = sqrt(1.d0/(rho1**4*kx**2)+2.d0/(rho1**2))
      kei2 = 1.d0/(rho1**2*kx)
      kei3 = -1.d0/(2.d0*rho1**2)

      kap1 =  (kei1-kei2)/2.d0
      kap2 = -(kei1+kei2)/2.d0
      kap3 = kap1-kap2

      ai  = (sin(kap1*al)-sin(kap2*al))/kap3
      bee = (cos(kap1*al)-cos(kap2*al))/kap3
      cee = (kap1*cos(kap2*al)-kap2*cos(kap1*al))/kap3
      dee = (kap1*sin(kap2*al)-kap2*sin(kap1*al))/kap3

      cod1(1) = cod(1)
      cod1(2) = cod(2)
      cod1(3) = cod(3)
      cod1(4) = cod(4)

      cod1(1)=cee*cod(1)+ai*cod(2)-dee*cod(3)+bee*cod(4)
      cod1(2)=kei3*ai*cod(1)+(-kei2*bee+cee)*cod(2)
     $           +kei3*bee*cod(3)+(kei2*ai-dee)*cod(4)
      cod1(3)=dee*cod(1)-bee*cod(2)+cee*cod(3)+ai*cod(4)
      cod1(4)=-kei3*bee*cod(1)+(-kei2*ai+dee)*cod(2)
     $           +kei3*ai*cod(3)+(-kei2*bee+cee)*cod(4)

      cod(1) = cod1(1)
      cod(2) = cod1(2)
      cod(3) = cod1(3)
      cod(4) = cod1(4)

      trans1(1,1)= cee
      trans1(1,2)= ai
      trans1(1,3)=-dee
      trans1(1,4)= bee
      trans1(1,5)= 0.d0
      trans1(2,1)= kei3*ai
      trans1(2,2)=-kei2*bee+cee
      trans1(2,3)= kei3*bee
      trans1(2,4)= kei2*ai-dee
      trans1(2,5)= 0.d0
      trans1(3,1)= dee
      trans1(3,2)=-bee
      trans1(3,3)= cee
      trans1(3,4)= ai
      trans1(3,5)= 0.d0
      trans1(4,1)=-kei3*bee
      trans1(4,2)=-kei2*ai+dee
      trans1(4,3)= kei3*ai
      trans1(4,4)=-kei2*bee+cee
      trans1(4,5)= 0.d0
      trans1(5,6)= 0.d0

        write(*,*) trans1(1,1),trans1(1,2),trans1(1,3),trans1(1,4),
     $             trans1(1,5),trans1(1,6)
        write(*,*) trans1(2,1),trans1(2,2),trans1(2,3),trans1(2,4),
     $             trans1(2,5),trans1(2,6)
        write(*,*) trans1(3,1),trans1(3,2),trans1(3,3),trans1(3,4),
     $             trans1(3,5),trans1(3,6)
        write(*,*) trans1(4,1),trans1(4,2),trans1(4,3),trans1(4,4),
     $             trans1(4,5),trans1(4,6)
        write(*,*) trans1(5,1),trans1(5,2),trans1(5,3),trans1(5,4),
     $             trans1(5,5),trans1(5,6)
        write(*,*) trans1(6,1),trans1(6,2),trans1(6,3),trans1(6,4),
     $             trans1(6,5),trans1(6,6)

      do 10 i=1,6
        v1=trans(1,i)
        v2=trans(2,i)
        v3=trans(3,i)
        v4=trans(4,i)
        v5=trans(5,i)
        v6=trans(6,i)
        trans(1,i)=trans1(1,1)*v1+trans1(1,2)*v2+trans1(1,3)*v3
     1            +trans1(1,4)*v4+trans1(1,5)*v5+trans1(1,6)*v6
        trans(2,i)=trans1(2,1)*v1+trans1(2,2)*v2+trans1(2,3)*v3
     1            +trans1(2,4)*v4+trans1(2,5)*v5+trans1(2,6)*v6
        trans(3,i)=trans1(3,1)*v1+trans1(3,2)*v2+trans1(3,3)*v3
     1            +trans1(3,4)*v4+trans1(3,5)*v5+trans1(3,6)*v6
        trans(4,i)=trans1(4,1)*v1+trans1(4,2)*v2+trans1(4,3)*v3
     1            +trans1(4,4)*v4+trans1(4,5)*v5+trans1(4,6)*v6
        trans(5,i)=trans1(5,1)*v1+trans1(5,2)*v2+trans1(5,3)*v3
     1            +trans1(5,4)*v4+trans1(5,5)*v5+trans1(5,6)*v6
        trans(6,i)=trans1(6,1)*v1+trans1(6,2)*v2+trans1(6,3)*v3
     1            +trans1(6,4)*v4+trans1(6,5)*v5+trans1(6,6)*v6
 10         continue

      call tmulbs(beam ,trans1,.false.)

      return
      end
