!
Subroutine Right_Part_Making
use Advertisement
implicit none
complex*16 i, ao, ae
complex*16 p, t
i=-4.d00*(0.d00, 1.d00)*pi
do n=1, n_max
 n_M(1,n)=i*cdexp((0.d00, 1.d00)*z0*nPole(n))
end do
n=m-4*(m/4)
if (n.eq.0) i=(1.d00, 0.d00)
if (n.eq.1) i=(0.d00, 1.d00)
if (n.eq.2) i=(-1.d00, 0.d00)
if (n.eq.3) i=(0.d00, -1.d00)
ao=(1.d00, 0.d00)*z0
Call Legendre(ao, p, t)
ao=i*m*p
ae=-i*t
if (m.eq.0) ae=-(0.d00, 1.d00)*t
do n=1, n_max
 a_e1(n)=ae*n_M(1, n)*et
 a_o1(n)=ao*n_M(1, n)*ef
 a_e2( n)=(0.d00, 1.d00)*ae*n_M(1, n)*et
 a_o2(n)=-(0.d00, 1.d00)*ao*n_M(1, n)*ef
end do
End Subroutine Right_Part_Making
!
Subroutine TE_TM_Right_Part_Making
use Advertisement
implicit none
complex*16 i, ao, ae
complex*16 p, t
i=-4.d00*pi*(0.d00, 1.d00)
do n=1, n_max
 n_M(1,n)=i*cdexp((0.d00, 1.d00)*z0*nPole(n))
end do
n=m-4*(m/4)
if (n.eq.0) i=(1.d00, 0.d00)
if (n.eq.1) i=(0.d00, 1.d00)
if (n.eq.2) i=(-1.d00, 0.d00)
if (n.eq.3) i=(0.d00, -1.d00)
ao=(1.d00, 0.d00)*z0
Call Legendre(ao, p, t)
ao=i*m*p
ae=-i*t
if (m.eq.0) ae=-(0.d00, 1.d00)*t
do n=1, n_max
 a_e1(n)=ae*n_M(1, n) !ef
 a_o1(n)=ao*n_M(1, n) !et
 a_e2(n)=(0.d00, 1.d00)*ae*n_M(1, n) !et
 a_o2(n)=-(0.d00, 1.d00)*ao*n_M(1, n) !ef
end do
End Subroutine TE_TM_Right_Part_Making
!
Subroutine RightPartsCheck
use Advertisement
implicit none
real*8 est, res(2)
external Ff, Low, Up
call Preparations
m=m_max
call Normalization(1)
call Right_Part_Making
do n=1, n_max
 do l=2, 3
  l_M(l, n)=n_M(l, n); l_N(l, n)=n_N(l, n)
 end do
end do
do odd=1, 2
 do n=1, n_max
  do l=1,2
   ox=-2.d00
   call  dtwodq (Ff, -1.d00, 1.d00, Low, Up, 0.d00, 0.5d-01, 6, res(l), est)
  end do
  print *, res(1), res(2)
  print *, l_M(1+odd, n)
 end do
end do
do odd=1, 2
 do n=n_max+1, 2*n_max
  do l=1,2
   ox=-2.d00
   call  dtwodq (Ff, -1.d00, 1.d00, Low, Up, 0.d00, 0.5d-01, 6, res(l), est)
  end do
  print *, res(1), res(2)
  print *, l_N(1+odd, n-n_max)
 end do
end do
End Subroutine RightPartsCheck
!
real*8 Function Low(x)
real*8, intent(in) :: x
Low=0.d00
End Function Low
!
real*8 Function Up(x)
use Advertisement
real*8, intent(in) :: x
Up=2.d00*pi
End Function Up
!
real*8 Function Ff(x, y)
use Advertisement
implicit none
real*8, intent(in) :: x, y
integer*4 s
real*8 kr, rnr, rnt
complex*16 v1(3), v2(3), v(3)
kr=rad/dsqrt(1.d00-exc*(x**2)) !
rnr=kr*kr
rnt=(kr**4)*x*dsqrt(1.d00-x*x)*exc/(rad**2) !
s=n; if (n.gt.n_max) s=n-n_max
if (x.ne.ox) &
 Call Components(kr, x, s, s, 3, nPole, n_M, n_N) !
ox=x
Call Term(y, n, pe, pm, odd) !
Call Plain_Wave(kr, x, y, v1, v2) !
v(1)=pm(2)*v1(3)-pm(3)*v1(2)
v(2)=-pm(1)*v1(3)+pm(3)*v1(1)
v(3)=pm(1)*v1(2)-pm(2)*v1(1)
v1=v
v(1)=pe(2)*v2(3)-pe(3)*v2(2)
v(2)=-pe(1)*v2(3)+pe(3)*v2(1)
v(3)=pe(1)*v2(2)-pe(2)*v2(1)
v2=v
v1=v1+(0.d00,1.d00)*v2
if (l.eq.1) ff=dreal(rnr*v1(1)+rnt*v1(2))
if (l.eq.2) ff=dimag(rnr*v1(1)+rnt*v1(2))
end Function Ff
!
Subroutine Term(fi, num, E, H, evenness)
use Advertisement
implicit none
real*8, intent(in) :: fi
integer*4, intent(in) :: num, evenness
complex*16, intent(out), dimension(1:3) :: E, H
real*8 c, s
if (evenness.eq.1) then
 c=dcos(m*fi); s=-dsin(m*fi)
else
 s=dcos(m*fi); c=dsin(m*fi)
end if
if (num.le.n_max) then
 E(1)=n_M(1, num)*s; H(1)=n_N(1, num)*c 
 E(2)=n_M(2, num)*s; H(2)=n_N(2, num)*c
 E(3)=n_M(3, num)*c; H(3)=n_N(3, num)*s
else
 H(1)=n_M(1, num-n_max)*s; E(1)=n_N(1, num-n_max)*c 
 H(2)=n_M(2, num-n_max)*s; E(2)=n_N(2, num-n_max)*c
 H(3)=n_M(3, num-n_max)*c; E(3)=n_N(3, num-n_max)*s
end if
End Subroutine Term
