module hamiltonian
  use constants, only : dp
  use utilities, only : error
  use scf, only: Vscf, V0
  implicit none
contains

  subroutine h_psi(psi,psip)

    use pw_types, only : wave_function, available, direct_space, &
                         field_times_wvfct

    type(wave_function), intent(in)             :: psi
    type(wave_function), intent(in out), target :: psip
    
    if( .not. available(psi) .or. .not. available(psip) ) &
         call error('h_psi','in and/or out wvfct not available',1)
    
    if ( any ( psi%k%k(:)/=psip%k%k(:) ) ) call error('h_psi', &
         'in and out wvfct must correspond to the same k point',1)
    
    if(Vscf%state /= DIRECT_SPACE) &
         call error('h_psi','Vscf not in real space',1)
    
    call field_times_wvfct(Vscf,psi,psip)
    psip%val(:) = psi%k%gk(:)*psi%val(:) + psip%val(:)

    return
    
  end subroutine h_psi
  
  subroutine g_psi(psi,e,psip)
    use pw_types, only : wave_function, available 

    type(wave_function), intent(in)             :: psi
    real(DP),            intent(in)             :: e
    type(wave_function), intent(in out), target :: psip
    
    if( .not. available(psi) .or. .not. available(psip) ) &
         call error('g_psi','in and/or out wvfct not available',1)
    
    if ( any ( psi%k%k(:)/=psip%k%k(:) ) ) call error('g_psi', &
         'in and out wvfct''s do not match',1)

    psip%val(:) = psi%val(:)
    where( psi%k%gk(:) + V0 - e > 0.01)
       psip%val(:) = psi%val(:) / ( psi%k%gk(:) + V0 - e )
    end where

    return
    
  end subroutine g_psi
  
  subroutine fill_h(hc,k)
    
    use constants, only : zero, one
    use pw_types, only : construct, destroy, wave_function, k_point, &
                         assignment(=)
    use reciprocal_lattice, only: g, ngm

    implicit none

    complex(DP),   intent(out) :: hc(:,:)
    type(k_point), intent(in)  :: k
    type(wave_function)        :: psi, psip
    integer                    :: i, npw

    npw = size(hc,2)

    hc(:,:)  = cmplx(zero,zero)

    call construct(psi,k); call construct(psip,k)

    do i=1, npw
       psi        = ZERO
       psi%val(i) = cmplx(ONE,ZERO)
       call h_psi(psi,psip)
       hc(1:npw,i) = psip%val(1:npw)
    end do

    call destroy(psi); call destroy(psip)

  end subroutine fill_h

end module hamiltonian
