!
Subroutine Matrix_Making(nmx ,key)
use Advertisement
implicit none
integer*4, intent(in) :: nmx, key
integer*4 i, ii, nn, ll, n_min
complex*16 mi, mj, mk, ml
real*8 rnr, rnt, r, z, w(4)
MATRIX=(0.d00,0.d00)
if (exc.lt.0.d00) then
 w(1)=-1.d00; w(2)=-width
 w(3)=width;  w(4)=1.d00
else
 w(1)=-1.d00;      w(2)=-1.d00+width
 w(3)=1.d00-width; w(4)=1.d00
end if
DO ii=1, 3 
DO i=1, node_max
 z=(w(ii+1)-w(ii))*node(i)/2.d00+(w(ii)+w(ii+1))/2.d00
 call Radius(z, r)
 call Normal(z, r, rnr, rnt)
 if (key.eq.1) Call Components(r, z, 1, nmx, 3, nPole, n_M, n_N)
 if (key.eq.2) Call oComponents(r, z, m_min, nmx, 1, n_M, n_N)
 if (key.eq.3) Call oComponents(r, z, m_min, nmx, 3, n_M, n_N)
 Call Components(r, z, 1, l_max, 1, lPole, l_M, l_N)
 n_min=m_min; if (key.eq.1) n_min=1
 Do n=n_min, nmx
  nn=n+nmx
  do l=1, l_max
   ll=l+l_max
   if (m.ne.0) then 
    Matrix(n, ll)=Matrix(n, ll)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(-n_M(2,n)*l_M(3,l)-n_M(3,n)*l_M(2,l))+ &
	 rnt*(n_M(1,n)*l_M(3,l)+n_M(3,n)*l_M(1,l)))
    Matrix(nn, l)=Matrix(nn, l)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(n_N(2,n)*l_N(3,l)+n_N(3,n)*l_N(2,l))+ &
	 rnt*(-n_N(1,n)*l_N(3,l)-n_N(3,n)*l_N(1,l)))
   end if
   Matrix(n, l)=Matrix(n, l)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(n_M(2,n)*l_N(3,l)-n_M(3,n)*l_N(2,l))+ &
	 rnt*(-n_M(1,n)*l_N(3,l)+n_M(3,n)*l_N(1,l)))
   Matrix(nn, ll)=Matrix(nn, ll)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(n_N(2,n)*l_M(3,l)-n_N(3,n)*l_M(2,l))+ &
	 rnt*(-n_N(1,n)*l_M(3,l)+n_N(3,n)*l_M(1,l)))
  end do
 End Do
END DO
END DO
rnr=pi; if (m.eq.0) rnr=2.d00*pi 
Do n=n_min, nmx
 nn=n+nmx
 do l=1, l_max
  ll=l+l_max
  if (m.ne.0) then
   mi=MATRIX(n, ll)*rnr
   ml=MATRIX(nn, l)*rnr
   MATRIX(n, ll)=(ml+r_i*mi)
   MATRIX(nn, l)=-(mi+r_i*ml)
  end if
   mj=MATRIX(n, l)*rnr
   mk=MATRIX(nn, ll)*rnr
   MATRIX(n, l)=mk+r_i*mj
   MATRIX(nn, ll)=mj+r_i*mk
 end do
End do
End Subroutine Matrix_Making
!
Subroutine oMatrix_Making(nmx ,key)
use Advertisement
implicit none
integer*4, intent(in) :: nmx, key
integer*4 i, ii, n_min
complex*16 mi, mj, mk, ml
real*8 rnr, rnt, r, z, w(4)
M11=(0.d00,0.d00); M12=(0.d00,0.d00); M21=(0.d00,0.d00); M22=(0.d00,0.d00)
if (exc.lt.0.d00) then
 w(1)=-1.d00; w(2)=-width
 w(3)=width;   w(4)=1.d00
else
 w(1)=-1.d00;         w(2)=-1.d00+width
 w(3)=1.d00-width; w(4)=1.d00
