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

module hamiltonian_temp

  implicit none

  integer :: natom_ac_ct,natom_ac_cl,natom_ac_cr
  integer :: natom_ac_lt,natom_ac_ll,natom_ac_lr
  integer :: natom_ac_rt,natom_ac_rl,natom_ac_rr
  integer :: nl_ac_c,nl_ac_l,nl_ac_r
  integer :: spin_ll,spin_cc,spin_rr
  real(8) :: ele_num_ll,ele_num_rr
  real(8) :: cell_tempabc(3,3)

  integer, pointer :: i_over_c(:,:,:),i_over_l(:,:,:),i_over_r(:,:,:)
  integer, pointer :: i_orb_c(:),i_orb_l(:),i_orb_r(:)
  real(8), pointer :: rac_c(:,:),rac_l(:,:),rac_r(:,:)
  complex(8), pointer :: hcc_t(:,:,:),scc_t(:,:) 

  complex(8), pointer :: h00_l_t(:,:,:),h01_l_t(:,:,:),h10_l_t(:,:,:) 
  complex(8), pointer :: s00_l_t(:,:),s01_l_t(:,:),s10_l_t(:,:) 
  complex(8), pointer :: h00_r_t(:,:,:),h01_r_t(:,:,:),h10_r_t(:,:,:) 
  complex(8), pointer :: s00_r_t(:,:),s01_r_t(:,:),s10_r_t(:,:) 

  type ham_negf_type
     real(8), pointer :: s(:,:)
     real(8), pointer :: h(:,:,:)
     complex(8), pointer :: hls(:,:,:)
  end type ham_negf_type

  type(ham_negf_type), pointer :: ht_hs_c(:,:,:)
  type(ham_negf_type), pointer :: ht_hs_l(:,:,:)
  type(ham_negf_type), pointer :: ht_hs_r(:,:,:)
