!
Subroutine Route_with_Field_at_a_Reference_Point
use Advertisement
implicit none
real*8 fl, fl_, add
complex*16 field(3), in_huygens(3), ad(3)
call Preparations
allocate(node(1:node_max), weight(1:node_max))
allocate(nPole(1:n_max), lPole(1:l_max))
allocate(a_e1(1:n_max), a_e2(1:n_max), a_o1(1:n_max), a_o2(1:n_max))
allocate(a_p1(1:n_max), a_p2(1:n_max), a_m1(1:n_max), a_m2(1:n_max))
allocate(c_e1(1:l_max), c_e2(1:l_max), c_o1(1:l_max), c_o2(1:l_max))
allocate(c_p1(1:l_max), c_p2(1:l_max), c_m1(1:l_max), c_m2(1:l_max))
n=n_max+terms-1
allocate(b_e1(1:n), b_e2(1:n), b_o1(1:n), b_o2(1:n))
allocate(d_e1(1:n), d_e2(1:n), d_o1(1:n), d_o2(1:n)) 
allocate(b_p1(1:n), b_p2(1:n), b_m1(1:n), b_m2(1:n))
allocate(d_p1(1:n), d_p2(1:n), d_m1(1:n), d_m2(1:n))
allocate(n_M(1:3,1:n), n_N(1:3,1:n), l_M(1:3,1:l_max), l_N(1:3,1:l_max))
call Line_Lattice(1.0d00)
call Nodes
exc=1.d00-exc*exc
fl_=-1.d00
in_huygens=(0.d00, 0.d00)
field=(0.d00, 0.d00)
teQexc=0.d00; teQscat=0.d00; tmQexc=0.d00; tmQscat=0.d00;
m=0 !
do
  m_min=m; if (m.eq.0) m_min=1
  allocate(MATRIX(1:2*n_max, 1:2*l_max))
  allocate(nu(0:m_min+terms-1))
  call Normalization(m_min+terms-1)
  call Matrix_Making(n_max, 1)
  call TE_TM_Right_Part_Making
  call Coefficients_Conversion_to_M_M(1, n_max, 1)
  call Matrix_Conversion_to_M_M(1, n_max, 1, l_max)
!  call GEN_Solver_MM
  call GEN_Inversion_MM !
  call Coefficients_Conversion_to_eo(1, l_max, 3)
  call Components(pr, pz, 1, l_max, 1, lPole, n_M, n_N)
  call TE_TM(pf, 1, l_max, c_e1, c_e2, c_o1, c_o2, pe, pm)
  ad=et*pe+ef*pm
  field=ad+field
  fl=(cdabs(field(1))**2+cdabs(field(2))**2+cdabs(field(3))**2)
  add=(cdabs(ad(1))**2+cdabs(ad(2))**2+cdabs(ad(3))**2)
  write(*,*) 'm=', m,  fl, add
  l=m_min+terms-1 !
  allocate(M11(m_min:l,1:l_max), M12(m_min:l,1:l_max), &
               M21(m_min:l,1:l_max), M22(m_min:l,1:l_max))
  call InnerHuygens(m_min+terms-1, pr, pz, pf, 3, in_huygens)
  call TE_TM_Sections(m_min+terms-1)
  deallocate(MATRIX, M11, M12, M21, M22, nu)
  if (m.eq.n_max) write (*,*) 'm=n_max restriction achieved'
  if (dabs(fl-fl_)/fl.lt.tolerance.or.m.eq.n_max) Exit 
  fl_=fl
  m=m+1
end do
deallocate( n_M, n_N, l_M, l_N)
deallocate(node, weight, nPole, lPole)
deallocate(a_e1, a_e2, a_o1, a_o2, a_p1, a_p2, a_m1, a_m2)
deallocate(c_e1, c_e2, c_o1, c_o2, c_p1, c_p2, c_m1, c_m2)
deallocate(b_e1, b_e2, b_o1, b_o2, d_e1, d_e2, d_o1, d_o2)
deallocate(b_p1, b_p2, b_m1, b_m2, d_p1, d_p2, d_m1, d_m2)
call Plain_Wave(pr, pz, pf, pe, pm)
pm=in_huygens+pe
write(*,*) '************************'
print *, 'reslength=', &
          dsqrt((cdabs(pm(1))**2+ cdabs(pm(2))**2+cdabs(pm(3))**2)/&
          (cdabs(pe(1))**2+ cdabs(pe(2))**2+cdabs(pe(3))**2))
print *, 'teQexc=', teQexc
print *, 'tmQexc=', tmQexc
print *, 'teQscat=', teQscat
print *, 'tmQscat=', tmQscat
m_max=m
l=(m_max+1)*terms
allocate(M11(1:l,1:n_max), M12(1:l,1:n_max), M21(1:l,1:n_max), M22(1:l,1:n_max))
call T_Matrix_DownLoad
deallocate(M11, M12, M21, M22)
End Subroutine Route_with_Field_at_a_Reference_Point
!
