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

subroutine cal_iv

  use condition_ini
  use hamiltonian_sgf
  use gf_se_c
  use hamiltonian_c
  use constant

  implicit none
  integer :: iw_do,ispin,kt,i_spin_c
  complex(8) :: current1
  complex(8) :: current2
  complex(8) :: current3

  if( spin_switch_cc == 2 ) then
     i_spin_c=2
  else
     i_spin_c=1
  end if

  current1=dcmplx(0.d0,0.d0)
  current2=dcmplx(0.d0,0.d0)
  current3=dcmplx(0.d0,0.d0)
  do kt=1,ka_tr*kb_tr
     do ispin=1,i_spin_c
        do iw_do=1,num_iv_mesh
           current1=current1+tr_tr(ispin,iw_do,kt)
        end do
        do iw_do=2,num_iv_mesh,2
           current2=current2+tr_tr(ispin,iw_do,kt)
        end do
        do iw_do=1,num_iv_mesh-1,2
           current3=current3+tr_tr(ispin,iw_do,kt)
        end do
     end do
  end do
  current1=(e/h)*current1*(cp_l-cp_r)/dfloat(num_iv_mesh*ka_tr*kb_tr)
  current2=(e/h)*current2*(cp_l-cp_r)/dfloat(num_iv_mesh/2*ka_tr*kb_tr)
  current3=(e/h)*current3*(cp_l-cp_r)/dfloat(num_iv_mesh/2*ka_tr*kb_tr)
  if( spin_switch_cc == 1 ) then
     current1=current1+current1
     current2=current2+current2
     current3=current3+current3
  end if

  open(unit=30,file='iv.dat')
  write(30,*) 'V     real     imag'
  write(30,*) cp_l-cp_r,dreal(current1),dimag(current1)
  write(30,*)
  write(30,*) 'half mesh'
  write(30,*) cp_l-cp_r,dreal(current2),dimag(current2)
  write(30,*) cp_l-cp_r,dreal(current3),dimag(current3)
  close(30)

end subroutine cal_iv