contains
  subroutine alo_ham_temp_ham(descCC,descLL,descRR)
    use ac_mpi_module
    implicit none

    type(MPI_MatDesc), intent(in) :: descCC, descLL, descRR
    integer :: ic_spin,il_spin,ir_spin
    integer :: ier

    if( spin_cc == 2 ) then
       ic_spin=2
    else
       ic_spin=1
    end if
    if( spin_ll == 2 ) then
       il_spin=2
    else
       il_spin=1
    end if
    if( spin_rr == 2 ) then
       ir_spin=2
    else
       ir_spin=1
    end if

    allocate(scc_t(descCC%nrow,descCC%scol:descCC%ecol),stat=ier) 
    allocate(hcc_t(descCC%nrow,descCC%scol:descCC%ecol,ic_spin),stat=ier) 

    allocate(s00_l_t(descLL%nrow,descLL%scol:descLL%ecol),stat=ier) 
    allocate(s01_l_t(descLL%nrow,descLL%scol:descLL%ecol),stat=ier) 
    allocate(s10_l_t(descLL%nrow,descLL%scol:descLL%ecol),stat=ier) 
    allocate(s00_r_t(descRR%nrow,descRR%scol:descRR%ecol),stat=ier) 
    allocate(s01_r_t(descRR%nrow,descRR%scol:descRR%ecol),stat=ier) 
    allocate(s10_r_t(descRR%nrow,descRR%scol:descRR%ecol),stat=ier) 

    allocate(h00_l_t(descLL%nrow,descLL%scol:descLL%ecol,ir_spin),stat=ier) 
    allocate(h01_l_t(descLL%nrow,descLL%scol:descLL%ecol,ir_spin),stat=ier) 
    allocate(h10_l_t(descLL%nrow,descLL%scol:descLL%ecol,ir_spin),stat=ier) 
    allocate(h00_r_t(descRR%nrow,descRR%scol:descRR%ecol,ir_spin),stat=ier) 
    allocate(h01_r_t(descRR%nrow,descRR%scol:descRR%ecol,ir_spin),stat=ier) 
    allocate(h10_r_t(descRR%nrow,descRR%scol:descRR%ecol,ir_spin),stat=ier) 
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_temp_ham'
       stop
    end if

    return
  end subroutine alo_ham_temp_ham

  subroutine dealo_ham_temp_ham
    implicit none
    integer :: ier

    deallocate(hcc_t,scc_t) 
    deallocate(h00_l_t,h01_l_t,h10_l_t,s00_l_t,s01_l_t,s10_l_t) 
    deallocate(h00_r_t,h01_r_t,h10_r_t,s00_r_t,s01_r_t,s10_r_t,stat=ier) 
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: dealo_ham_temp_ham'
       stop
    end if

    return
  end subroutine dealo_ham_temp_ham

  subroutine alo_ham_negf_type_c1
    implicit none
    integer :: i1_do,i2_do,i3_do,ier

    allocate(ht_hs_c(natom_ac_ct,natom_ac_ct,nl_ac_c)                            &
         ,i_over_c(natom_ac_ct,natom_ac_ct,nl_ac_c)                           &
         ,i_orb_c(natom_ac_ct),rac_c(3,nl_ac_c),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_negf_type_c1'
       stop
    end if

    do i1_do=1,natom_ac_ct
       do i2_do=1,nl_ac_c
          do i3_do=1,natom_ac_ct
             i_over_c(i1_do,i3_do,i2_do)=1
          end do
       end do
    end do

    return
  end subroutine alo_ham_negf_type_c1

  subroutine alo_ham_negf_type_c2(i1,i2,l1,j1,j2)
    implicit none
    integer, intent(in) :: i1,i2,l1,j1,j2
    integer :: ier

    if( spin_cc /= 4 ) then
       allocate(ht_hs_c(i2,i1,l1)%h(spin_cc,j2,j1)                                &
            ,ht_hs_c(i2,i1,l1)%s(j2,j1),stat=ier)
    else
       allocate(ht_hs_c(i2,i1,l1)%hls(spin_cc,j2,j1)                              &
            ,ht_hs_c(i2,i1,l1)%s(j2,j1),stat=ier)
    end if
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_negf_type_c2'
       stop
    end if

    return
  end subroutine alo_ham_negf_type_c2

  subroutine dealo_ham_negf_type_c
    implicit none
    integer :: i1_do,i2_do,i3_do,ier

    if( spin_cc /= 4 ) then
       do i1_do=1,natom_ac_ct
          do i2_do=1,nl_ac_c
             do i3_do=1,natom_ac_ct
                if( i_over_c(i3_do,i1_do,i2_do) == 0 ) then
                   deallocate(ht_hs_c(i3_do,i1_do,i2_do)%h                            &
                        ,ht_hs_c(i3_do,i1_do,i2_do)%s,stat=ier)
                   if( ier /= 0 ) then
                      write(6,*) 'error allocate: dealo_ham_negf_type_c2'
                   end if
                end if
             end do
          end do
       end do
    else
       do i1_do=1,natom_ac_ct
          do i2_do=1,nl_ac_c
             do i3_do=1,natom_ac_ct
                if( i_over_c(i3_do,i1_do,i2_do) == 0 ) then
                   deallocate(ht_hs_c(i3_do,i1_do,i2_do)%hls                          &
                        ,ht_hs_c(i3_do,i1_do,i2_do)%s,stat=ier)
                   if( ier /= 0 ) then
                      write(6,*) 'error allocate: dealo_ham_negf_type_c2'
                   end if
                end if
             end do
          end do
       end do
    end if

    deallocate(ht_hs_c,i_over_c,i_orb_c,rac_c,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: dealo_ham_negf_type_c'
       stop
    end if

    return
  end subroutine dealo_ham_negf_type_c

  subroutine alo_ham_negf_type_l1
    implicit none
    integer :: i1_do,i2_do,i3_do,ier

    allocate(ht_hs_l(natom_ac_lt,natom_ac_lt,nl_ac_l)                            &
         ,i_over_l(natom_ac_lt,natom_ac_lt,nl_ac_l)                           &
         ,i_orb_l(natom_ac_lt),rac_l(3,nl_ac_l),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_negf_type_l1'
       stop
    end if

    do i1_do=1,natom_ac_lt
       do i2_do=1,nl_ac_l
          do i3_do=1,natom_ac_lt
             i_over_l(i1_do,i3_do,i2_do)=1
          end do
       end do
    end do

    return
  end subroutine alo_ham_negf_type_l1

  subroutine alo_ham_negf_type_l2(i1,i2,l1,j1,j2)
    implicit none
    integer, intent(in) :: i1,i2,l1,j1,j2
    integer :: ier

    if( spin_ll /= 4 ) then
       allocate(ht_hs_l(i2,i1,l1)%h(spin_ll,j2,j1)                                &
            ,ht_hs_l(i2,i1,l1)%s(j2,j1),stat=ier)
    else
       allocate(ht_hs_l(i2,i1,l1)%hls(spin_ll,j2,j1)                              &
            ,ht_hs_l(i2,i1,l1)%s(j2,j1),stat=ier)
    end if
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_negf_type_l2'
       stop
    end if

    return
  end subroutine alo_ham_negf_type_l2

  subroutine dealo_ham_negf_type_l
    implicit none
    integer :: i1_do,i2_do,i3_do,ier

    if( spin_ll /= 4 ) then
       do i1_do=1,natom_ac_lt
          do i2_do=1,nl_ac_l
             do i3_do=1,natom_ac_lt
                if( i_over_l(i3_do,i1_do,i2_do) == 0 ) then
                   deallocate(ht_hs_l(i3_do,i1_do,i2_do)%h                            &
                        ,ht_hs_l(i3_do,i1_do,i2_do)%s,stat=ier)
                   if( ier /= 0 ) then
                      write(6,*) 'error allocate: dealo_ham_negf_type_l2'
                   end if
                end if
             end do
          end do
       end do
    else
       do i1_do=1,natom_ac_lt
          do i2_do=1,nl_ac_l
             do i3_do=1,natom_ac_lt
                if( i_over_l(i3_do,i1_do,i2_do) == 0 ) then
                   deallocate(ht_hs_l(i3_do,i1_do,i2_do)%hls                          &
                        ,ht_hs_l(i3_do,i1_do,i2_do)%s,stat=ier)
                   if( ier /= 0 ) then
                      write(6,*) 'error allocate: dealo_ham_negf_type_l2'
                   end if
                end if
             end do
          end do
       end do
    end if

    deallocate(ht_hs_l,i_over_l,i_orb_l,rac_l,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: dealo_ham_negf_type_l'
       stop
    end if

    return
  end subroutine dealo_ham_negf_type_l

  subroutine alo_ham_negf_type_r1
    implicit none
    integer :: i1_do,i2_do,i3_do,ier

    allocate(ht_hs_r(natom_ac_rt,natom_ac_rt,nl_ac_r)                            &
         ,i_over_r(natom_ac_rt,natom_ac_rt,nl_ac_r)                           &
         ,i_orb_r(natom_ac_rt),rac_r(3,nl_ac_r),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_negf_type_r1'
       stop
    end if

    do i1_do=1,natom_ac_rt
       do i2_do=1,nl_ac_r
          do i3_do=1,natom_ac_rt
             i_over_r(i1_do,i3_do,i2_do)=1
          end do
       end do
    end do

    return
  end subroutine alo_ham_negf_type_r1

  subroutine alo_ham_negf_type_r2(i1,i2,l1,j1,j2)
    implicit none
    integer, intent(in) :: i1,i2,l1,j1,j2
    integer :: ier

    if( spin_rr /= 4 ) then
       allocate(ht_hs_r(i2,i1,l1)%h(spin_rr,j2,j1)                                &
            ,ht_hs_r(i2,i1,l1)%s(j2,j1),stat=ier)
    else
       allocate(ht_hs_r(i2,i1,l1)%hls(spin_rr,j2,j1)                              &
            ,ht_hs_r(i2,i1,l1)%s(j2,j1),stat=ier)
    end if
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_ham_negf_type_r2'
       stop
    end if

    return
  end subroutine alo_ham_negf_type_r2

  subroutine dealo_ham_negf_type_r
    implicit none
    integer :: i1_do,i2_do,i3_do,ier

    if( spin_rr /= 4 ) then
       do i1_do=1,natom_ac_rt
          do i2_do=1,nl_ac_r
             do i3_do=1,natom_ac_rt
                if( i_over_r(i3_do,i1_do,i2_do) == 0 ) then
                   deallocate(ht_hs_r(i3_do,i1_do,i2_do)%h                            &
                        ,ht_hs_r(i3_do,i1_do,i2_do)%s,stat=ier)
                   if( ier /= 0 ) then
                      write(6,*) 'error allocate: dealo_ham_negf_type_r2'
                   end if
                end if
             end do
          end do
       end do
    else
       do i1_do=1,natom_ac_rt
          do i2_do=1,nl_ac_r
             do i3_do=1,natom_ac_rt
                if( i_over_r(i3_do,i1_do,i2_do) == 0 ) then
                   deallocate(ht_hs_r(i3_do,i1_do,i2_do)%hls                          &
                        ,ht_hs_r(i3_do,i1_do,i2_do)%s,stat=ier)
                   if( ier /= 0 ) then
                      write(6,*) 'error allocate: dealo_ham_negf_type_r2'
                   end if
                end if
             end do
          end do
       end do
    end if

    deallocate(ht_hs_r,i_over_r,i_orb_r,rac_r,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: dealo_ham_negf_type_r'
       stop
    end if

    return
  end subroutine dealo_ham_negf_type_r

end module hamiltonian_temp