end if
DO ii=1, 3 
DO i=1, node_max
 z=(w(ii+1)-w(ii))*node(i)/2.d00+(w(ii)+w(ii+1))/2.d00
 call Radius(z, r)
 call Normal(z, r, rnr, rnt)
 if (key.eq.1) Call Components(r, z, 1, n_max, 3, nPole, n_M, n_N)
 if (key.eq.2) Call oComponents(r, z, m_min, nmx, 1, n_M, n_N)
 if (key.eq.3) Call oComponents(r, z, m_min, nmx, 3, n_M, n_N)
 Call Components(r, z, 1, l_max, 1, lPole, l_M, l_N)
 n_min=m_min; if (key.eq.1) n_min=1
 Do n=n_min, nmx
  do l=1, l_max
   if (m.ne.0) then 
    M12(n, l)=M12(n, l)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(-n_M(2,n)*l_M(3,l)-n_M(3,n)*l_M(2,l))+ &
	 rnt*(n_M(1,n)*l_M(3,l)+n_M(3,n)*l_M(1,l)))
    M21(n, l)=M21(n, l)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(n_N(2,n)*l_N(3,l)+n_N(3,n)*l_N(2,l))+ &
	 rnt*(-n_N(1,n)*l_N(3,l)-n_N(3,n)*l_N(1,l)))
   end if
   M11(n, l)=M11(n, l)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(n_M(2,n)*l_N(3,l)-n_M(3,n)*l_N(2,l))+ &
	 rnt*(-n_M(1,n)*l_N(3,l)+n_M(3,n)*l_N(1,l)))
   M22(n, l)=M22(n, l)+(w(ii+1)-w(ii))/2.d00*weight(i)* &
    (rnr*(n_N(2,n)*l_M(3,l)-n_N(3,n)*l_M(2,l))+ &
	 rnt*(-n_N(1,n)*l_M(3,l)+n_N(3,n)*l_M(1,l)))
  end do
 End Do
END DO
END DO
rnr=pi; if (m.eq.0) rnr=2.d00*pi 
Do n=n_min, nmx
 do l=1, l_max
  if (m.ne.0) then
   mi=M12(n, l)*rnr
   ml=M21(n, l)*rnr
   M12(n, l)=(ml+r_i*mi)
   M21(n, l)=-(mi+r_i*ml)
  end if
   mj=M11(n, l)*rnr
   mk=M22(n, l)*rnr
   M11(n, l)=mk+r_i*mj
   M22(n, l)=mj+r_i*mk
 end do
End do
End Subroutine oMatrix_Making
!
Subroutine Coefficients_Conversion_to_M_M(min, max, key)
use Advertisement
implicit none
integer*4, intent(in) :: min, max, key
complex*16 e1(max), e2(max), o1(max), o2(max), &
                    p1(max), p2(max), m1(max), m2(max)
complex*16 a1, a2, a3, a4
real*8 alpha
integer*4 i
if (key.eq.1) then
  e1=a_e1; e2=a_e2; o1=a_o1; o2=a_o2
end if
if (key.eq.2) then
  e1=b_e1; e2=b_e2; o1=b_o1; o2=b_o2
end if
if (key.eq.3) then
  e1=c_e1; e2=c_e2; o1=c_o1; o2=c_o2
end if
if (key.eq.4) then
  e1=d_e1; e2=d_e2; o1=d_o1; o2=d_o2
end if
i=(-1)**m
alpha=i*dsqrt(2.d00/pi); if (m.eq.0) alpha=dsqrt(1.d00/pi)
do n=min, max
  if (m.eq.0) then
    a1=e1(n)/alpha; a2=e2(n)/alpha
	a3=(0.d00, 0.d00); a4=(0.d00, 0.d00)
  else
    a1=(e1(n)-(0.d00,1.d00)*o1(n))/alpha
    a2=(e2(n)-(0.d00,1.d00)*o2(n))/alpha
	a3=i*(e1(n)+(0.d00,1.d00)*o1(n))/alpha
    a4=i*(e2(n)+(0.d00,1.d00)*o2(n))/alpha
  end if
  if (key.eq.1) then
      a_p1(n)=a1*i/pi; a_p2(n)=a2*i/pi; a_m1(n)=a3*i/pi; a_m2(n)=a4*i/pi
  end if
  if (key.eq.2) then
    b_p1(n)=a1; b_p2(n)=a2; b_m1(n)=a3; b_m2(n)=a4
  end if
  if (key.eq.3) then
    c_p1(n)=a1; c_p2(n)=a2; c_m1(n)=a3; c_m2(n)=a4
  end if
  if (key.eq.4) then
    d_p1(n)=a1; d_p2(n)=a2; d_m1(n)=a3; d_m2(n)=a4
  end if
end do
End Subroutine Coefficients_Conversion_to_M_M
!
Subroutine Coefficients_Conversion_to_eo(min, max, key)
use Advertisement
implicit none
integer*4, intent(in) :: min, max, key
complex*16 e1(max), e2(max), o1(max), o2(max), &
                    p1(max), p2(max), m1(max), m2(max)
complex*16 a1, a2, a3, a4
real*8 alpha
integer*4 i
i=(-1)**m
alpha=i*dsqrt(.5d00/pi); if (m.eq.0) alpha=dsqrt(1.d00/pi)
if (key.eq.1) then
  p1=a_p1; p2=a_p2; m1=a_m1; m2=a_m2
end if
if (key.eq.2) then
  p1=b_p1; p2=b_p2; m1=b_m1; m2=b_m2
end if
if (key.eq.3) then
  p1=c_p1; p2=c_p2; m1=c_m1; m2=c_m2
