mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Bug in analyze_wf
This commit is contained in:
parent
0c190934a8
commit
7131a21be6
@ -3,6 +3,7 @@ program analyze_wf
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Wave function analyzis
|
! Wave function analyzis
|
||||||
END_DOC
|
END_DOC
|
||||||
|
PROVIDE mo_tot_num psi_det psi_coef
|
||||||
read_wf = .True.
|
read_wf = .True.
|
||||||
SOFT_TOUCH read_wf
|
SOFT_TOUCH read_wf
|
||||||
call run()
|
call run()
|
||||||
@ -29,11 +30,11 @@ subroutine run
|
|||||||
write(*,'(A)') '============='
|
write(*,'(A)') '============='
|
||||||
write(*,'(A)') ''
|
write(*,'(A)') ''
|
||||||
do istate=1,N_states
|
do istate=1,N_states
|
||||||
call get_occupation_from_dets(occupation,istate)
|
|
||||||
write(*,'(A)') ''
|
write(*,'(A)') ''
|
||||||
write(*,'(A,I3)'), 'State ', istate
|
write(*,'(A,I3)'), 'State ', istate
|
||||||
write(*,'(A)') '---------------'
|
write(*,'(A)') '---------------'
|
||||||
write(*,'(A)') ''
|
write(*,'(A)') ''
|
||||||
|
call get_occupation_from_dets(istate,occupation)
|
||||||
write (*,'(A)') '======== ================'
|
write (*,'(A)') '======== ================'
|
||||||
class = 0
|
class = 0
|
||||||
do i=1,mo_tot_num
|
do i=1,mo_tot_num
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
subroutine get_occupation_from_dets(occupation, istate)
|
subroutine get_occupation_from_dets(istate,occupation)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(out) :: occupation(mo_tot_num)
|
double precision, intent(out) :: occupation(mo_tot_num)
|
||||||
integer, intent(in) :: istate
|
integer, intent(in) :: istate
|
||||||
@ -9,6 +9,8 @@ subroutine get_occupation_from_dets(occupation, istate)
|
|||||||
integer :: list(N_int*bit_kind_size,2)
|
integer :: list(N_int*bit_kind_size,2)
|
||||||
integer :: n_elements(2)
|
integer :: n_elements(2)
|
||||||
double precision :: c
|
double precision :: c
|
||||||
|
ASSERT (istate > 0)
|
||||||
|
ASSERT (istate <= N_states)
|
||||||
|
|
||||||
occupation = 0.d0
|
occupation = 0.d0
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -16,6 +18,7 @@ subroutine get_occupation_from_dets(occupation, istate)
|
|||||||
call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int)
|
call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int)
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
do j=1,n_elements(ispin)
|
do j=1,n_elements(ispin)
|
||||||
|
ASSERT ( list(j,ispin) < mo_tot_num )
|
||||||
occupation( list(j,ispin) ) += c
|
occupation( list(j,ispin) ) += c
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
Loading…
Reference in New Issue
Block a user