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

module scf_negf

  implicit none
  character(50) :: file_parameter_hc_scf
  character(50) :: file_parameter_hl_scf
  character(50) :: file_parameter_hr_scf
  character(50) :: file_parameter_lv1_scf
  character(50) :: file_parameter_lv2_scf
  character(50) :: file_parameter_rv1_scf
  character(50) :: file_parameter_rv2_scf
  character(50) :: file_parameter_cv1_pot
  character(50) :: file_parameter_ham_pot
  character(50) :: file_parameter_out_scf
  character(50) :: file_parameter_out_pot
  character(50) :: filecalc_onoff
  character(50) :: file_parameter_out_vh0

  integer :: num_atom_scf,numc_atom_scf,numl_atom_scf,numr_atom_scf
  integer :: nelem_num,num_cell_l,xc_type
  integer :: ispin_pol_scf,ispin_pol_scf_l,ispin_pol_scf_r
  integer :: i_rotspin_l,i_rotspin_r,shift_cell_l1,shift_cell_l2
  integer, pointer :: iatom_orb_num(:)

  integer :: method_sum_om_scf
  integer :: om_block_num_scf
  integer, pointer :: num_om_par_scf(:,:)
  real(8), pointer :: omega_if_scf(:,:)
  character(50), pointer :: om_con_method_scf(:)

  integer :: i_total_omega
  integer, pointer :: i_bios_omega_scf(:)
  complex(8), pointer :: omega_scf(:),omega_weight_scf(:)

  character(50) :: file_selfenergy_onoff
  character(50) :: file_selfenergy_scf
  character(50) :: restart_onoff
  character(50) :: ft_switch
  character(50) :: intp_switch

  real(8), pointer :: dens(:,:,:),dens2(:,:,:)
  real(8), pointer :: edens(:,:,:),edens2(:,:,:)
  real(8), pointer :: rho(:,:),rho_temp(:,:)
  complex(8), pointer :: rhols(:,:),rhols_temp(:,:)
  complex(8), pointer :: h_cc_scf(:,:,:),s_cc_scf(:,:)
  integer, pointer :: i_atom_num(:),i_atom_invnum(:),i_orb(:)

  real(8) :: eps_scf,eps_scf_cal,mixing,mixing_rho,mixing_max,mixing_vto
  integer :: max_num_scf,iter_conv,iter_mm

  character(50) :: gra_onoff

  integer :: n_a,n_b,n_c
  integer :: l_cell_l_bound,r_cell_l_bound,r_cell_l_bound_num,c_num_cell_l
  real(8), pointer :: cell_labc(:,:),cell_dkabc(:,:)
  real(8), pointer :: vh_l(:),v0_l(:,:),vh_r(:),v0_r(:,:)
  real(8), pointer :: cell_lr(:,:),cell_lr_z(:)
  real(8), pointer :: r_cell_dk(:,:),cell_dlabc(:,:),g2_temp(:)

  real(8), pointer :: den_l(:,:),den_r(:,:)
  complex(8), pointer :: denls_l(:,:),denls_r(:,:)
  complex(8), pointer :: dens_temp_l(:),dens_temp_r(:)
  integer :: hartree_switch

  real(8), pointer :: vh_temp_l(:),vh_temp_r(:)
  real(8), pointer :: v_hartree(:),v_tot(:,:),v_tot_temp(:,:),green(:,:,:)
  complex(8), pointer :: vh_l_f(:),vh_r_f(:),rho_f(:),del2_z(:)
  complex(8), pointer :: vh_temp(:)
  real(8) :: del_cell_l
  complex(8) :: v0_a,v0_b

  real(8), pointer :: v_xc(:),v_ext(:),rhoval(:),rhopcc(:)
  real(8), pointer :: h0(:,:,:,:),h0_accel(:,:,:)

  integer :: i_gzero_method
  real(8) :: gzero_gamma

  real(8) :: cp_scf_l,cp_scf_r,v_scf_l,v_scf_r
  real(8) :: om_im_bias,om_del_bias
  character(50) :: scf_bias
  integer :: num_om_bias

  real(8), pointer :: cell_labc_l(:,:),cell_labc_r(:,:)
  real(8) :: res_bound_l,res_bound_r,del_bound_l,del_bound_r
  integer :: n_a_l,n_b_l,n_c_l
  integer :: n_a_r,n_b_r,n_c_r
  integer :: l_cell_l_bound_l,r_cell_l_bound_r

  integer :: cutene_vt_swi
  real(8) :: cutene_vt_val

  real(8), pointer :: v_tot_l(:,:),v_tot_r(:,:)
  integer :: atom_parlay_l,atom_parlay_r,lay_shift_l,lay_shift_r
  character(50) :: ene_c_shift_swi
  real(8) :: ene_c_shift_val

  real(8), pointer :: omega_gamm(:),omega_tem(:)

  complex(8), pointer :: boucon_l(:),boucon_r(:)

  real(8), pointer :: cell_lo(:),vatom_q(:),atom_rcut(:)
  real(8), pointer :: atom_ro(:,:),sum_charge(:)
  integer, pointer :: atom_name_num(:)
  character(5), pointer :: atom_name(:)
  character(50) :: dis_chara,lay_chara

  real(8) :: min_level_l,min_level_c,min_level_r,cp_scf_c

  integer :: base_npao,param_cell_nl

  integer :: n_v_atom_matrix,n_v_nim_max
  integer, pointer :: hv_atom_matrix(:,:,:)

  real(8) :: tot_ele_num
  real(8) :: mixing_dm,mixing_dm_s
  integer :: negf_mix_history,negf_mix_start

  integer :: ka_scf,kb_scf,kt_num
  integer, pointer :: ksw_po_kt_scf(:)
  real(8), pointer :: po_kt_scf(:,:)
  real(8), pointer :: po_ka_scf(:,:),po_kb_scf(:,:)
  real(8), pointer :: param_cell_vl(:,:)

  character(50) :: force_calc_onoff
  character(50) :: param_option_projection
  character(50) :: sw_shift_chem