end if
if (key.eq.4) then
  p1=d_p1; p2=d_p2; m1=d_m1; m2=d_m2
end if
do n=min, max
  if (m.eq.0) then
    a1=p1(n)*alpha; a2=p2(n)*alpha
	a3=(0.d00, 0.d00); a4=(0.d00, 0.d00)
  else
    a1=(p1(n)+i*m1(n))*alpha
    a2=(p2(n)+i*m2(n))*alpha
	a3=(p1(n)-i*m1(n))*alpha*(0.d00,1.d00)
    a4=(p2(n)-i*m2(n))*alpha*(0.d00,1.d00)
  end if
  if (key.eq.1) then
      a_e1(n)=a1*i*pi; a_e2(n)=a2*i*pi; a_o1(n)=a3*i*pi; a_o2(n)=a4*i*pi
  end if
  if (key.eq.2) then
    b_e1(n)=a1; b_e2(n)=a2; b_o1(n)=a3; b_o2(n)=a4
  end if
  if (key.eq.3) then
    c_e1(n)=a1; c_e2(n)=a2; c_o1(n)=a3; c_o2(n)=a4
  end if
  if (key.eq.4) then
    d_e1(n)=a1; d_e2(n)=a2; d_o1(n)=a3; d_o2(n)=a4
  end if
end do
End Subroutine Coefficients_Conversion_to_eo
!
Subroutine Matrix_Conversion_to_M_M(nmin, nmax, lmin, lmax)
use Advertisement
implicit none
integer*4, intent(in) :: nmin, nmax, lmin, lmax
real*8 alpha
alpha=((-1)**m)/pi
 do n=nmin, nmax
    do l=lmin, lmax
      MATRIX(n,l)=MATRIX(n,l)*alpha
	  MATRIX(n+nmax,l+lmax)=MATRIX(n+nmax,l+lmax)*alpha
	  if (m.gt.0) then
	    MATRIX(n+nmax,l)=MATRIX(n+nmax,l)*alpha*(0.d00,1.d00)
		MATRIX(n,l+lmax)=MATRIX(n,l+lmax)*alpha*(0.d00,-1.d00)
	  end if
    end do
  end do
End Subroutine Matrix_Conversion_to_M_M
!
Subroutine oMatrix_Conversion_to_M_M(nmin, nmax, lmin, lmax)
use Advertisement
implicit none
integer*4, intent(in) :: nmin, nmax, lmin, lmax
real*8 alpha
alpha=((-1)**m)/pi
 do n=nmin, nmax
    do l=lmin, lmax
      M11(n,l)=M11(n,l)*alpha
	  M22(n,l)=M22(n,l)*alpha
	  if (m.gt.0) then
	    M21(n,l)=M21(n,l)*alpha*(0.d00,1.d00)
		M12(n,l)=M12(n,l)*alpha*(0.d00,-1.d00)
	  end if
    end do
  end do
End Subroutine oMatrix_Conversion_to_M_M
!
Subroutine Radius(zet, er)
use Advertisement
implicit none
real*8, intent(in) :: zet
real*8, intent(out) :: er
er=rad/dsqrt(1.d00-exc*zet**2)
End Subroutine Radius
!
Subroutine Normal(zet, er, nr, nt)
use Advertisement
implicit none
real*8, intent(in) :: zet, er
real*8, intent(out) :: nr, nt
nr=er*er
nt=(er**4)*zet*dsqrt(1.d00-zet*zet)*exc/(rad**2)
End Subroutine Normal
!
Subroutine IntegrationCheck(key)
use Advertisement
implicit none
integer*4, intent(in) :: key
print *, pi
call Preparations
m=m_max
m_min=m; if (m.eq.0) m_min=1
call Normalization(n_max)
lPole(1)=(0.5d00,0.d00)
lPole(2)=(0.5d00,0.d00)
nPole(1)=(0.5d00,0.d00)
nPole(2)=(0.5d00,0.d00)
call Matrix_Making(n_max, key)
call Matrix_Conversion_to_M_M(1, 2, 1, 2)
write (*,*) 'A-matrix *******************'
do n=1, n_max
 do l=1, l_max
  print *, n, l, matrix(n, l)
 end do
end do
write (*,*) 'B-matrix *******************'
do n=1, n_max
 do l=1, l_max
  print *, n, l, matrix(n, l+l_max)
 end do
end do
write (*,*) 'C-matrix *******************'
do n=1, n_max
 do l=1, l_max
  print *, n, l, matrix(n+n_max, l+l_max)
 end do
end do
write (*,*) '-D-matrix ******************'
do n=1, n_max
 do l=1, l_max
  print *, n, l, matrix(n+n_max, l)
 end do
end do
End Subroutine IntegrationCheck
!