! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.40)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine made_fourier_arb(fft,wn,number)

  implicit none
  integer, intent(in) :: number
  complex(8), intent(inout) :: fft(number),wn(number)

  integer :: i_do,ier,num_temp,i_mul
  complex(8), allocatable :: fft_temp1(:)

  allocate(fft_temp1(number),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: fft'
     stop
  end if

  do i_do=1,number
     fft_temp1(i_do)=fft(i_do)
  end do

  num_temp=number
  i_mul=1
  call fft_recur(fft_temp1,wn,num_temp,number,i_mul)

  do i_do=1,number
     fft(i_do)=fft_temp1(i_do)
  end do

  deallocate(fft_temp1,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: fft'
     stop
  end if

  return
end subroutine made_fourier_arb
recursive subroutine fft_recur(fft_temp1,wn,number,number_hold,i_mul)

  implicit none
  integer, intent(in) :: number,number_hold,i_mul
  complex(8), intent(inout) :: fft_temp1(number),wn(number_hold)

  integer :: n1,n2
  integer :: j1,j2,k1,k2,i1_do,ier,i_temp
  complex(8), allocatable :: fft_temp2(:),fft_temp3(:)

  if( number <= 1 ) then
     return
  end if

  n2=2
  do i1_do=1,number
     if( mod(number,n2) == 0 ) then
        exit
     end if
     n2=n2+1
  end do

  n1=number/n2

  allocate(fft_temp2(n1),fft_temp3(number),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: fft'
     stop
  end if

  i_temp=i_mul*n2
  do k1=0,n2-1
     do k2=0,n1-1
        fft_temp2(k2+1)=fft_temp1(k2*n2+k1+1)
     end do
     call fft_recur(fft_temp2,wn,n1,number_hold,i_temp)
     do k2=0,n1-1
        fft_temp3(k2*n2+k1+1)=fft_temp2(k2+1)
     end do
  end do

  deallocate(fft_temp2,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: fft'
     stop
  end if

  do i1_do=1,number
     fft_temp1(i1_do)=dcmplx(0.d0,0.d0)
  end do
  do j1=0,n1-1
     do j2=0,n2-1
        do k1=0,n2-1
           i_temp=(j2*n1+j1)*k1*i_mul+1
           do i1_do=1,number_hold
              if( i_temp > number_hold ) then
                 i_temp=i_temp-number_hold
              else
                 exit
              end if
           end do
           fft_temp1(j2*n1+j1+1)=fft_temp1(j2*n1+j1+1)                            &
                +wn(i_temp)*fft_temp3(j1*n2+k1+1)
        end do
     end do
  end do

  deallocate(fft_temp3,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: fft'
     stop
  end if

  return
end subroutine fft_recur

subroutine made_dft(fft_in,fft_out,r,p,number,i_dim,isign)

  implicit none
  integer, intent(in) :: number,i_dim,isign
  real(8), intent(in) :: r(i_dim,number),p(i_dim,number)
  complex(8), intent(in) :: fft_in(number)
  complex(8), intent(out) :: fft_out(number)

  integer :: i1_do,i2_do,i3_do
  real(8) :: theta
  complex(8) :: rot

  do i1_do=1,number
     fft_out(i1_do)=dcmplx(0.d0,0.d0)
  end do
  do i2_do=1,number
     do i1_do=1,number
        theta=0.d0
        do i3_do=1,i_dim
           theta=theta+r(i3_do,i1_do)*p(i3_do,i2_do)
        end do
        rot=dcmplx(dcos(theta),dfloat(isign)*dsin(theta))
        fft_out(i2_do)=fft_out(i2_do)+fft_in(i1_do)*rot
     end do
  end do

  return
end subroutine made_dft

subroutine made_fourier(fft,wn,number,n1)

  implicit none
  integer, intent(in) :: number,n1
  complex(8), intent(in) :: wn(number)
  complex(8), intent(inout) :: fft(number)

  integer :: n2
  complex(8), allocatable :: fft_temp(:)

  integer :: j0,j1,k0,k1,i_do,ier

  n2=number/n1

  allocate(fft_temp(number),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: fft'
     stop
  end if

  do j0=1,number
     fft_temp(j0)=dcmplx(0.d0,0.d0)
  end do

  do j0=0,n1-1
     do k0=0,n2-1
        do k1=0,n1-1
           j1=j0*k1*n2+1
           do i_do=1,number
              if( j1 > number ) then
                 j1=j1-number
              else
                 exit
              end if
           end do
           fft_temp(j0*n2+k0+1)=fft_temp(j0*n2+k0+1)+fft(k1*n2+k0+1)*wn(j1)
        end do
     end do
  end do

  do j0=1,number
     fft(j0)=dcmplx(0.d0,0.d0)
  end do

  do j0=0,n1-1
     do j1=0,n2-1
        do k0=0,n2-1
           k1=(j1*n1+j0)*k0+1
           do i_do=1,number
              if( k1 > number ) then
                 k1=k1-number
              else
                 exit
              end if
           end do
           fft(j1*n1+j0+1)=fft(j1*n1+j0+1)+fft_temp(j0*n2+k0+1)*wn(k1)
        end do
     end do
  end do

  deallocate(fft_temp,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: fft'
     stop
  end if

  return
end subroutine made_fourier
