10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-04 13:13:57 +01:00
quantum_package/plugins/analyze_wf/occupation.irp.f

31 lines
926 B
Fortran
Raw Normal View History

2017-12-04 10:31:54 +01:00
subroutine get_occupation_from_dets(istate,occupation)
2016-12-19 13:27:16 +01:00
implicit none
double precision, intent(out) :: occupation(mo_tot_num)
integer, intent(in) :: istate
BEGIN_DOC
! Returns the average occupation of the MOs
END_DOC
integer :: i,j, ispin
integer :: list(N_int*bit_kind_size,2)
integer :: n_elements(2)
2018-04-09 18:34:45 +02:00
double precision :: c, norm_2
2017-12-04 10:31:54 +01:00
ASSERT (istate > 0)
ASSERT (istate <= N_states)
2016-12-19 13:27:16 +01:00
occupation = 0.d0
2018-04-09 18:34:45 +02:00
double precision, external :: u_dot_u
norm_2 = 1.d0/u_dot_u(psi_coef(1,istate),N_det)
2016-12-19 13:27:16 +01:00
do i=1,N_det
2018-04-09 18:34:45 +02:00
c = psi_coef(i,istate)*psi_coef(i,istate)*norm_2
2016-12-19 13:27:16 +01:00
call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int)
do ispin=1,2
do j=1,n_elements(ispin)
2017-12-04 10:31:54 +01:00
ASSERT ( list(j,ispin) < mo_tot_num )
2016-12-19 13:27:16 +01:00
occupation( list(j,ispin) ) += c
enddo
enddo
enddo
end