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

subroutine set_hamiltonian_zper(descZZ,kx,ky,kz,ispin)
  use condition
  use hamiltonian_zper
  use ac_mpi_module
  implicit none

  type(MPI_MatDesc), intent(in) :: descZZ
  integer, intent(in) :: kx,ky,kz,ispin
  integer :: i1_do,i2_do


  h00_mat(:,:) = dcmplx(0.d0,0.d0) 
  s00_mat(:,:) = dcmplx(0.d0,0.d0) 

  if( ham_model == 'input' .or. ham_model == 'scf_accel' ) then
     if( lr_switch == -1 ) then
        call set_hamiltonian_zper_input_l(descZZ,kz,ispin)
     end if
     if( lr_switch == 1 ) then
        call set_hamiltonian_zper_input_r(descZZ,kz,ispin)
     end if
  else
     if( p_or_f == 'free' ) then
        call set_hamiltonian_zper_free(descZZ,kz)
     else
        if( p_or_f == 'periodic' ) then
           call set_hamiltonian_zper_periodic(descZZ,kx,ky,kz)
        else
           write(6,*) 'error: set_hamiltonian_zper'
           stop
        end if
     end if
  end if

  return
end subroutine set_hamiltonian_zper

subroutine alo_hamiltonian_zper(descZZ)
  use condition
  use hamiltonian_zper
  use ac_mpi_module
  implicit none

  type(MPI_MatDesc), intent(in) :: descZZ

  mat_max_zper=mat_max_eigen

  if( ham_model == 'input' .or. ham_model == 'scf_accel' ) then
     call alo_hamiltonian_zper_input(descZZ)
  else
     if( p_or_f == 'free' ) then
        call alo_hamiltonian_zper_free(descZZ,num_atom,num_unit)
     end if
     if( p_or_f == 'periodic' .or.  p_or_f == 'periodic-1d' ) then
        call alo_hamiltonian_zper_periodic(descZZ,num_atom)
     end if
  end if

  return
end subroutine alo_hamiltonian_zper

subroutine unset_hamiltonian_zper

  use condition
  use hamiltonian_zper

  if( ham_model == 'input' .or. ham_model == 'scf_accel' ) then
     call unset_hamiltonian_zper_input
  else
     if( p_or_f == 'free' ) then
        call unset_hamiltonian_zper_free
     end if
     if( p_or_f == 'periodic' .or.  p_or_f == 'periodic-1d' ) then
        call unset_hamiltonian_zper_periodic
     end if
  end if

  return
end subroutine unset_hamiltonian_zper

subroutine set_hamiltonian_zper_input_l(descZZ,qz,ispin)
  use condition
  use hamiltonian_zper
  use hamiltonian_temp
  use scf_negf
  use ac_mpi_module

  implicit none

  type(MPI_MatDesc), intent(in) :: descZZ
  integer, intent(in) :: qz,ispin

  integer :: kz,iz,i2_do,i3_do
  real(8) :: cs,sn,pai

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


  kz=qz
  iz=1
  cs=dcos(2.d0*pai*(dfloat((kz-1)*iz)/dfloat(kz_max)))
  sn=dsin(2.d0*pai*(dfloat((kz-1)*iz)/dfloat(kz_max)))

  h00_mat(:,:) = h00_mat(:,:) + h00_l_t(:,:,ispin) 
  h00_mat(:,:) = h00_mat(:,:) + h01_l_t(:,:,ispin)*dcmplx(cs,-sn) 
  h00_mat(:,:) = h00_mat(:,:) + h10_l_t(:,:,ispin)*dcmplx(cs,+sn) 

  s00_mat(:,:) = s00_mat(:,:) + s00_l_t(:,:) 
  s00_mat(:,:) = s00_mat(:,:) + s01_l_t(:,:)*dcmplx(cs,-sn) 
  s00_mat(:,:) = s00_mat(:,:) + s10_l_t(:,:)*dcmplx(cs,+sn) 

  return
end subroutine set_hamiltonian_zper_input_l

