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