Subroutine T_Matrix
use Advertisement
implicit none
complex*16 T_M11, T_M12, T_M21, T_M22, factor
integer*4 i, ii, ll
factor=(0.d00,-1.d00)*((-1)**m)
d_p1=(0.d00,0.d00); d_p2=(0.d00,0.d00); d_m1=(0.d00,0.d00); d_m2=(0.d00,0.d00)
if (m.eq.0) then
  do n=m_min, m_min+terms-1
    do l=1, n_max
	  T_M11=(0.d00,0.d00); T_M12=(0.d00,0.d00)
	  T_M21=(0.d00,0.d00); T_M22=(0.d00,0.d00)
      do i=1, l_max
	    T_M11=T_M11+M11(n,i)*MATRIX(i,l)
		T_M22=T_M22+M22(n,i)*MATRIX(i+n_max,l+l_max)
	  end do
      T_M11=T_M11*factor; T_M22=T_M22*factor
	  d_p1(n)=d_p1(n)+T_M11*a_p1(l)
	  d_p2(n)=d_p2(n)+T_M22*a_p2(l)
	  write(07,*) dreal(T_M11)
	  write(07,*) dimag(T_M11)
	  write(07,*) dreal(T_M22)
	  write(07,*) dimag(T_M22)
    end do
  end do
else
  do n=m_min, m_min+terms-1
    do l=1, n_max
	  ll=l+l_max
	  T_M11=(0.d00,0.d00); T_M12=(0.d00,0.d00)
      T_M21=(0.d00,0.d00); T_M22=(0.d00,0.d00)
      do i=1, l_max
	    ii=i+n_max
	    T_M11=T_M11+M11(n,i)*MATRIX(i,l)+M12(n,i)*MATRIX(ii,l)
		T_M12=T_M12+M11(n,i)*MATRIX(i,ll)+M12(n,i)*MATRIX(ii,ll)
		T_M21=T_M21+M21(n,i)*MATRIX(i,l)+M22(n,i)*MATRIX(ii,l)
		T_M22=T_M22+M21(n,i)*MATRIX(i,ll)+M22(n,i)*MATRIX(ii,ll)
	  end do
	  T_M11=T_M11*factor; T_M22=T_M22*factor
	  T_M12=T_M12*factor; T_M21=T_M21*factor
	  d_m1(n)=d_m1(n)+T_M11*a_m1(l)+T_M12*a_m2(l) 
	  d_m2(n)=d_m2(n)+T_M21*a_m1(l)+T_M22*a_m2(l) 
	  d_p1(n)=d_p1(n)+T_M11*a_p1(l)-T_M12*a_p2(l) 
	  d_p2(n)=d_p2(n)-T_M21*a_p1(l)+T_M22*a_p2(l) 
	  write(07,*) dreal(T_M11)
	  write(07,*) dimag(T_M11)
	  write(07,*) dreal(T_M12)
	  write(07,*) dimag(T_M12)
	  write(07,*) dreal(T_M21)
	  write(07,*) dimag(T_M21)
	  write(07,*) dreal(T_M22)
	  write(07,*) dimag(T_M22)
    end do
  end do
end if
End Subroutine T_Matrix
!
Subroutine T_Matrix_DownLoad
use Advertisement
implicit none
real*8 re, im
integer*4 nn
rewind(7)
do n=1, terms
  do l=1, n_max
    read(07,*) re
	read(07,*) im; M11(n,l)=dcmplx(re,im)
	read(07,*) re
	read(07,*) im; M22(n,l)=dcmplx(re,im)
  end do
end do
do m=1, m_max
  do n=1, terms
    nn=n+m*terms
    do l=1, n_max
	  read(07,*) re
	  read(07,*) im; M11(nn,l)=dcmplx(re,im)
	  read(07,*) re
	  read(07,*) im; M12(nn,l)=dcmplx(re,im)
	  read(07,*) re
	  read(07,*) im; M21(nn,l)=dcmplx(re,im)
	  read(07,*) re
	  read(07,*) im; M22(nn,l)=dcmplx(re,im)
	end do
  end do
end do
End Subroutine T_Matrix_DownLoad
!
Subroutine W_Matrix(nn, ll, kk, ww)
use Advertisement
implicit none
integer*4, intent(in) :: nn, ll, kk
complex*16, intent(out) :: ww
complex*16 W11, W12, W21, W22
integer*4 i, ii
W11=(0.d00,0.d00); W12=(0.d00,0.d00); W21=(0.d00,0.d00); W22=(0.d00,0.d00)
if (m.eq.0) then
  ww=(0.d00,0.d00) 
  if (kk-2*(kk/2).eq.0) then
    do i=1, terms
      W11=W11+DCONJG(M11(i,nn))*M11(i,ll)+DCONJG(M21(i,nn))*M21(i,ll)
	  W22=W22+DCONJG(M12(i,nn))*M12(i,ll)+DCONJG(M22(i,nn))*M22(i,ll)
    end do
    ww=W11+W22
  end if
else
  if (kk-2*(kk/2).eq.0) then
	do i=1,terms
	  ii=i+m*terms
      W11=W11+DCONJG(M11(ii,nn))*M11(ii,ll)+DCONJG(M21(ii,nn))*M21(ii,ll)
	  W22=W22+DCONJG(M12(ii,nn))*M12(ii,ll)+DCONJG(M22(ii,nn))*M22(ii,ll)
	end do
	ww=2.d00*(W11+W22)
  else
    do i=1,terms
	  ii=i+m*terms
      W12=W12+DCONJG(M11(ii,nn))*M12(ii,ll)+DCONJG(M21(ii,nn))*M22(ii,ll)
	  W21=W21+DCONJG(M12(ii,nn))*M11(ii,ll)+DCONJG(M22(ii,nn))*M21(ii,ll)
	end do
    ww=2.d00*(W12+W21)
  end if
end if
End Subroutine W_Matrix
!
Subroutine T_Matrix_12(nn,ll, nn1, tt, tm, key)
use Advertisement
implicit none
integer*4, intent(in) :: nn, ll, nn1, tt, key
complex*16, intent(out) :: tm
integer*4 st, nnn
real*8 sw1, sw2
st=tt; if (tt.eq.0) st=1
sw1=2.d00; if (tt.eq.0) sw1=1.d00
sw2=2.d00; if (tt.eq.0) sw2=0.d00
nnn=nn+m*terms
if ((nn+nn1+st)-2*((nn+nn1+st)/2).eq.0) then
  if (key.eq.1) tm=sw1*(M11(nnn,ll)+M22(nnn,ll))
  if (key.eq.2) tm=sw1*(M11(nnn,ll)-M22(nnn,ll))
else
  if (key.eq.1) tm=sw2*(M12(nnn,ll)+M21(nnn,ll))
  if (key.eq.2) tm=sw2*(M12(nnn,ll)-M21(nnn,ll))
end if
End Subroutine T_Matrix_12
!
