! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 fourier_pot

  use scf_negf
  use fft
  use dft
  use hamiltonian_sgf
  use hamiltonian_c
  use gf_se_c
  use constant
  use condition_ini
  use mod_mpi

  implicit none
  integer :: interp_l,interp_r
  integer :: i1_do,i2_do,i1,i2,m3,i3,gn,i_do,ier,ispin,gn1
  real(8) :: r1,gx
  complex(8) :: temp_l,temp_r

  real(8), allocatable :: v_tot_l_int(:,:),vh_temp_l_int(:)
  real(8), allocatable :: v_tot_r_int(:,:),vh_temp_r_int(:)
  complex(8), allocatable :: den_l_int(:,:),den_r_int(:,:)

  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++ interpolate ...'
  close(16)

  interp_l=0
  if( n_a /= n_a_l .or. n_b /= n_b_l ) then
     interp_l=1
     allocate(v_tot_l_int(n_a*n_b*n_c_l,ispin_pol_scf)                          &
          ,vh_temp_l_int(n_a*n_b*n_c_l)                                      &
          ,den_l_int(n_a*n_b*n_c_l,ispin_pol_scf),stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
     call interpo_l(v_tot_l_int,vh_temp_l_int,den_l_int)
  end if
  interp_r=0
  if( n_a /= n_a_r .or. n_b /= n_b_r ) then
     interp_r=1
     allocate(v_tot_r_int(n_a*n_b*n_c_r,ispin_pol_scf)                          &
          ,vh_temp_r_int(n_a*n_b*n_c_r)                                      &
          ,den_r_int(n_a*n_b*n_c_r,ispin_pol_scf),stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
     call interpo_r(v_tot_r_int,vh_temp_r_int,den_r_int)
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do i2_do=0,n_b-1
        do i1_do=0,n_a-1
           if( interp_l == 0 ) then
              fft1(i1_do+1)=dcmplx(vh_l(i1_do*n_b_l+i2_do+1),0.d0)
           else
              fft1(i1_do+1)                                                        &
                   =dcmplx(vh_temp_l_int(i1_do*n_b*n_c_l+i2_do*n_c_l              &
                   +l_cell_l_bound_l-1+1),0.d0)
           end if
        end do
        if( ft_switch == 'f_2_ft' ) then
           call made_fourier(fft1,wxn,n_a,ix_fft)
        else
           call made_fourier_arb(fft1,wxn,n_a)
        end if
        do i1_do=0,n_a-1
           vh_l_f(i1_do*n_b+i2_do+1)=fft1(i1_do+1)
        end do
     end do
     do i1_do=0,n_a-1
        do i2_do=0,n_b-1
           fft2(i2_do+1)=vh_l_f(i1_do*n_b_l+i2_do+1)
        end do
        if( ft_switch == 'f_2_ft' ) then
           call made_fourier(fft2,wyn,n_b,iy_fft)
        else
           call made_fourier_arb(fft2,wyn,n_b)
        end if
        do i2_do=0,n_b-1
           vh_l_f(i1_do*n_b+i2_do+1)=fft2(i2_do+1)
        end do
     end do
  else
     do i2=0,n_b_l-1
        do i1=0,n_a_l-1
           r_tem(1,i1*n_b+i2+1)=dfloat(i1)
           r_tem(2,i1*n_b+i2+1)=dfloat(i2)
           p_tem(1,i1*n_b+i2+1)=dfloat(i1)*2.d0*pai/dfloat(n_a)
           p_tem(2,i1*n_b+i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b)
           if( interp_l == 0 ) then
              fft_in(i1*n_b+i2+1)=dcmplx(vh_l(i1*n_b_l+i2+1),0.d0)
           else
              fft_in(i1*n_b+i2+1)                                                  &
                   =dcmplx(vh_temp_l_int(i1*n_b*n_c_l+i2*n_c_l                  &
                   +l_cell_l_bound_l-1+1),0.d0)
           end if
        end do
     end do
     call made_dft(fft_in,fft_out,r_tem,p_tem,n_a*n_b,2,1)
     do i2=0,n_b-1
        do i1=0,n_a-1
           vh_l_f(i1*n_b+i2+1)=fft_out(i1*n_b+i2+1)
        end do
     end do
  end if

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do i2_do=0,n_b-1
        do i1_do=0,n_a-1
           if( interp_r == 0 ) then
              fft1(i1_do+1)=dcmplx(vh_r(i1_do*n_b_r+i2_do+1),0.d0)
           else
              fft1(i1_do+1)                                                        &
                   =dcmplx(vh_temp_r_int(i1_do*n_b*n_c_r+i2_do*n_c_r              &
                   +r_cell_l_bound_r-1+1),0.d0)
           end if
        end do
        if( ft_switch == 'f_2_ft' ) then
           call made_fourier(fft1,wxn,n_a,ix_fft)
        else
           call made_fourier_arb(fft1,wxn,n_a)
        end if
        do i1_do=0,n_a-1
           vh_r_f(i1_do*n_b+i2_do+1)=fft1(i1_do+1)
        end do
     end do
     do i1_do=0,n_a-1
        do i2_do=0,n_b-1
           fft2(i2_do+1)=vh_r_f(i1_do*n_b+i2_do+1)
        end do
        if( ft_switch == 'f_2_ft' ) then
           call made_fourier(fft2,wyn,n_b,iy_fft)
        else
           call made_fourier_arb(fft2,wyn,n_b)
        end if
        do i2_do=0,n_b-1
           vh_r_f(i1_do*n_b+i2_do+1)=fft2(i2_do+1)
        end do
     end do
  else
     do i2=0,n_b-1
        do i1=0,n_a-1
           r_tem(1,i1*n_b+i2+1)=dfloat(i1)
           r_tem(2,i1*n_b+i2+1)=dfloat(i2)
           p_tem(1,i1*n_b+i2+1)=dfloat(i1)*2.d0*pai/dfloat(n_a)
           p_tem(2,i1*n_b+i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b)
           if( interp_r == 0 ) then
              fft_in(i1*n_b+i2+1)=dcmplx(vh_r(i1*n_b_r+i2+1),0.d0)
           else
              fft_in(i1*n_b+i2+1)                                                  &
                   =dcmplx(vh_temp_r_int(i1*n_b*n_c_r+i2*n_c_r                    &
                   +r_cell_l_bound_r-1+1),0.d0)
           end if
        end do
     end do
     call made_dft(fft_in,fft_out,r_tem,p_tem,n_a*n_b,2,1)
     do i2=0,n_b-1
        do i1=0,n_a-1
           vh_r_f(i1*n_b+i2+1)=fft_out(i1*n_b+i2+1)
        end do
     end do
  end if
  !                       ------------------------------------                       !

  pai=datan(1.d0)*4.d0

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     call alo_fft_zz(n_c_l)
     do i1=0,n_a-1
        do i2=0,n_b-1
           do i3=0,n_c_l-1
              if( interp_l == 0 ) then
                 fft3(i3+1)                                                         &
                      =dcmplx(vh_temp_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1),0.d0)
              else
                 fft3(i3+1)                                                         &
                      =dcmplx(vh_temp_l_int(i1*n_b*n_c_l+i2*n_c_l+i3+1),0.d0)
              end if
           end do
           if( ft_switch == 'f_2_ft' ) then
              call made_fourier(fft3,wzn,n_c_l,iz_fft_l)
           else
              call made_fourier_arb(fft3,wzn,n_c_l)
           end if
           do i_do=0,l_cell_l_bound
              gn=i1*n_b*n_c+i2*n_c+i_do+1
              r1=cell_lr(1,i_do+1)+cell_labc(3,1)/dfloat(2*n_c)                    &
                   -cell_labc_l(3,1)/dfloat(2*n_c_l)
              temp_l=dcmplx(0.d0,0.d0)
              do i3=0,n_c_l-1
                 if( i3 < n_c_l/2 ) then
                    m3=i3
                 else
                    m3=i3-n_c_l
                 end if
                 gx=dfloat(m3)*2.d0*pai/cell_labc_l(3,1)
                 temp_l=temp_l+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              v_hartree(gn)=dreal(temp_l)/dfloat(n_c_l)
           end do
        end do
     end do
     call unset_fft_zz
  else
     call alo_dft_z(n_c_l)
     do i1=0,n_a-1
        do i2=0,n_b-1
           do i3=0,n_c_l-1
              r_tem_z(1,i3+1)=dfloat(i3)
              p_tem_z(1,i3+1)=dfloat(i3)*2.d0*pai/dfloat(n_c_l)
              if( interp_l == 0 ) then
                 fft_in_z(i3+1)                                                     &
                      =dcmplx(vh_temp_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1),0.d0)
              else
                 fft_in_z(i3+1)                                                     &
                      =dcmplx(vh_temp_l_int(i1*n_b*n_c_l+i2*n_c_l+i3+1),0.d0)
              end if
           end do
           call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_c_l,1,1)
           do i_do=0,l_cell_l_bound
              gn=i1*n_b*n_c+i2*n_c+i_do+1
              r1=cell_lr(1,i_do+1)+cell_labc(3,1)/dfloat(2*n_c)                    &
                   -cell_labc_l(3,1)/dfloat(2*n_c_l)
              temp_l=dcmplx(0.d0,0.d0)
              do i3=0,n_c_l-1
                 if( i3 < n_c_l/2 ) then
                    m3=i3
                 else
                    m3=i3-n_c_l
                 end if
                 gx=dfloat(m3)*2.d0*pai/cell_labc_l(3,1)
                 temp_l=temp_l+fft_out_z(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              v_hartree(gn)=dreal(temp_l)/dfloat(n_c_l)
           end do
        end do
     end do
     call unset_dft_z
  end if

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     call alo_fft_zz(n_c_r)
     do i1=0,n_a-1
        do i2=0,n_b-1
           do i3=0,n_c_r-1
              if( interp_r == 0 ) then
                 fft3(i3+1)                                                         &
                      =dcmplx(vh_temp_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1),0.d0)
              else
                 fft3(i3+1)                                                         &
                      =dcmplx(vh_temp_r_int(i1*n_b*n_c_r+i2*n_c_r+i3+1),0.d0)
              end if
           end do
           if( ft_switch == 'f_2_ft' ) then
              call made_fourier(fft3,wzn,n_c_r,iz_fft_r)
           else
              call made_fourier_arb(fft3,wzn,n_c_r)
           end if
           do i_do=r_cell_l_bound-1,n_c-1
              gn=i1*n_b*n_c+i2*n_c+i_do+1
              r1=cell_lr(1,i_do+1)-cell_labc(3,1)+cell_labc(3,1)/dfloat(2*n_c)     &
                   -cell_labc_r(3,1)/dfloat(2*n_c_r)
              temp_r=dcmplx(0.d0,0.d0)
              do i3=0,n_c_r-1
                 if( i3 < n_c_r/2 ) then
                    m3=i3
                 else
                    m3=i3-n_c_r
                 end if
                 gx=dfloat(m3)*2.d0*pai/cell_labc_r(3,1)
                 temp_r=temp_r+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              v_hartree(gn)=dreal(temp_r)/dfloat(n_c_r)
           end do
        end do
     end do
     call unset_fft_zz
  else
     call alo_dft_z(n_c)
     do i1=0,n_a-1
        do i2=0,n_b-1
           do i3=0,n_c_r-1
              r_tem_z(1,i3+1)=dfloat(i3)
              p_tem_z(1,i3+1)=dfloat(i3)*2.d0*pai/dfloat(n_c_r)
              if( interp_r == 0 ) then
                 fft_in_z(i3+1)                                                     &
                      =dcmplx(vh_temp_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1),0.d0)
              else
                 fft_in_z(i3+1)                                                     &
                      =dcmplx(vh_temp_r_int(i1*n_b*n_c_r+i2*n_c_r+i3+1),0.d0)
              end if
           end do
           call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_c_r,1,1)
           do i_do=r_cell_l_bound-1,n_c-1
              gn=i1*n_b*n_c+i2*n_c+i_do+1
              r1=cell_lr(1,i_do+1)-cell_labc(3,1)+cell_labc(3,1)/dfloat(2*n_c)     &
                   -cell_labc_r(3,1)/dfloat(2*n_c_r)
              temp_r=dcmplx(0.d0,0.d0)
              do i3=0,n_c_r-1
                 if( i3 < n_c_r/2 ) then
                    m3=i3
                 else
                    m3=i3-n_c_r
                 end if
                 gx=dfloat(m3)*2.d0*pai/cell_labc_r(3,1)
                 temp_r=temp_r+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              v_hartree(gn)=dreal(temp_r)/dfloat(n_c_r)
           end do
        end do
     end do
     call unset_dft_z
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     call alo_fft_zz(n_c_l)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_l-1
                 if( interp_l == 0 ) then
                    gn1=i1*n_b_l*n_c_l+i2*n_c_l+i3+1
                    fft3(i3+1)=dcmplx(v_tot_l(gn1,ispin),0.d0)
                 else
                    gn1=i1*n_b*n_c_l+i2*n_c_l+i3+1
                    fft3(i3+1)=dcmplx(v_tot_l_int(gn1,ispin),0.d0)
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_c_l,iz_fft_l)
              else
                 call made_fourier_arb(fft3,wzn,n_c_l)
              end if
              do i_do=0,l_cell_l_bound
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)+cell_labc(3,1)/dfloat(2*n_c)                  &
                      -cell_labc_l(3,1)/dfloat(2*n_c_l)
                 temp_l=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_l-1
                    if( i3 < n_c_l/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_l
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_l(3,1)
                    temp_l=temp_l+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 v_tot(gn,ispin)=dreal(temp_l)/dfloat(n_c_l)
              end do
           end do
        end do
     end do
     call unset_fft_zz
  else
     call alo_dft_z(n_c_l)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_l-1
                 r_tem_z(1,i3+1)=dfloat(i3)
                 p_tem_z(1,i3+1)=dfloat(i3)*2.d0*pai/dfloat(n_c_l)
                 if( interp_l == 0 ) then
                    gn1=i1*n_b_l*n_c_l+i2*n_c_l+i3+1
                    fft_in_z(i3+1)=dcmplx(v_tot_l(gn1,ispin),0.d0)
                 else
                    gn1=i1*n_b*n_c_l+i2*n_c_l+i3+1
                    fft_in_z(i3+1)=dcmplx(v_tot_l_int(gn1,ispin),0.d0)
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_c_l,1,1)
              do i_do=0,l_cell_l_bound
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)+cell_labc(3,1)/dfloat(2*n_c)                  &
                      -cell_labc_l(3,1)/dfloat(2*n_c_l)
                 temp_l=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_l-1
                    if( i3 < n_c_l/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_l
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_l(3,1)
                    temp_l=temp_l+fft_out_z(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 v_tot(gn,ispin)=dreal(temp_l)/dfloat(n_c_l)
              end do
           end do
        end do
     end do
     call unset_dft_z
  end if

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     call alo_fft_zz(n_c_r)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_r-1
                 if( interp_r == 0 ) then
                    gn1=i1*n_b_r*n_c_r+i2*n_c_r+i3+1
                    fft3(i3+1)=dcmplx(v_tot_r(gn1,ispin),0.d0)
                 else
                    gn1=i1*n_b*n_c_r+i2*n_c_r+i3+1
                    fft3(i3+1)=dcmplx(v_tot_r_int(gn1,ispin),0.d0)
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_c_r,iz_fft_r)
              else
                 call made_fourier_arb(fft3,wzn,n_c_r)
              end if
              do i_do=r_cell_l_bound-1,n_c-1
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)-cell_labc(3,1)+cell_labc(3,1)/dfloat(2*n_c)   &
                      -cell_labc_r(3,1)/dfloat(2*n_c_r)
                 temp_r=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_r-1
                    if( i3 < n_c_r/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_r
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_r(3,1)
                    temp_r=temp_r+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 v_tot(gn,ispin)=dreal(temp_r)/dfloat(n_c_r)
              end do
           end do
        end do
     end do
     call unset_fft_zz
  else
     call alo_dft_z(n_c)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_r-1
                 r_tem_z(1,i3+1)=dfloat(i3)
                 p_tem_z(1,i3+1)=dfloat(i3)*2.d0*pai/dfloat(n_c_r)
                 if( interp_r == 0 ) then
                    gn1=i1*n_b_r*n_c_r+i2*n_c_r+i3+1
                    fft_in_z(i3+1)=dcmplx(v_tot_r(gn1,ispin),0.d0)
                 else
                    gn1=i1*n_b*n_c_r+i2*n_c_r+i3+1
                    fft_in_z(i3+1)=dcmplx(v_tot_r_int(gn1,ispin),0.d0)
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_c_r,1,1)
              do i_do=r_cell_l_bound-1,n_c-1
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)-cell_labc(3,1)+cell_labc(3,1)/dfloat(2*n_c)   &
                      -cell_labc_r(3,1)/dfloat(2*n_c_r)
                 temp_r=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_r-1
                    if( i3 < n_c_r/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_r
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_r(3,1)
                    temp_r=temp_r+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 v_tot(gn,ispin)=dreal(temp_r)/dfloat(n_c_r)
              end do
           end do
        end do
     end do
     call unset_dft_z
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     call alo_fft_zz(n_c_l)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_l-1
                 if( interp_l == 0 ) then
                    gn1=i1*n_b_l*n_c_l+i2*n_c_l+i3+1
                    if( ispin_pol_scf < 4 ) then
                       fft3(i3+1)=dcmplx(den_l(gn1,ispin),0.d0)
                    else
                       fft3(i3+1)=denls_l(gn1,ispin)
                    end if
                 else
                    gn1=i1*n_b*n_c_l+i2*n_c_l+i3+1
                    fft3(i3+1)=den_l_int(gn1,ispin)
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_c_l,iz_fft_l)
              else
                 call made_fourier_arb(fft3,wzn,n_c_l)
              end if
              do i_do=0,l_cell_l_bound
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)+cell_labc(3,1)/dfloat(2*n_c)                  &
                      -cell_labc_l(3,1)/dfloat(2*n_c_l)
                 temp_l=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_l-1
                    if( i3 < n_c_l/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_l
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_l(3,1)
                    temp_l=temp_l+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 if( ispin_pol_scf < 4 ) then
                    rho(gn,ispin)=dcmplx(dreal(temp_l)/dfloat(n_c_l),0.d0)
                 else
                    rhols(gn,ispin)=temp_l/dfloat(n_c_l)
                 end if
              end do
           end do
        end do
     end do
     call unset_fft_zz
  else
     call alo_dft_z(n_c_l)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_l-1
                 r_tem_z(1,i3+1)=dfloat(i3)
                 p_tem_z(1,i3+1)=dfloat(i3)*2.d0*pai/dfloat(n_c_l)
                 if( interp_l == 0 ) then
                    gn1=i1*n_b_l*n_c_l+i2*n_c_l+i3+1
                    if( ispin_pol_scf < 4 ) then
                       fft_in_z(i3+1)=dcmplx(den_l(gn1,ispin),0.d0)
                    else
                       fft_in_z(i3+1)=denls_l(gn1,ispin)
                    end if
                 else
                    gn1=i1*n_b*n_c_l+i2*n_c_l+i3+1
                    fft_in_z(i3+1)=den_l_int(gn1,ispin)
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_c_l,1,1)
              do i_do=0,l_cell_l_bound
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)+cell_labc(3,1)/dfloat(2*n_c)                  &
                      -cell_labc_l(3,1)/dfloat(2*n_c_l)
                 temp_l=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_l-1
                    if( i3 < n_c_l/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_l
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_l(3,1)
                    temp_l=temp_l+fft_out_z(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 if( ispin_pol_scf < 4 ) then
                    rho(gn,ispin)=dreal(temp_l)/dfloat(n_c_l)
                 else
                    rhols(gn,ispin)=temp_l/dfloat(n_c_l)
                 end if
              end do
           end do
        end do
     end do
     call unset_dft_z
  end if

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     call alo_fft_zz(n_c_r)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_r-1
                 if( interp_r == 0 ) then
                    gn1=i1*n_b_r*n_c_r+i2*n_c_r+i3+1
                    if( ispin_pol_scf < 4 ) then
                       fft3(i3+1)=dcmplx(den_r(gn1,ispin),0.d0)
                    else
                       fft3(i3+1)=denls_r(gn1,ispin)
                    end if
                 else
                    gn1=i1*n_b*n_c_r+i2*n_c_r+i3+1
                    fft3(i3+1)=den_r_int(gn1,ispin)
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_c_r,iz_fft_r)
              else
                 call made_fourier_arb(fft3,wzn,n_c_r)
              end if
              do i_do=r_cell_l_bound-1,n_c-1
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)-cell_labc(3,1)+cell_labc(3,1)/dfloat(2*n_c)   &
                      -cell_labc_r(3,1)/dfloat(2*n_c_r)
                 temp_r=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_r-1
                    if( i3 < n_c_r/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_r
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_r(3,1)
                    temp_r=temp_r+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 if( ispin_pol_scf < 4 ) then
                    rho(gn,ispin)=dreal(temp_r)/dfloat(n_c_r)
                 else
                    rhols(gn,ispin)=temp_r/dfloat(n_c_r)
                 end if
              end do
           end do
        end do
     end do
     call unset_fft_zz
  else
     call alo_dft_z(n_c)
     do ispin=1,ispin_pol_scf
        do i1=0,n_a-1
           do i2=0,n_b-1
              do i3=0,n_c_r-1
                 r_tem_z(1,i3+1)=dfloat(i3)
                 p_tem_z(1,i3+1)=dfloat(i3)*2.d0*pai/dfloat(n_c_r)
                 if( interp_r == 0 ) then
                    gn1=i1*n_b_r*n_c_r+i2*n_c_r+i3+1
                    if( ispin_pol_scf < 4 ) then
                       fft_in_z(i3+1)=dcmplx(den_r(gn1,ispin),0.d0)
                    else
                       fft_in_z(i3+1)=denls_r(gn1,ispin)
                    end if
                 else
                    gn1=i1*n_b*n_c_r+i2*n_c_r+i3+1
                    fft_in_z(i3+1)=den_r_int(gn1,ispin)
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_c_r,1,1)
              do i_do=r_cell_l_bound-1,n_c-1
                 gn=i1*n_b*n_c+i2*n_c+i_do+1
                 r1=cell_lr(1,i_do+1)-cell_labc(3,1)+cell_labc(3,1)/dfloat(2*n_c)   &
                      -cell_labc_r(3,1)/dfloat(2*n_c_r)
                 temp_r=dcmplx(0.d0,0.d0)
                 do i3=0,n_c_r-1
                    if( i3 < n_c_r/2 ) then
                       m3=i3
                    else
                       m3=i3-n_c_r
                    end if
                    gx=dfloat(m3)*2.d0*pai/cell_labc_r(3,1)
                    temp_r=temp_r+fft3(i3+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 if( ispin_pol_scf < 4 ) then
                    rho(gn,ispin)=dreal(temp_r)/dfloat(n_c_r)
                 else
                    rhols(gn,ispin)=temp_r/dfloat(n_c_r)
                 end if
              end do
           end do
        end do
     end do
     call unset_dft_z
  end if

  !                       ------------------------------------                       !

  do ispin=1,ispin_pol_scf
     do i1=0,n_a-1
        do i2=0,n_b-1
           do i3=0,n_c-1
              gn=i1*n_b*n_c+i2*n_c+i3+1
              if( ispin_pol_scf < 4 ) then
                 if( i3+1 > l_cell_l_bound .and. i3+1 < r_cell_l_bound ) then
                    rho(gn,ispin)=rho_temp(gn,ispin)
                 else
                    rho_temp(gn,ispin)=rho(gn,ispin)
                 end if
              else
                 if( i3+1 > l_cell_l_bound .and. i3+1 < r_cell_l_bound ) then
                    rhols(gn,ispin)=rhols_temp(gn,ispin)
                 else
                    rhols_temp(gn,ispin)=rhols(gn,ispin)
                 end if
              end if
           end do
        end do
     end do
  end do

  !                       ------------------------------------                       !

  if( n_a /= n_a_l .or. n_b /= n_b_l ) then
     deallocate(v_tot_l_int,vh_temp_l_int,den_l_int,stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
  end if
  if( n_a /= n_a_r .or. n_b /= n_b_r ) then
     deallocate(v_tot_r_int,vh_temp_r_int,den_r_int,stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
  end if

  return
end subroutine fourier_pot

subroutine interpo_l(v_tot_l_int,vh_temp_l_int,den_l_int)

  use scf_negf
  use fft
  use dft
  use hamiltonian_sgf
  use hamiltonian_c
  use gf_se_c
  use constant
  use condition_ini

  implicit none
  real(8), intent(inout) :: v_tot_l_int(n_a*n_b*n_c_l,ispin_pol_scf)
  real(8), intent(inout) :: vh_temp_l_int(n_a*n_b*n_c_l)
  complex(8), intent(inout) :: den_l_int(n_a*n_b*n_c_l,ispin_pol_scf)

  real(8), allocatable :: temp_forier(:),temp_forier1(:)

  integer :: i1,i2,i3,m1,m2,gn,i_do,ier,i1_fft_l,i2_fft_l,ispin
  real(8) :: r1,gx
  complex(8) :: temp_l

  pai=datan(1.d0)*4.d0

  if( ft_switch == 'f_2_ft' ) then
     call set_f_2_ft_intl(n_a_l,i1_fft_l)
     call set_f_2_ft_intl(n_b_l,i2_fft_l)
  end if

  allocate(temp_forier(n_a*n_b_l),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: cal_hamiltonian'
     stop
  end if
  if( ispin_pol_scf == 4 ) then
     allocate(temp_forier1(n_a*n_b_l),stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do i3=0,n_c_l-1
        call alo_fft_zz(n_a_l)
        do i2=0,n_b_l-1
           do i1=0,n_a_l-1
              fft3(i1+1)                                                           &
                   =dcmplx(vh_temp_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1),0.d0)
           end do
           if( ft_switch == 'f_2_ft' ) then
              call made_fourier(fft3,wzn,n_a_l,i1_fft_l)
           else
              call made_fourier_arb(fft3,wzn,n_a_l)
           end if
           do i_do=0,n_a-1
              gn=i_do*n_b_l+i2+1
              r1=dfloat(i_do*n_a_l)/dfloat(n_a)                                    &
                   +dfloat(n_a_l)/dfloat(2*n_a)-0.5d0
              temp_l=dcmplx(0.d0,0.d0)
              do i1=0,n_a_l-1
                 if( i1 < n_a_l/2 ) then
                    m1=i1
                 else
                    m1=i1-n_a_l
                 end if
                 gx=dfloat(m1)*2.d0*pai/dfloat(n_a_l)
                 temp_l=temp_l+fft3(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              temp_forier(gn)=dreal(temp_l)/dfloat(n_a_l)
           end do
        end do
        call unset_fft_zz
        call alo_fft_zz(n_b_l)
        do i1=0,n_a-1
           do i2=0,n_b_l-1
              gn=i1*n_b_l+i2+1
              fft3(i2+1)=dcmplx(temp_forier(gn),0.d0)
           end do
           if( ft_switch == 'f_2_ft' ) then
              call made_fourier(fft3,wzn,n_b_l,i2_fft_l)
           else
              call made_fourier_arb(fft3,wzn,n_b_l)
           end if
           do i_do=0,n_b-1
              r1=dfloat(i_do*n_b_l)/dfloat(n_b)                                    &
                   +dfloat(n_b_l)/dfloat(2*n_b)-0.5d0
              temp_l=dcmplx(0.d0,0.d0)
              do i2=0,n_b_l-1
                 if( i2 < n_b_l/2 ) then
                    m2=i2
                 else
                    m2=i2-n_b_l
                 end if
                 gx=dfloat(m2)*2.d0*pai/dfloat(n_b_l)
                 temp_l=temp_l+fft3(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              gn=i1*n_b*n_c_l+i_do*n_c_l+i3+1
              vh_temp_l_int(gn)=dreal(temp_l)/dfloat(n_b_l)
           end do
        end do
        call unset_fft_zz
     end do
  else
     do i3=0,n_c_l-1
        call alo_dft_z(n_a_l)
        do i2=0,n_b_l-1
           do i1=0,n_a_l-1
              r_tem_z(1,i1+1)=dfloat(i1)
              p_tem_z(1,i1+1)=dfloat(i1)*2.d0*pai/dfloat(n_a_l)
              fft_in_z(i1+1)                                                       &
                   =dcmplx(vh_temp_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1),0.d0)
           end do
           call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_a_l,1,1)
           do i_do=0,n_a-1
              gn=i_do*n_b_l+i2+1
              r1=dfloat(i_do*n_a_l)/dfloat(n_a)                                    &
                   +dfloat(n_a_l)/dfloat(2*n_a)-0.5d0
              temp_l=dcmplx(0.d0,0.d0)
              do i1=0,n_a_l-1
                 if( i1 < n_a_l/2 ) then
                    m1=i1
                 else
                    m1=i1-n_a_l
                 end if
                 gx=dfloat(m1)*2.d0*pai/dfloat(n_a_l)
                 temp_l=temp_l+fft_out_z(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              temp_forier(gn)=dreal(temp_l)/dfloat(n_a_l)
           end do
        end do
        call unset_dft_z
        call alo_dft_z(n_b_l)
        do i1=0,n_a-1
           do i2=0,n_b_l-1
              r_tem_z(1,i2+1)=dfloat(i2)
              p_tem_z(1,i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b_l)
              gn=i_do*n_b_l+i2+1
              fft_in_z(i2+1)=dcmplx(temp_forier(gn),0.d0)
           end do
           call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_b_l,1,1)
           do i_do=0,n_b-1
              r1=dfloat(i_do*n_b_l)/dfloat(n_b)                                    &
                   +dfloat(n_b_l)/dfloat(2*n_b)-0.5d0
              temp_l=dcmplx(0.d0,0.d0)
              do i2=0,n_b_l-1
                 if( i2 < n_b_l/2 ) then
                    m2=i2
                 else
                    m2=i2-n_b_l
                 end if
                 gx=dfloat(m2)*2.d0*pai/dfloat(n_b_l)
                 temp_l=temp_l+fft_out_z(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              gn=i1*n_b*n_c_l+i_do*n_c_l+i3+1
              vh_temp_l_int(gn)=dreal(temp_l)/dfloat(n_b_l)
           end do
        end do
        call unset_dft_z
     end do
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_l-1
           call alo_fft_zz(n_a_l)
           do i2=0,n_b_l-1
              do i1=0,n_a_l-1
                 fft3(i1+1)                                                         &
                      =dcmplx(v_tot_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1,ispin),0.d0)
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_a_l,i1_fft_l)
              else
                 call made_fourier_arb(fft3,wzn,n_a_l)
              end if
              do i_do=0,n_a-1
                 gn=i_do*n_b_l+i2+1
                 r1=dfloat(i_do*n_a_l)/dfloat(n_a)                                  &
                      +dfloat(n_a_l)/dfloat(2*n_a)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_l-1
                    if( i1 < n_a_l/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_l
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_l)
                    temp_l=temp_l+fft3(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_l)/dfloat(n_a_l)
              end do
           end do
           call unset_fft_zz
           call alo_fft_zz(n_b_l)
           do i1=0,n_a-1
              do i2=0,n_b_l-1
                 gn=i1*n_b_l+i2+1
                 fft3(i2+1)=dcmplx(temp_forier(gn),0.d0)
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_b_l,i2_fft_l)
              else
                 call made_fourier_arb(fft3,wzn,n_b_l)
              end if
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_l)/dfloat(n_b)                                  &
                      +dfloat(n_b_l)/dfloat(2*n_b)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_l-1
                    if( i2 < n_b_l/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_l
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_l)
                    temp_l=temp_l+fft3(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_l+i_do*n_c_l+i3+1
                 v_tot_l_int(gn,ispin)=dreal(temp_l)/dfloat(n_b_l)
              end do
           end do
           call unset_fft_zz
        end do
     end do
  else
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_l-1
           call alo_dft_z(n_a_l)
           do i2=0,n_b_l-1
              do i1=0,n_a_l-1
                 r_tem_z(1,i1+1)=dfloat(i1)
                 p_tem_z(1,i1+1)=dfloat(i1)*2.d0*pai/dfloat(n_a_l)
                 fft_in_z(i1+1)                                                     &
                      =dcmplx(v_tot_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1,ispin),0.d0)
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_a_l,1,1)
              do i_do=0,n_a-1
                 gn=i_do*n_b_l+i2+1
                 r1=dfloat(i_do*n_a_l)/dfloat(n_a)                                  &
                      +dfloat(n_a_l)/dfloat(2*n_a)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_l-1
                    if( i1 < n_a_l/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_l
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_l)
                    temp_l=temp_l+fft_out_z(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_l)/dfloat(n_a_l)
              end do
           end do
           call unset_dft_z
           call alo_dft_z(n_b_l)
           do i1=0,n_a-1
              do i2=0,n_b_l-1
                 r_tem_z(1,i2+1)=dfloat(i2)
                 p_tem_z(1,i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b_l)
                 gn=i_do*n_b_l+i2+1
                 fft_in_z(i2+1)=dcmplx(temp_forier(gn),0.d0)
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_b_l,1,1)
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_l)/dfloat(n_b)                                  &
                      +dfloat(n_b_l)/dfloat(2*n_b)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_l-1
                    if( i2 < n_b_l/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_l
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_l)
                    temp_l=temp_l+fft_out_z(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_l+i_do*n_c_l+i3+1
                 v_tot_l_int(gn,ispin)=dreal(temp_l)/dfloat(n_b_l)
              end do
           end do
           call unset_dft_z
        end do
     end do
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_l-1
           call alo_fft_zz(n_a_l)
           do i2=0,n_b_l-1
              do i1=0,n_a_l-1
                 if( ispin_pol_scf < 4 ) then
                    fft3(i1+1)                                                       &
                         =dcmplx(den_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1,ispin),0.d0)
                 else
                    fft3(i1+1)=denls_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1,ispin)
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_a_l,i1_fft_l)
              else
                 call made_fourier_arb(fft3,wzn,n_a_l)
              end if
              do i_do=0,n_a-1
                 gn=i_do*n_b_l+i2+1
                 r1=dfloat(i_do*n_a_l)/dfloat(n_a)                                  &
                      +dfloat(n_a_l)/dfloat(2*n_a)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_l-1
                    if( i1 < n_a_l/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_l
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_l)
                    temp_l=temp_l+fft3(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_l)/dfloat(n_a_l)
                 if( ispin_pol_scf == 4 ) then
                    temp_forier1(gn)=dimag(temp_l)/dfloat(n_a_l)
                 end if
              end do
           end do
           call unset_fft_zz
           call alo_fft_zz(n_b_l)
           do i1=0,n_a-1
              do i2=0,n_b_l-1
                 gn=i1*n_b_l+i2+1
                 if( ispin_pol_scf < 4 ) then
                    fft3(i2+1)=dcmplx(temp_forier(gn),0.d0)
                 else
                    fft3(i2+1)=dcmplx(temp_forier(gn),temp_forier1(gn))
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_b_l,i2_fft_l)
              else
                 call made_fourier_arb(fft3,wzn,n_b_l)
              end if
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_l)/dfloat(n_b)                                  &
                      +dfloat(n_b_l)/dfloat(2*n_b)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_l-1
                    if( i2 < n_b_l/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_l
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_l)
                    temp_l=temp_l+fft3(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_l+i_do*n_c_l+i3+1
                 if( ispin_pol_scf < 4 ) then
                    den_l_int(gn,ispin)=dcmplx(dreal(temp_l)/dfloat(n_b_l),0.d0)
                 else
                    den_l_int(gn,ispin)=temp_l/dfloat(n_b_l)
                 end if
              end do
           end do
           call unset_fft_zz
        end do
     end do
  else
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_l-1
           call alo_dft_z(n_a_l)
           do i2=0,n_b_l-1
              do i1=0,n_a_l-1
                 r_tem_z(1,i1+1)=dfloat(i1)
                 p_tem_z(1,i1+1)=dfloat(i1)*2.d0*pai/dfloat(n_a_l)
                 if( ispin_pol_scf < 4 ) then
                    fft_in_z(i1+1)                                                   &
                         =dcmplx(den_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1,ispin),0.d0)
                 else
                    fft_in_z(i1+1)=denls_l(i1*n_b_l*n_c_l+i2*n_c_l+i3+1,ispin)
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_a_l,1,1)
              do i_do=0,n_a-1
                 gn=i_do*n_b_l+i2+1
                 r1=dfloat(i_do*n_a_l)/dfloat(n_a)                                  &
                      +dfloat(n_a_l)/dfloat(2*n_a)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_l-1
                    if( i1 < n_a_l/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_l
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_l)
                    temp_l=temp_l+fft_out_z(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_l)/dfloat(n_a_l)
                 if( ispin_pol_scf == 4 ) then
                    temp_forier1(gn)=dimag(temp_l)/dfloat(n_a_l)
                 end if
              end do
           end do
           call unset_dft_z
           call alo_dft_z(n_b_l)
           do i1=0,n_a-1
              do i2=0,n_b_l-1
                 r_tem_z(1,i2+1)=dfloat(i2)
                 p_tem_z(1,i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b_l)
                 gn=i_do*n_b_l+i2+1
                 if( ispin_pol_scf < 4 ) then
                    fft_in_z(i2+1)=dcmplx(temp_forier(gn),0.d0)
                 else
                    fft_in_z(i2+1)=dcmplx(temp_forier(gn),temp_forier1(gn))
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_b_l,1,1)
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_l)/dfloat(n_b)                                  &
                      +dfloat(n_b_l)/dfloat(2*n_b)-0.5d0
                 temp_l=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_l-1
                    if( i2 < n_b_l/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_l
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_l)
                    temp_l=temp_l+fft_out_z(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_l+i_do*n_c_l+i3+1
                 if( ispin_pol_scf < 4 ) then
                    den_l_int(gn,ispin)=dcmplx(dreal(temp_l)/dfloat(n_b_l),0.d0)
                 else
                    den_l_int(gn,ispin)=temp_l/dfloat(n_b_l)
                 end if
              end do
           end do
           call unset_dft_z
        end do
     end do
  end if

  !                       ------------------------------------                       !

  deallocate(temp_forier,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: cal_hamiltonian'
     stop
  end if
  if( ispin_pol_scf == 4 ) then
     deallocate(temp_forier1,stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
  end if

  return
end subroutine interpo_l

subroutine set_f_2_ft_intl(ngrid_l,i_fft_l)

  implicit none
  integer, intent(in) :: ngrid_l
  integer, intent(inout) :: i_fft_l

  integer :: i_do,j_do,i_temp,j_temp,ier
  integer, allocatable :: n(:)

  allocate(n(4),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_fft'
     stop
  end if

  n(1)=7
  n(2)=5
  n(3)=3
  n(4)=2

  i_temp=ngrid_l
  i_fft_l=1
  j_temp=1
  do j_do=1,ngrid_l
     do i_do=1,4
        if( mod(i_temp,n(i_do)) == 0 ) then
           if( i_fft_l > j_temp ) then
              j_temp=j_temp*n(i_do)
           else
              i_fft_l=i_fft_l*n(i_do)
           end if
           i_temp=i_temp/n(i_do)
           exit
        end if
     end do
     if( i_temp == 1 ) then
        exit
     end if
  end do

  deallocate(n,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_fft'
     stop
  end if

  return
end subroutine set_f_2_ft_intl

subroutine interpo_r(v_tot_r_int,vh_temp_r_int,den_r_int)

  use scf_negf
  use fft
  use dft
  use hamiltonian_sgf
  use hamiltonian_c
  use gf_se_c
  use constant
  use condition_ini

  implicit none
  real(8), intent(inout) :: v_tot_r_int(n_a*n_b*n_c_r,ispin_pol_scf)
  real(8), intent(inout) :: vh_temp_r_int(n_a*n_b*n_c_r)
  complex(8), intent(inout) :: den_r_int(n_a*n_b*n_c_r,ispin_pol_scf)

  real(8), allocatable :: temp_forier(:),temp_forier1(:)

  integer :: i1,i2,i3,m1,m2,gn,i_do,ier,i1_fft_r,i2_fft_r,ispin
  real(8) :: r1,gx
  complex(8) :: temp_r

  pai=datan(1.d0)*4.d0

  if( ft_switch == 'f_2_ft' ) then
     call set_f_2_ft_intr(n_a_r,i1_fft_r)
     call set_f_2_ft_intr(n_b_r,i2_fft_r)
  end if

  allocate(temp_forier(n_a*n_b_r),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: cal_hamiltonian'
     stop
  end if
  if( ispin_pol_scf == 4 ) then
     allocate(temp_forier1(n_a*n_b_r),stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do i3=0,n_c_r-1
        call alo_fft_zz(n_a_r)
        do i2=0,n_b_r-1
           do i1=0,n_a_r-1
              fft3(i1+1)                                                           &
                   =dcmplx(vh_temp_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1),0.d0)
           end do
           if( ft_switch == 'f_2_ft' ) then
              call made_fourier(fft3,wzn,n_a_r,i1_fft_r)
           else
              call made_fourier_arb(fft3,wzn,n_a_r)
           end if
           do i_do=0,n_a-1
              gn=i_do*n_b_r+i2+1
              r1=dfloat(i_do*n_a_r)/dfloat(n_a)                                    &
                   +dfloat(n_a_r)/dfloat(2*n_a)-0.5d0
              temp_r=dcmplx(0.d0,0.d0)
              do i1=0,n_a_r-1
                 if( i1 < n_a_r/2 ) then
                    m1=i1
                 else
                    m1=i1-n_a_r
                 end if
                 gx=dfloat(m1)*2.d0*pai/dfloat(n_a_r)
                 temp_r=temp_r+fft3(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              temp_forier(gn)=dreal(temp_r)/dfloat(n_a_r)
           end do
        end do
        call unset_fft_zz
        call alo_fft_zz(n_b_r)
        do i1=0,n_a-1
           do i2=0,n_b_r-1
              gn=i1*n_b_r+i2+1
              fft3(i2+1)=dcmplx(temp_forier(gn),0.d0)
           end do
           if( ft_switch == 'f_2_ft' ) then
              call made_fourier(fft3,wzn,n_b_r,i2_fft_r)
           else
              call made_fourier_arb(fft3,wzn,n_b_r)
           end if
           do i_do=0,n_b-1
              r1=dfloat(i_do*n_b_r)/dfloat(n_b)                                    &
                   +dfloat(n_b_r)/dfloat(2*n_b)-0.5d0
              temp_r=dcmplx(0.d0,0.d0)
              do i2=0,n_b_r-1
                 if( i2 < n_b_r/2 ) then
                    m2=i2
                 else
                    m2=i2-n_b_r
                 end if
                 gx=dfloat(m2)*2.d0*pai/dfloat(n_b_r)
                 temp_r=temp_r+fft3(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              gn=i1*n_b*n_c_r+i_do*n_c_r+i3+1
              vh_temp_r_int(gn)=dreal(temp_r)/dfloat(n_b_r)
           end do
        end do
        call unset_fft_zz
     end do
  else
     do i3=0,n_c_r-1
        call alo_dft_z(n_a_r)
        do i2=0,n_b_r-1
           do i1=0,n_a_r-1
              r_tem_z(1,i1+1)=dfloat(i1)
              p_tem_z(1,i1+1)=dfloat(i1)*2.d0*pai/dfloat(n_a_r)
              fft_in_z(i1+1)                                                       &
                   =dcmplx(vh_temp_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1),0.d0)
           end do
           call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_a_r,1,1)
           do i_do=0,n_a-1
              gn=i_do*n_b_r+i2+1
              r1=dfloat(i_do*n_a_r)/dfloat(n_a)                                    &
                   +dfloat(n_a_r)/dfloat(2*n_a)-0.5d0
              temp_r=dcmplx(0.d0,0.d0)
              do i1=0,n_a_r-1
                 if( i1 < n_a_r/2 ) then
                    m1=i1
                 else
                    m1=i1-n_a_r
                 end if
                 gx=dfloat(m1)*2.d0*pai/dfloat(n_a_r)
                 temp_r=temp_r+fft_out_z(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              temp_forier(gn)=dreal(temp_r)/dfloat(n_a_r)
           end do
        end do
        call unset_dft_z
        call alo_dft_z(n_b_r)
        do i1=0,n_a-1
           do i2=0,n_b_r-1
              r_tem_z(1,i2+1)=dfloat(i2)
              p_tem_z(1,i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b_r)
              gn=i_do*n_b_r+i2+1
              fft_in_z(i2+1)=dcmplx(temp_forier(gn),0.d0)
           end do
           call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_b_r,1,1)
           do i_do=0,n_b-1
              r1=dfloat(i_do*n_b_r)/dfloat(n_b)                                    &
                   +dfloat(n_b_r)/dfloat(2*n_b)-0.5d0
              temp_r=dcmplx(0.d0,0.d0)
              do i2=0,n_b_r-1
                 if( i2 < n_b_r/2 ) then
                    m2=i2
                 else
                    m2=i2-n_b_r
                 end if
                 gx=dfloat(m2)*2.d0*pai/dfloat(n_b_r)
                 temp_r=temp_r+fft_out_z(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
              end do
              gn=i1*n_b*n_c_r+i_do*n_c_r+i3+1
              vh_temp_r_int(gn)=dreal(temp_r)/dfloat(n_b_r)
           end do
        end do
        call unset_dft_z
     end do
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_r-1
           call alo_fft_zz(n_a_r)
           do i2=0,n_b_r-1
              do i1=0,n_a_r-1
                 fft3(i1+1)                                                         &
                      =dcmplx(v_tot_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1,ispin),0.d0)
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_a_r,i1_fft_r)
              else
                 call made_fourier_arb(fft3,wzn,n_a_r)
              end if
              do i_do=0,n_a-1
                 gn=i_do*n_b_r+i2+1
                 r1=dfloat(i_do*n_a_r)/dfloat(n_a)                                  &
                      +dfloat(n_a_r)/dfloat(2*n_a)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_r-1
                    if( i1 < n_a_r/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_r
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_r)
                    temp_r=temp_r+fft3(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_r)/dfloat(n_a_r)
              end do
           end do
           call unset_fft_zz
           call alo_fft_zz(n_b_r)
           do i1=0,n_a-1
              do i2=0,n_b_r-1
                 gn=i1*n_b_r+i2+1
                 fft3(i2+1)=dcmplx(temp_forier(gn),0.d0)
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_b_r,i2_fft_r)
              else
                 call made_fourier_arb(fft3,wzn,n_b_r)
              end if
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_r)/dfloat(n_b)                                  &
                      +dfloat(n_b_r)/dfloat(2*n_b)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_r-1
                    if( i2 < n_b_r/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_r
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_r)
                    temp_r=temp_r+fft3(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_r+i_do*n_c_r+i3+1
                 v_tot_r_int(gn,ispin)=dreal(temp_r)/dfloat(n_b_r)
              end do
           end do
           call unset_fft_zz
        end do
     end do
  else
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_r-1
           call alo_dft_z(n_a_r)
           do i2=0,n_b_r-1
              do i1=0,n_a_r-1
                 r_tem_z(1,i1+1)=dfloat(i1)
                 p_tem_z(1,i1+1)=dfloat(i1)*2.d0*pai/dfloat(n_a_r)
                 fft_in_z(i1+1)                                                     &
                      =dcmplx(v_tot_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1,ispin),0.d0)
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_a_r,1,1)
              do i_do=0,n_a-1
                 gn=i_do*n_b_r+i2+1
                 r1=dfloat(i_do*n_a_r)/dfloat(n_a)                                  &
                      +dfloat(n_a_r)/dfloat(2*n_a)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_r-1
                    if( i1 < n_a_r/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_r
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_r)
                    temp_r=temp_r+fft_out_z(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_r)/dfloat(n_a_r)
              end do
           end do
           call unset_dft_z
           call alo_dft_z(n_b_r)
           do i1=0,n_a-1
              do i2=0,n_b_r-1
                 r_tem_z(1,i2+1)=dfloat(i2)
                 p_tem_z(1,i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b_r)
                 gn=i_do*n_b_r+i2+1
                 fft_in_z(i2+1)=dcmplx(temp_forier(gn),0.d0)
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_b_r,1,1)
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_r)/dfloat(n_b)                                  &
                      +dfloat(n_b_r)/dfloat(2*n_b)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_r-1
                    if( i2 < n_b_r/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_r
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_r)
                    temp_r=temp_r+fft_out_z(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_r+i_do*n_c_r+i3+1
                 v_tot_r_int(gn,ispin)=dreal(temp_r)/dfloat(n_b_r)
              end do
           end do
           call unset_dft_z
        end do
     end do
  end if

  !                       ------------------------------------                       !

  if( ft_switch == 'f_2_ft' .or. ft_switch == 'fft' ) then
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_r-1
           call alo_fft_zz(n_a_r)
           do i2=0,n_b_r-1
              do i1=0,n_a_r-1
                 if( ispin_pol_scf < 4 ) then
                    fft3(i1+1)                                                       &
                         =dcmplx(den_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1,ispin),0.d0)
                 else
                    fft3(i1+1)=denls_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1,ispin)
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_a_r,i1_fft_r)
              else
                 call made_fourier_arb(fft3,wzn,n_a_r)
              end if
              do i_do=0,n_a-1
                 gn=i_do*n_b_r+i2+1
                 r1=dfloat(i_do*n_a_r)/dfloat(n_a)                                  &
                      +dfloat(n_a_r)/dfloat(2*n_a)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_r-1
                    if( i1 < n_a_r/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_r
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_r)
                    temp_r=temp_r+fft3(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_r)/dfloat(n_a_r)
                 if( ispin_pol_scf == 4 ) then
                    temp_forier1(gn)=dimag(temp_r)/dfloat(n_a_r)
                 end if
              end do
           end do
           call unset_fft_zz
           call alo_fft_zz(n_b_r)
           do i1=0,n_a-1
              do i2=0,n_b_r-1
                 gn=i1*n_b_r+i2+1
                 if( ispin_pol_scf < 4 ) then
                    fft3(i2+1)=dcmplx(temp_forier(gn),0.d0)
                 else
                    fft3(i2+1)=dcmplx(temp_forier(gn),temp_forier1(gn))
                 end if
              end do
              if( ft_switch == 'f_2_ft' ) then
                 call made_fourier(fft3,wzn,n_b_r,i2_fft_r)
              else
                 call made_fourier_arb(fft3,wzn,n_b_r)
              end if
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_r)/dfloat(n_b)                                  &
                      +dfloat(n_b_r)/dfloat(2*n_b)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_r-1
                    if( i2 < n_b_r/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_r
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_r)
                    temp_r=temp_r+fft3(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_r+i_do*n_c_r+i3+1
                 if( ispin_pol_scf < 4 ) then
                    den_r_int(gn,ispin)=dcmplx(dreal(temp_r)/dfloat(n_b_r),0.d0)
                 else
                    den_r_int(gn,ispin)=temp_r/dfloat(n_b_r)
                 end if
              end do
           end do
           call unset_fft_zz
        end do
     end do
  else
     do ispin=1,ispin_pol_scf
        do i3=0,n_c_r-1
           call alo_dft_z(n_a_r)
           do i2=0,n_b_r-1
              do i1=0,n_a_r-1
                 r_tem_z(1,i1+1)=dfloat(i1)
                 p_tem_z(1,i1+1)=dfloat(i1)*2.d0*pai/dfloat(n_a_r)
                 if( ispin_pol_scf < 4 ) then
                    fft_in_z(i1+1)                                                   &
                         =dcmplx(den_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1,ispin),0.d0)
                 else
                    fft_in_z(i1+1)=denls_r(i1*n_b_r*n_c_r+i2*n_c_r+i3+1,ispin)
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_a_r,1,1)
              do i_do=0,n_a-1
                 gn=i_do*n_b_r+i2+1
                 r1=dfloat(i_do*n_a_r)/dfloat(n_a)                                  &
                      +dfloat(n_a_r)/dfloat(2*n_a)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i1=0,n_a_r-1
                    if( i1 < n_a_r/2 ) then
                       m1=i1
                    else
                       m1=i1-n_a_r
                    end if
                    gx=dfloat(m1)*2.d0*pai/dfloat(n_a_r)
                    temp_r=temp_r+fft_out_z(i1+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 temp_forier(gn)=dreal(temp_r)/dfloat(n_a_r)
                 if( ispin_pol_scf == 4 ) then
                    temp_forier1(gn)=dimag(temp_r)/dfloat(n_a_r)
                 end if
              end do
           end do
           call unset_dft_z
           call alo_dft_z(n_b_r)
           do i1=0,n_a-1
              do i2=0,n_b_r-1
                 r_tem_z(1,i2+1)=dfloat(i2)
                 p_tem_z(1,i2+1)=dfloat(i2)*2.d0*pai/dfloat(n_b_r)
                 gn=i_do*n_b_r+i2+1
                 if( ispin_pol_scf < 4 ) then
                    fft_in_z(i2+1)=dcmplx(temp_forier(gn),0.d0)
                 else
                    fft_in_z(i2+1)=dcmplx(temp_forier(gn),temp_forier1(gn))
                 end if
              end do
              call made_dft(fft_in_z,fft_out_z,r_tem_z,p_tem_z,n_b_r,1,1)
              do i_do=0,n_b-1
                 r1=dfloat(i_do*n_b_r)/dfloat(n_b)                                  &
                      +dfloat(n_b_r)/dfloat(2*n_b)-0.5d0
                 temp_r=dcmplx(0.d0,0.d0)
                 do i2=0,n_b_r-1
                    if( i2 < n_b_r/2 ) then
                       m2=i2
                    else
                       m2=i2-n_b_r
                    end if
                    gx=dfloat(m2)*2.d0*pai/dfloat(n_b_r)
                    temp_r=temp_r+fft_out_z(i2+1)*dcmplx(dcos(gx*r1),-dsin(gx*r1))
                 end do
                 gn=i1*n_b*n_c_r+i_do*n_c_r+i3+1
                 if( ispin_pol_scf < 4 ) then
                    den_r_int(gn,ispin)=dcmplx(dreal(temp_r)/dfloat(n_b_r),0.d0)
                 else
                    den_r_int(gn,ispin)=temp_r/dfloat(n_b_r)
                 end if
              end do
           end do
           call unset_dft_z
        end do
     end do
  end if

  !                       ------------------------------------                       !

  deallocate(temp_forier,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: cal_hamiltonian'
     stop
  end if
  if( ispin_pol_scf == 4 ) then
     deallocate(temp_forier1,stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: cal_hamiltonian'
        stop
     end if
  end if

  return
end subroutine interpo_r

subroutine set_f_2_ft_intr(ngrid_r,i_fft_r)

  implicit none
  integer, intent(in) :: ngrid_r
  integer, intent(inout) :: i_fft_r

  integer :: i_do,j_do,i_temp,j_temp,ier
  integer, allocatable :: n(:)

  allocate(n(4),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_fft'
     stop
  end if

  n(1)=7
  n(2)=5
  n(3)=3
  n(4)=2

  i_temp=ngrid_r
  i_fft_r=1
  j_temp=1
  do j_do=1,ngrid_r
     do i_do=1,4
        if( mod(i_temp,n(i_do)) == 0 ) then
           if( i_fft_r > j_temp ) then
              j_temp=j_temp*n(i_do)
           else
              i_fft_r=i_fft_r*n(i_do)
           end if
           i_temp=i_temp/n(i_do)
           exit
        end if
     end do
     if( i_temp == 1 ) then
        exit
     end if
  end do

  deallocate(n,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_fft'
     stop
  end if

  return
end subroutine set_f_2_ft_intr
