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

  use scf_negf
  use constant
  use mod_mpi

  implicit none
  integer :: i1_do,i2_do,i3_do,i_temp
  real(8) :: temp,v_temp_a(3),v_temp_b(3)

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

  kt_num=ka_scf*kb_scf

  call alo_scf_negf_kpoint

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

  temp=cell_labc(1,2)*cell_labc(2,3)-cell_labc(1,3)*cell_labc(2,2)
  temp=2.d0*pai/temp

  v_temp_a(1)= 0.d0
  v_temp_a(2)= cell_labc(2,3)*temp
  v_temp_a(3)=-cell_labc(2,2)*temp
  v_temp_b(1)= 0.d0
  v_temp_b(2)=-cell_labc(1,3)*temp
  v_temp_b(3)= cell_labc(1,2)*temp

  i_temp=(ka_scf-mod(ka_scf,2))/2
  i_temp=0
  do i1_do=1,ka_scf
     po_ka_scf(1,i1_do)=0.d0
     po_ka_scf(2,i1_do)=v_temp_a(2)                                             &
          *.5d0*dfloat(2*(i1_do+i_temp)-ka_scf-1)/dfloat(ka_scf)
     po_ka_scf(3,i1_do)=v_temp_a(3)                                             &
          *.5d0*dfloat(2*(i1_do+i_temp)-ka_scf-1)/dfloat(ka_scf)
  end do
  i_temp=(kb_scf-mod(kb_scf,2))/2
  i_temp=0
  do i1_do=1,kb_scf
     po_kb_scf(1,i1_do)=0.d0
     po_kb_scf(2,i1_do)=v_temp_b(2)                                             &
          *.5d0*dfloat(2*(i1_do+i_temp)-kb_scf-1)/dfloat(kb_scf)
     po_kb_scf(3,i1_do)=v_temp_b(3)                                             &
          *.5d0*dfloat(2*(i1_do+i_temp)-kb_scf-1)/dfloat(kb_scf)
  end do

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

  open(unit=16,file=file_tempout,position='append')
  write(16,*)
  write(16,*) '--------------------------------------------------------------'
  write(16,998) ka_scf,kb_scf
998 format('------------   K-sampling (SCF):',2i4)
  write(16,*) '--------------------------------------------------------------'
  i_temp=0
  do i1_do=1,ka_scf
     do i2_do=1,kb_scf
        i_temp=i_temp+1
        po_kt_scf(1,i_temp)=0.d0
        po_kt_scf(2,i_temp)=po_ka_scf(2,i1_do)+po_kb_scf(2,i2_do)
        po_kt_scf(3,i_temp)=po_ka_scf(3,i1_do)+po_kb_scf(3,i2_do)

        if( ispin_pol_scf < 4 ) then
           temp=po_kt_scf(2,i_temp)**2+po_kt_scf(3,i_temp)**2
           if( dabs(temp) > 1.d-14 ) then
              ksw_po_kt_scf(i_temp)=2
              do i3_do=1,i_temp-1
                 temp=(po_kt_scf(2,i_temp)+po_kt_scf(2,i3_do))**2                   &
                      +(po_kt_scf(3,i_temp)+po_kt_scf(3,i3_do))**2
                 if( dabs(temp) < 1.d-14 ) then
                    ksw_po_kt_scf(i_temp)=0
                    exit
                 end if
              end do
           else
              ksw_po_kt_scf(i_temp)=1
           end if
        else
           ksw_po_kt_scf(i_temp)=1
        end if

        write(16,999) i_temp,ksw_po_kt_scf(i_temp)                             &
             ,po_kt_scf(2,i_temp),po_kt_scf(3,i_temp)
     end do
  end do
  write(16,*) '--------------------------------------------------------------'
999 format(i5,i4,d23.13,d25.13)
  close(16)

  return
end subroutine make_scf_ksampling_scf

