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

  implicit none
  complex(8), pointer :: se_l_mat_per(:,:,:,:) 
  complex(8), pointer :: se_r_mat_per(:,:,:,:) 

  integer :: num_gra_gs,iw_max_gs
  integer, pointer :: omega_par_gs(:),omega_par_num_gs(:)
  complex(8), pointer :: omega_gs(:),omega_weight(:)

  integer :: num_block_gr
  complex(8), pointer :: tr_gr_l(:,:,:),tr_gr_r(:,:,:),tr_gr_c(:,:,:),tr_tr(:,:,:)
  complex(8), pointer :: tr_grc_block(:,:,:,:)

  integer :: kt_tr
  real(8), pointer :: po_ka_tr(:,:),po_kb_tr(:,:)
  real(8), pointer :: po_kt_tr(:,:)
contains
  subroutine alo_tr_negf_kpoint(ka_tr,kb_tr)

    implicit none
    integer, intent(in) :: ka_tr,kb_tr
    integer :: ier

    allocate(po_ka_tr(3,ka_tr),po_kb_tr(3,kb_tr)                                 &
         ,po_kt_tr(3,ka_tr*kb_tr),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_kpoint'
       stop
    end if

    return
  end subroutine alo_tr_negf_kpoint

  subroutine dealo_tr_negf_kpoint

    implicit none
    integer :: ier

    deallocate(po_ka_tr,po_kb_tr,po_kt_tr,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_scf_negf_kpoint'
       stop
    end if

    return
  end subroutine dealo_tr_negf_kpoint

  subroutine alo_gf_se_c(descCC,kx_max_l,ky_max_l,kx_max_r,ky_max_r)
    use ac_mpi_module
    implicit none

    type(MPI_MatDesc), intent(in) :: descCC
    integer, intent(in) :: kx_max_l,ky_max_l,kx_max_r,ky_max_r
    integer :: ier,kx,ky,i1_do,i2_do


    allocate(se_l_mat_per(descCC%nrow,descCC%scol:descCC%ecol,ky_max_l,kx_max_l),stat=ier)    
    allocate(se_r_mat_per(descCC%nrow,descCC%scol:descCC%ecol,ky_max_r,kx_max_r),stat=ier)    
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_gf_se_c'
       stop
    end if

    do kx=1,kx_max_l
       do ky=1,ky_max_l
          se_l_mat_per(:,:,ky,kx) = dcmplx(0.d0,0.d0)    
       end do
    end do

    do kx=1,kx_max_r
       do ky=1,ky_max_r
          se_r_mat_per(:,:,ky,kx) = dcmplx(0.d0,0.d0)    
       end do
    end do

    return
  end subroutine alo_gf_se_c

  subroutine unset_gf_se_c

    implicit none
    integer :: ier

    deallocate(se_l_mat_per,se_r_mat_per,stat=ier) 
    if( ier /= 0 ) then
       write(6,*) 'error deallocate: unset_gf_se_c'
       stop
    end if

    return
  end subroutine unset_gf_se_c

  subroutine alo_condition_omega_gs(om_block_num)

    implicit none
    integer,intent(in) :: om_block_num
    integer :: ier

    allocate(omega_par_gs(om_block_num),omega_par_num_gs(om_block_num)           &
         ,omega_gs(iw_max_gs),omega_weight(iw_max_gs),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_condition_omega_gs'
       stop
    end if

    return
  end subroutine alo_condition_omega_gs

  subroutine unset_condition_omega_gs

    implicit none
    integer :: ier

    deallocate(omega_par_gs,omega_par_num_gs,omega_gs,omega_weight,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: unset_condition_omega_gs'
       stop
    end if

    return
  end subroutine unset_condition_omega_gs

  subroutine alo_gf_se_gra(spin_t,kt_num)

    implicit none
    integer,intent(in) :: spin_t,kt_num
    integer :: ier,i1_do,i2_do,i3_do,kt,spin

    if( spin_t == 2 ) then
       spin=2
    else
       spin=1
    end if

    allocate(tr_gr_l(spin,iw_max_gs,kt_num),tr_gr_r(spin,iw_max_gs,kt_num)       &
         ,tr_gr_c(spin,iw_max_gs,kt_num),tr_tr(spin,iw_max_gs,kt_num)         &
         ,tr_grc_block(spin,num_block_gr,iw_max_gs,kt_num),stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: alo_gf_se_gra'
       stop
    end if

    do kt=1,kt_num
       do i3_do=1,spin
          do i1_do=1,iw_max_gs
             tr_gr_l(i3_do,i1_do,kt)=dcmplx(0.d0,0.d0)
          end do
          do i1_do=1,iw_max_gs
             tr_gr_r(i3_do,i1_do,kt)=dcmplx(0.d0,0.d0)
          end do
          do i1_do=1,iw_max_gs
             tr_gr_c(i3_do,i1_do,kt)=dcmplx(0.d0,0.d0)
          end do
          do i1_do=1,iw_max_gs
             tr_tr(i3_do,i1_do,kt)=dcmplx(0.d0,0.d0)
          end do
          do i2_do=1,iw_max_gs
             do i1_do=1,num_block_gr
                tr_grc_block(i3_do,i1_do,i2_do,kt)=dcmplx(0.d0,0.d0)
             end do
          end do
       end do
    end do

    return
  end subroutine alo_gf_se_gra

  subroutine unset_gf_se_gra

    implicit none
    integer :: ier

    deallocate(tr_gr_l,tr_gr_r,tr_gr_c,tr_tr,tr_grc_block,stat=ier)
    if( ier /= 0 ) then
       write(6,*) 'error allocate: unset_gf_se_gra'
       stop
    end if

    return
  end subroutine unset_gf_se_gra

end module gf_se_c
