subroutine qkund(trans,cod,al,rho,kx,eps0,coup)

      implicit none
      real*8 trans(4,5),cod(6),cod1(6),al,rho,eps0
      real*8 dp,kx,kap1,kap2,kap3,ai,bee,cee,dee
      real*8 kei1,kei2,kei3,rho1

      logical coup

c      write(*,*) cod(6)
      dp      = cod(6)
      rho1     = rho*(1+dp)      
c      write(*,*) rho,rho1

      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)

      trans(1,1)= cee
      trans(1,2)= ai
      trans(1,3)=-dee
      trans(1,4)= bee
      trans(1,5)= 0.d0
      trans(2,1)= kei3*ai
      trans(2,2)=-kei2*bee+cee
      trans(2,3)= kei3*bee
      trans(2,4)= kei2*ai-dee
      trans(2,5)= 0.d0
      trans(3,1)= dee
      trans(3,2)=-bee
      trans(3,3)= cee
      trans(3,4)= ai
      trans(3,5)= 0.d0
      trans(4,1)=-kei3*bee
      trans(4,2)=-kei2*ai+dee
      trans(4,3)= kei3*ai
      trans(4,4)=-kei2*bee+cee
      trans(4,5)= 0.d0
      
      coup=.true.
      return
      end