subroutine set_hamiltonian_zper_input_r(descZZ,qz,ispin)
  use condition
  use hamiltonian_zper
  use hamiltonian_temp
  use scf_negf
  use ac_mpi_module

  implicit none
  type(MPI_MatDesc), intent(in) :: descZZ
  integer, intent(in) :: qz,ispin

  integer :: kz,iz,i2_do,i3_do
  real(8) :: cs,sn,pai

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


  kz=qz
  iz=1
  cs=dcos(2.d0*pai*(dfloat((kz-1)*iz)/dfloat(kz_max)))
  sn=dsin(2.d0*pai*(dfloat((kz-1)*iz)/dfloat(kz_max)))

  h00_mat(:,:) = h00_mat(:,:) + h00_r_t(:,:,ispin) 
  h00_mat(:,:) = h00_mat(:,:) + h01_r_t(:,:,ispin)*dcmplx(cs,+sn) 
  h00_mat(:,:) = h00_mat(:,:) + h10_r_t(:,:,ispin)*dcmplx(cs,-sn) 

  s00_mat(:,:) = s00_mat(:,:) + s00_r_t(:,:) 
  s00_mat(:,:) = s00_mat(:,:) + s01_r_t(:,:)*dcmplx(cs,+sn) 
  s00_mat(:,:) = s00_mat(:,:) + s10_r_t(:,:)*dcmplx(cs,-sn) 

  return
end subroutine set_hamiltonian_zper_input_r

