mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Added mo_energies as diff of expectation values of ionized wfs
This commit is contained in:
parent
7eb7e2134a
commit
3756b0a26a
159
src/Determinants/mo_energy_expval.irp.f
Normal file
159
src/Determinants/mo_energy_expval.irp.f
Normal file
@ -0,0 +1,159 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, mo_energy_expval, (N_states,mo_tot_num,2,2)]
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Third index is spin.
|
||||||
|
! Fourth index is 1:creation, 2:annihilation
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: ispin, istate
|
||||||
|
integer :: hp
|
||||||
|
double precision :: norm_out(N_states)
|
||||||
|
|
||||||
|
integer, parameter :: hole_particle(2) = (/ -1, 1 /)
|
||||||
|
double precision :: energies(n_states)
|
||||||
|
|
||||||
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
|
double precision :: E0(N_states), norm
|
||||||
|
double precision, parameter :: t=1.d-3
|
||||||
|
|
||||||
|
allocate (psi_in_out(N_int,2,N_det),psi_in_out_coef(N_det,N_states))
|
||||||
|
mo_energy_expval = 0.d0
|
||||||
|
|
||||||
|
psi_in_out_coef(1:N_det,1:N_states) = psi_coef(1:N_det,1:N_states)
|
||||||
|
psi_in_out(1:N_int,1:2,1:N_det) = psi_det(1:N_int,1:2,1:N_det)
|
||||||
|
|
||||||
|
! Truncate the wave function
|
||||||
|
do istate=1,N_states
|
||||||
|
norm = 0.d0
|
||||||
|
do k=1,N_det
|
||||||
|
if (dabs(psi_in_out_coef(k,istate)) < t) then
|
||||||
|
psi_in_out_coef(k,istate) = 0.d0
|
||||||
|
endif
|
||||||
|
norm = norm + psi_in_out_coef(k,istate)*psi_in_out_coef(k,istate)
|
||||||
|
enddo
|
||||||
|
ASSERT (norm > 0.d0)
|
||||||
|
norm = 1.d0/dsqrt(norm)
|
||||||
|
psi_in_out_coef(1:N_det,istate) = psi_in_out_coef(1:N_det,istate) * norm
|
||||||
|
call au0_h_au0(E0,psi_in_out,psi_in_out_coef,N_det,size(psi_in_out_coef,1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
do hp=1,2
|
||||||
|
do ispin=1,2
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
psi_in_out_coef(1:N_det,1:N_states) = psi_coef(1:N_det,1:N_states)
|
||||||
|
psi_in_out(1:N_int,1:2,1:N_det) = psi_det(1:N_int,1:2,1:N_det)
|
||||||
|
call apply_exc_to_psi(i,hole_particle(hp),ispin, &
|
||||||
|
norm_out,psi_in_out,psi_in_out_coef, N_det,N_det,N_det,N_states)
|
||||||
|
|
||||||
|
! Truncate the wave function
|
||||||
|
do istate=1,N_states
|
||||||
|
norm = 0.d0
|
||||||
|
do k=1,N_det
|
||||||
|
if (dabs(psi_in_out_coef(k,istate)) < t) then
|
||||||
|
psi_in_out_coef(k,istate) = 0.d0
|
||||||
|
endif
|
||||||
|
norm = norm + psi_in_out_coef(k,istate)*psi_in_out_coef(k,istate)
|
||||||
|
enddo
|
||||||
|
if (norm == 0.d0) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
norm = 1.d0/dsqrt(norm)
|
||||||
|
psi_in_out_coef(1:N_det,istate) = psi_in_out_coef(1:N_det,istate) * norm
|
||||||
|
enddo
|
||||||
|
call au0_h_au0(energies,psi_in_out,psi_in_out_coef,N_det,size(psi_in_out_coef,1))
|
||||||
|
mo_energy_expval(1:N_states,i,ispin,hp) = energies(1:N_states) - E0(1:N_states)
|
||||||
|
print *, i, ispin, real(energies(1)), real(E0(1))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
mo_energy_expval(1:N_states,1:mo_tot_num,1:2,1) = -mo_energy_expval(1:N_states,1:mo_tot_num,1:2,1)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
subroutine au0_h_au0(energies,psi_in,psi_in_coef,ndet,dim_psi_coef)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: ndet,dim_psi_coef
|
||||||
|
integer(bit_kind), intent(in) :: psi_in(N_int,2,Ndet)
|
||||||
|
double precision, intent(in) :: psi_in_coef(dim_psi_coef,N_states)
|
||||||
|
double precision, intent(out) :: energies(N_states)
|
||||||
|
|
||||||
|
integer :: i,j, istate
|
||||||
|
double precision :: hij,accu
|
||||||
|
double precision, allocatable :: psi_coef_tmp(:)
|
||||||
|
|
||||||
|
energies(1:N_states) = 0.d0
|
||||||
|
do i = 1, Ndet
|
||||||
|
if(sum(dabs(psi_in_coef(i,1:N_states)))==0.d0) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
call diag_H_mat_elem_au0_h_au0(psi_in(1,1,i),N_int,hij)
|
||||||
|
do istate=1,N_states
|
||||||
|
energies(istate) += psi_in_coef(i,istate) * psi_in_coef(i,istate) * hij
|
||||||
|
enddo
|
||||||
|
do j = i+1, Ndet
|
||||||
|
if(sum(dabs(psi_in_coef(j,1:N_states)))==0.d0) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
call i_H_j(psi_in(1,1,i),psi_in(1,1,j),N_int,hij)
|
||||||
|
hij = hij+hij
|
||||||
|
do istate=1,N_states
|
||||||
|
energies(istate) = energies(istate) + psi_in_coef(i,istate) * psi_in_coef(j,istate) * hij
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine diag_H_mat_elem_au0_h_au0(det_in,Nint,hii)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes <i|H|i> for any determinant i. Used for wave functions with an additional electron.
|
||||||
|
END_DOC
|
||||||
|
integer,intent(in) :: Nint
|
||||||
|
integer(bit_kind),intent(in) :: det_in(Nint,2)
|
||||||
|
double precision, intent(out) :: hii
|
||||||
|
|
||||||
|
integer :: i, j, iorb, jorb
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
integer :: elec_num_tab_local(2)
|
||||||
|
|
||||||
|
hii = 0.d0
|
||||||
|
call bitstring_to_list(det_in(1,1), occ(1,1), elec_num_tab_local(1), Nint)
|
||||||
|
call bitstring_to_list(det_in(1,2), occ(1,2), elec_num_tab_local(2), Nint)
|
||||||
|
|
||||||
|
! alpha - alpha
|
||||||
|
do i = 1, elec_num_tab_local(1)
|
||||||
|
iorb = occ(i,1)
|
||||||
|
hii += mo_mono_elec_integral(iorb,iorb)
|
||||||
|
do j = i+1, elec_num_tab_local(1)
|
||||||
|
jorb = occ(j,1)
|
||||||
|
hii += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! beta - beta
|
||||||
|
do i = 1, elec_num_tab_local(2)
|
||||||
|
iorb = occ(i,2)
|
||||||
|
hii += mo_mono_elec_integral(iorb,iorb)
|
||||||
|
do j = i+1, elec_num_tab_local(2)
|
||||||
|
jorb = occ(j,2)
|
||||||
|
hii += mo_bielec_integral_jj_anti(jorb,iorb)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! alpha - beta
|
||||||
|
do i = 1, elec_num_tab_local(2)
|
||||||
|
iorb = occ(i,2)
|
||||||
|
do j = 1, elec_num_tab_local(1)
|
||||||
|
jorb = occ(j,1)
|
||||||
|
hii += mo_bielec_integral_jj(jorb,iorb)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
@ -228,9 +228,7 @@ function new_zmq_pull_socket()
|
|||||||
character*(8), external :: zmq_port
|
character*(8), external :: zmq_port
|
||||||
integer(ZMQ_PTR) :: new_zmq_pull_socket
|
integer(ZMQ_PTR) :: new_zmq_pull_socket
|
||||||
|
|
||||||
print *, 'coucou'
|
|
||||||
call omp_set_lock(zmq_lock)
|
call omp_set_lock(zmq_lock)
|
||||||
print *, 'pouet'
|
|
||||||
if (zmq_context == 0_ZMQ_PTR) then
|
if (zmq_context == 0_ZMQ_PTR) then
|
||||||
stop 'zmq_context is uninitialized'
|
stop 'zmq_context is uninitialized'
|
||||||
endif
|
endif
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user