subroutine set_ksampling_tr
  use condition_ini
  use hamiltonian_temp
  use gf_se_c
  use constant

  implicit none
  integer :: i1_do,i2_do,i_temp
  real(8) :: temp,v_temp_a(3),v_temp_b(3)

  if( filename_kpoint /= '' ) then
     open(unit=90,file=filename_kpoint)
     read(90,*) ka_tr
     kb_tr=1
     kt_tr=ka_tr*kb_tr
     call alo_tr_negf_kpoint(ka_tr,kb_tr)
     do i1_do=1,ka_tr
        po_kt_tr(1,i1_do)=0.d0
        read(90,*) i2_do,po_kt_tr(2,i1_do),po_kt_tr(3,i1_do)
     end do
     close(90)
  end if

  pai=datan(1.d0)*4.d0
  kt_tr=ka_tr*kb_tr
  call alo_tr_negf_kpoint(ka_tr,kb_tr)

  temp=cell_tempabc(1,2)*cell_tempabc(2,3)-cell_tempabc(1,3)*cell_tempabc(2,2)
  temp=2.d0*pai/temp

  v_temp_a(1)= 0.d0
  v_temp_a(2)= cell_tempabc(2,3)*temp
  v_temp_a(3)=-cell_tempabc(2,2)*temp
  v_temp_b(1)= 0.d0
  v_temp_b(2)=-cell_tempabc(1,3)*temp
  v_temp_b(3)= cell_tempabc(1,2)*temp

  i_temp=(ka_tr-mod(ka_tr,2))/2
  do i1_do=1,ka_tr
     po_ka_tr(1,i1_do)=0.d0
     po_ka_tr(2,i1_do)                                                        &
          =v_temp_a(2)*.5d0*dfloat(2*(i1_do+i_temp)-ka_tr-1)/dfloat(ka_tr)
     po_ka_tr(3,i1_do)                                                        &
          =v_temp_a(3)*.5d0*dfloat(2*(i1_do+i_temp)-ka_tr-1)/dfloat(ka_tr)
  end do
  i_temp=(kb_tr-mod(kb_tr,2))/2
  do i1_do=1,kb_tr
     po_kb_tr(1,i1_do)=0.d0
     po_kb_tr(2,i1_do)                                                        &
          =v_temp_b(2)*.5d0*dfloat(2*(i1_do+i_temp)-kb_tr-1)/dfloat(kb_tr)
     po_kb_tr(3,i1_do)                                                        &
          =v_temp_b(3)*.5d0*dfloat(2*(i1_do+i_temp)-kb_tr-1)/dfloat(kb_tr)
  end do

  i_temp=0
  do i1_do=1,ka_tr
     do i2_do=1,kb_tr
        i_temp=i_temp+1
        po_kt_tr(1,i_temp)=0.d0
        po_kt_tr(2,i_temp)=po_ka_tr(2,i1_do)+po_kb_tr(2,i2_do)
        po_kt_tr(3,i_temp)=po_ka_tr(3,i1_do)+po_kb_tr(3,i2_do)
     end do
  end do

  do i_temp=ka_tr*kb_tr,1,-1
     po_kt_tr(1,i_temp)=po_kt_tr(1,i_temp)-po_kt_tr(1,1)
     po_kt_tr(2,i_temp)=po_kt_tr(2,i_temp)-po_kt_tr(2,1)
     po_kt_tr(3,i_temp)=po_kt_tr(3,i_temp)-po_kt_tr(3,1)
  end do

  return
end subroutine set_ksampling_tr

subroutine show_ksampling
  use condition_ini
  use hamiltonian_temp
  use gf_se_c
  use mod_mpi

  implicit none
  integer :: i1_do

  if( ham_model_ini /= 'rtb_h' .and. ham_model_ini /= 'gsp' ) then

     open(unit=16,file=file_tempout,position='append')
     write(16,*)                                                              &
          '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     if( filename_kpoint /= '' ) then
        write(16,997) ka_tr
     else
        write(16,998) ka_tr,kb_tr
     end if
     do i1_do=1,ka_tr*kb_tr
        write(16,999) i1_do,po_kt_tr(2,i1_do),po_kt_tr(3,i1_do)
     end do
     write(16,*)                                                              &
          '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
997  format(' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>    K-sampling :      ',i6,' <<')
998  format(' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>    K-sampling :',2i6,' <<')
999  format(' >>  ',i5,d25.15,d25.15,' <<')
     close(16)

  end if

  return
end subroutine show_ksampling