contains
  subroutine alo_scf_negf_kpoint

    implicit none
    integer :: ier

    allocate(po_ka_scf(3,ka_scf),po_kb_scf(3,kb_scf)                             &
         ,po_kt_scf(3,ka_scf*kb_scf),ksw_po_kt_scf(ka_scf*kb_scf),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_kpoint'
       stop
    end if

    return
  end subroutine alo_scf_negf_kpoint

  subroutine alo_scf_negf_parameter_1

    implicit none
    integer :: ier

    allocate(cell_labc(3,3),cell_dkabc(3,3)                                      &
         ,atom_name(num_atom_scf),atom_name_num(num_atom_scf)                 &
         ,cell_lo(3),vatom_q(num_atom_scf)                                    &
         ,atom_rcut(num_atom_scf),atom_ro(num_atom_scf,3)                     &
         ,sum_charge(num_atom_scf),iatom_orb_num(num_atom_scf),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_parameter_1'
       stop
    end if

    return
  end subroutine alo_scf_negf_parameter_1

  subroutine alo_scf_negf_parameter_11

    implicit none
    integer :: ier

    allocate(param_cell_vl(param_cell_nl,3),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_parameter_1'
       stop
    end if

    return
  end subroutine alo_scf_negf_parameter_11

  subroutine alo_scf_accel_parameter

    implicit none
    integer :: ier

    allocate(i_orb(num_atom_scf+1),v_ext(num_cell_l)                             &
         ,rhoval(num_cell_l)                                                  &
         ,rhopcc(num_cell_l)                                                  &
         ,v_hartree(num_cell_l)                                               &
         ,i_atom_num(num_atom_scf),i_atom_invnum(num_atom_scf)                &
         ,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_accel_parameter_3'
       stop
    end if

    if( ispin_pol_scf < 4 ) then
       allocate(rho_temp(num_cell_l,ispin_pol_scf),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_scf_accel_parameter_31'
          stop
       end if
    else
       allocate(rhols_temp(num_cell_l,ispin_pol_scf),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_scf_accel_parameter_31'
          stop
       end if
    end if

    return
  end subroutine alo_scf_accel_parameter

  subroutine alo_scf_negf_omega1

    implicit none
    integer :: ier

    allocate(num_om_par_scf(om_block_num_scf,3),omega_if_scf(om_block_num_scf,4) &
         ,om_con_method_scf(om_block_num_scf),omega_gamm(om_block_num_scf)    &
         ,omega_tem(om_block_num_scf),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_omega1'
       stop
    end if

    return
  end subroutine alo_scf_negf_omega1

  subroutine alo_scf_negf_omega2

    implicit none
    integer :: ier

    allocate(omega_scf(i_total_omega),omega_weight_scf(i_total_omega)            &
         ,i_bios_omega_scf(i_total_omega),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_omega2'
       stop
    end if

    return
  end subroutine alo_scf_negf_omega2

  subroutine alo_potential

    implicit none
    integer :: ier

    allocate(cell_lr(3,n_a*n_b*n_c),r_cell_dk(3,n_a*n_b)                         &
         ,cell_dlabc(3,3),v_tot(n_a*n_b*n_c,ispin_pol_scf)                    &
         ,g2_temp(n_a*n_b*n_c),cell_lr_z(n_c+1),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    return
  end subroutine alo_potential

  subroutine alo_potential_l

    implicit none
    integer :: ier

    allocate(vh_l(n_a_l*n_b_l),v0_l(n_a_l*n_b_l,ispin_pol_scf_l)                 &
         ,dens_temp_l(n_a_l*n_b_l)                                            &
         ,v_tot_l(n_a_l*n_b_l*n_c_l,ispin_pol_scf_l)                          &
         ,vh_temp_l(n_a_l*n_b_l*n_c_l)                                        &
         ,vh_l_f(n_a*n_b),cell_labc_l(3,3),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    if( ispin_pol_scf_l < 4 ) then
       allocate(den_l(n_a_l*n_b_l*n_c_l,ispin_pol_scf_l),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_density1'
          stop
       end if
    else
       allocate(denls_l(n_a_l*n_b_l*n_c_l,ispin_pol_scf_l),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_density1'
          stop
       end if
    end if

    return
  end subroutine alo_potential_l

  subroutine alo_potential_r

    implicit none
    integer :: ier

    allocate(vh_r(n_a_r*n_b_r),v0_r(n_a_r*n_b_r,ispin_pol_scf_r)                 &
         ,dens_temp_r(n_a_r*n_b_r)                                            &
         ,v_tot_r(n_a_r*n_b_r*n_c_r,ispin_pol_scf_r)                          &
         ,vh_temp_r(n_a_r*n_b_r*n_c_r)                                        &
         ,vh_r_f(n_a*n_b),cell_labc_r(3,3),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    if( ispin_pol_scf_r < 4 ) then
       allocate(den_r(n_a_r*n_b_r*n_c_r,ispin_pol_scf_r),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_density1'
          stop
       end if
    else
       allocate(denls_r(n_a_r*n_b_r*n_c_r,ispin_pol_scf_r),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_density1'
          stop
       end if
    end if

    return
  end subroutine alo_potential_r

  subroutine unset_scf_accel_parameter

    implicit none
    integer :: ier

    deallocate(num_om_par_scf,omega_if_scf,om_con_method_scf                     &
         ,omega_scf,omega_weight_scf,v_tot,i_bios_omega_scf                 &
         ,vh_l,v0_l,vh_r,v0_r,vh_l_f,vh_r_f,v_ext,rhoval                    &
         ,cell_labc,cell_dkabc,cell_lr,r_cell_dk,cell_dlabc                 &
         ,rhopcc,cell_lr_z,dens_temp_l,dens_temp_r,v_tot_l,v_tot_r          &
         ,v_hartree,vh_temp_l,vh_temp_r,cell_lo,vatom_q,atom_rcut           &
         ,atom_ro,atom_name_num,atom_name,sum_charge,i_atom_num             &
         ,i_atom_invnum,po_ka_scf,po_kb_scf,po_kt_scf,ksw_po_kt_scf         &
         ,param_cell_vl,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    if( ispin_pol_scf < 4 ) then
       deallocate(rho_temp,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter_c'
          stop
       end if
    else
       deallocate(rhols_temp,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter_c'
          stop
       end if
    end if

    if( ispin_pol_scf_l < 4 ) then
       deallocate(den_l,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter_l'
          stop
       end if
    else
       deallocate(denls_l,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter_l'
          stop
       end if
    end if

    if( ispin_pol_scf_r < 4 ) then
       deallocate(den_r,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter_r'
          stop
       end if
    else
       deallocate(denls_r,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter_r'
          stop
       end if
    end if

    return
  end subroutine unset_scf_accel_parameter

  subroutine unset_scf_accel_parameter1

    implicit none
    integer :: ier

    deallocate(i_orb,iatom_orb_num,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    return
  end subroutine unset_scf_accel_parameter1

  subroutine alo_use_scf_3(m_mat_max_c)

    implicit none
    integer, intent(in) :: m_mat_max_c
    integer :: i1_do,i2_do,i3_do,ier

    allocate(v_tot_temp(n_a*n_b*n_c,ispin_pol_scf)                               &
         ,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    do i2_do=1,ispin_pol_scf
       do i1_do=1,n_a*n_b*n_c
          v_tot_temp(i1_do,i2_do)=v_tot(i1_do,i2_do)
       end do
    end do

    return
  end subroutine alo_use_scf_3

  subroutine unset_use_scf_32

    implicit none
    integer :: ier

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

    return
  end subroutine unset_use_scf_32

  subroutine alo_use_scf_4

    implicit none
    integer :: ier

    allocate(boucon_l(n_a*n_b),boucon_r(n_a*n_b),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    return
  end subroutine alo_use_scf_4

  subroutine unset_use_scf_4

    implicit none
    integer :: ier

    deallocate(boucon_l,boucon_r,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    return
  end subroutine unset_use_scf_4

  subroutine alo_density_1(m_mat_max_c)

    implicit none
    integer, intent(in) :: m_mat_max_c
    integer :: i1_do,i2_do,i3_do,ier,ic_spin

    if( ispin_pol_scf == 2 ) then
       ic_spin=2
    else
       ic_spin=1
    end if

    allocate(dens(ic_spin,m_mat_max_c,m_mat_max_c)                               &
         ,dens2(ic_spin,m_mat_max_c,m_mat_max_c)                              &
         ,edens(ic_spin,m_mat_max_c,m_mat_max_c)                              &
         ,edens2(ic_spin,m_mat_max_c,m_mat_max_c),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    return
  end subroutine alo_density_1

  subroutine alo_density_2

    implicit none
    integer :: i1_do,ier

    allocate(rho_f(num_cell_l),del2_z(n_c+1),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    do i1_do=1,n_c+1
       del2_z(i1_do)=dcmplx(0.d0,0.d0)
    end do

    return
  end subroutine alo_density_2

  subroutine unset_density_1

    implicit none
    integer :: ier

    deallocate(dens,dens2,edens,edens2,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    return
  end subroutine unset_density_1

  subroutine unset_density_21

    implicit none
    integer :: ier

    deallocate(rho_f,del2_z,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    return
  end subroutine unset_density_21

  subroutine alo_density_ini

    implicit none
    integer :: i1_do,i2_do,ier

    if( ispin_pol_scf < 4 ) then
       allocate(rho(num_cell_l,ispin_pol_scf),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_density'
          stop
       end if
       do i1_do=1,ispin_pol_scf
          do i2_do=1,num_cell_l
             rho(i2_do,i1_do)=rho_temp(i2_do,i1_do)
          end do
       end do
    else
       allocate(rhols(num_cell_l,ispin_pol_scf),stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error allocate: alo_density'
          stop
       end if
       do i1_do=1,ispin_pol_scf
          do i2_do=1,num_cell_l
             rhols(i2_do,i1_do)=rhols_temp(i2_do,i1_do)
          end do
       end do
    end if

    return
  end subroutine alo_density_ini

  subroutine unset_density_ini

    implicit none
    integer :: ier

    if( ispin_pol_scf < 4 ) then
       deallocate(rho,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter'
          stop
       end if
    else
       deallocate(rhols,stat=ier)
       if( ier /= 0 ) then
          write(6,*) 'error deallocate: unset_ham_parameter'
          stop
       end if
    end if

    return
  end subroutine unset_density_ini

  subroutine alo_scf_ham(m_mat_max_c)

    implicit none
    integer, intent(in) :: m_mat_max_c
    integer :: i1_do,i2_do,i3_do,ier,ic_spin

    if( ispin_pol_scf == 2 ) then
       ic_spin=2
    else
       ic_spin=1
    end if

    allocate(h_cc_scf(ic_spin,m_mat_max_c,m_mat_max_c)                           &
         ,s_cc_scf(m_mat_max_c,m_mat_max_c),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_density'
       stop
    end if

    do i3_do=1,m_mat_max_c
       do i2_do=1,m_mat_max_c
          do i1_do=1,ic_spin
             h_cc_scf(i1_do,i2_do,i3_do)=dcmplx(0.d0,0.d0)
          end do
          s_cc_scf(i2_do,i3_do)=dcmplx(0.d0,0.d0)
       end do
    end do

    return
  end subroutine alo_scf_ham

  subroutine unset_scf_ham

    implicit none
    integer :: ier

    deallocate(h_cc_scf,s_cc_scf,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    return
  end subroutine unset_scf_ham

  subroutine h_v_atom

    implicit none
    integer :: ier

    allocate(hv_atom_matrix(num_atom_scf,num_atom_scf,0:param_cell_nl-1) &
         ,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_ham_parameter'
       stop
    end if

    return
  end subroutine h_v_atom

  subroutine unset_h_v_atom

    implicit none
    integer :: ier

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

    return
  end subroutine unset_h_v_atom
end module scf_negf