subroutine set_hamiltonian_zper_free(descZZ,qz)
  use condition
  use hamiltonian_zper
  use ac_mpi_module

  implicit none
  type(MPI_MatDesc), intent(in) :: descZZ
  integer, intent(in) :: qz

  integer :: max_atom_orbital
  integer :: kx,ky,kz,lx,ly,iz
  integer :: i1_do,i2_do,i3_do,i4_do,i1_count,i2_count,ier
  real(8) :: cs,sn,pai
  complex(8), allocatable :: h_ijmn(:,:),s_ijmn(:,:)
  integer :: i, j

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

  mat_max_zper=mat_max_eigen

  max_atom_orbital=0
  do i1_do=1,num_atom_kind
     if( max_atom_orbital < atom_orbital(i1_do) ) then
        max_atom_orbital=atom_orbital(i1_do)
     end if
  end do

  allocate(h_ijmn(max_atom_orbital,max_atom_orbital)                           &
       ,s_ijmn(max_atom_orbital,max_atom_orbital),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_hamiltonian_zper_free'
     stop
  end if


  i1_count=0
  do kx=1,num_unit(1)
     do ky=1,num_unit(2)
        do i1_do=1,num_atom
           itemp(kx,ky,i1_do)=i1_count
           i1_count=i1_count+atom_orbital(atom_kindn(i1_do))
        end do
     end do
  end do

  kz=qz
  do kx=0,num_unit(1)-1
     do ky=0,num_unit(2)-1
        do i1_do=1,num_atom
           i1_count=itemp(kx+1,ky+1,i1_do)
           do iz=-neighbor_z_max,neighbor_z_max
              do lx=0,num_unit(1)-1
                 do ly=0,num_unit(2)-1
                    do i2_do=1,num_atom
                       i2_count=itemp(lx+1,ly+1,i2_do)
                       if( i1_count == i2_count .and. iz == 0 ) then
                          if( ham_model .eq. 'gsp' ) then
                             call onsite_gsp_hamiltonian(max_atom_orbital,i1_do,i2_do,h_ijmn,s_ijmn)
                          else
                             if( ham_model .eq. 'rtb_h' ) then
                                call onsite_rtbh_hamiltonian(max_atom_orbital,i1_do,h_ijmn,s_ijmn)
                             else
                                write(6,*) 'error - ham_model: set_hamiltonian_zper 1'
                                stop
                             end if
                          end if
                          cs=1.d0
                          sn=0.d0
                       else
                          if( ham_model .eq. 'gsp' ) then
                             call off_gsp_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do        &
                                  ,max_atom_orbital,h_ijmn,s_ijmn)
                          else
                             if( ham_model .eq. 'rtb_h' ) then
                                call off_rtbh_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do     &
                                     ,max_atom_orbital,h_ijmn,s_ijmn)
                             else
                                write(6,*) 'error - ham_model: set_hamiltonian_zper 2'
                                stop
                             end if
                          end if
                          cs=dcos(2.d0*pai*(dfloat((kz-1)*iz)/dfloat(kz_max)))
                          sn=dsin(2.d0*pai*(dfloat((kz-1)*iz)/dfloat(kz_max)))
                       end if
                       do i4_do=1,atom_orbital(atom_kindn(i2_do))
                          do i3_do=1,atom_orbital(atom_kindn(i1_do))
                             i = i1_count+i3_do
                             j = i2_count+i4_do

                             if( i<descZZ%srow .or. descZZ%erow<i ) cycle
                             if( j<descZZ%scol .or. descZZ%ecol<j ) cycle
                             h00_mat(i,j) = h00_mat(i,j) + h_ijmn(i3_do,i4_do)*dcmplx(cs,sn) 
                             s00_mat(i,j) = s00_mat(i,j) + s_ijmn(i3_do,i4_do)*dcmplx(cs,sn) 
                          end do
                       end do
                    end do
                 end do
              end do
           end do
        end do
     end do
  end do


  deallocate(h_ijmn,s_ijmn,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: set_hamiltonian_zper_free'
     stop
  end if

  return
end subroutine set_hamiltonian_zper_free

subroutine set_hamiltonian_zper_periodic(descZZ,qx,qy,qz)
  use condition
  use hamiltonian_zper
  use ac_mpi_module

  implicit none
  type(MPI_MatDesc), intent(in) :: descZZ
  integer, intent(in) :: qx,qy,qz
  integer :: max_atom_orbital
  integer :: kx,ky,kz,lx,ly,iz
  integer :: i1_do,i2_do,i3_do,i4_do,i1_count,i2_count,ier
  real(8) :: pai,cs,sn
  complex(8), allocatable :: h_ijmn(:,:),s_ijmn(:,:)
  integer :: i, j

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

  mat_max_zper=mat_max_eigen

  max_atom_orbital=0
  do i1_do=1,num_atom_kind
     if( max_atom_orbital < atom_orbital(i1_do) ) then
        max_atom_orbital=atom_orbital(i1_do)
     end if
  end do

  allocate(h_ijmn(max_atom_orbital,max_atom_orbital)                           &
       ,s_ijmn(max_atom_orbital,max_atom_orbital),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_hamiltonian_zper_periodic'
     stop
  end if


  i1_count=0
  do i1_do=1,num_atom
     jtemp(i1_do)=i1_count
     i1_count=i1_count+atom_orbital(atom_kindn(i1_do))
  end do

  kx=qx
  ky=qy
  kz=qz
  do i1_do=1,num_atom
     i1_count=jtemp(i1_do)
     do lx=-neighbor_x_max,neighbor_x_max
        do ly=-neighbor_y_max,neighbor_y_max
           do iz=-neighbor_z_max,neighbor_z_max
              do i2_do=1,num_atom
                 i2_count=jtemp(i2_do)
                 if( i1_do == i2_do .and. lx == 0 .and. ly == 0 .and. iz == 0 ) then
                    if( ham_model .eq. 'gsp' ) then
                       call onsite_gsp_hamiltonian(max_atom_orbital,i1_do             &
                            ,i2_do,h_ijmn,s_ijmn)
                    else
                       if( ham_model .eq. 'rtb_h' ) then
                          call onsite_rtbh_hamiltonian(max_atom_orbital,i1_do          &
                               ,h_ijmn,s_ijmn)
                       else
                          write(6,*)                                                   &
                               'error - ham_model: set_hamiltonian_zper_periodic 1'
                          stop
                       end if
                    end if
                    cs=1.d0
                    sn=0.d0
                 else
                    if( ham_model .eq. 'gsp' ) then
                       call off_gsp_hamiltonian(iz,lx,ly,0,0,i1_do,i2_do              &
                            ,max_atom_orbital,h_ijmn,s_ijmn)
                    else
                       if( ham_model .eq. 'rtb_h' ) then
                          call off_rtbh_hamiltonian(iz,lx,ly,0,0,i1_do,i2_do           &
                               ,max_atom_orbital,h_ijmn,s_ijmn)
                       else
                          write(6,*)                                                   &
                               'error - ham_model: set_hamiltonian_zper_periodic 2'
                          stop
                       end if
                    end if
                    cs=dcos(2.d0*pai*(dfloat((kx-1)*lx)/dfloat(kx_max)               &
                         +dfloat((ky-1)*ly)/dfloat(ky_max)               &
                         +dfloat((kz-1)*iz)/dfloat(kz_max)))
                    sn=dsin(2.d0*pai*(dfloat((kx-1)*lx)/dfloat(kx_max)               &
                         +dfloat((ky-1)*ly)/dfloat(ky_max)               &
                         +dfloat((kz-1)*iz)/dfloat(kz_max)))
                 end if
                 do i4_do=1,atom_orbital(atom_kindn(i2_do))
                    do i3_do=1,atom_orbital(atom_kindn(i1_do))
                       i = i1_count+i3_do
                       j = i2_count+i4_do
                       if( i<descZZ%srow .or. descZZ%erow<i ) cycle
                       if( j<descZZ%scol .or. descZZ%ecol<j ) cycle
                       h00_mat(i,j) = h00_mat(i,j) + h_ijmn(i3_do,i4_do)*dcmplx(cs,sn) 
                       s00_mat(i,j) = s00_mat(i,j) + s_ijmn(i3_do,i4_do)*dcmplx(cs,sn) 
                    end do
                 end do
              end do
           end do
        end do
     end do
  end do


  deallocate(h_ijmn,s_ijmn,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: set_hamiltonian_zper_periodic'
     stop
  end if

  return
end subroutine set_hamiltonian_zper_periodic
