LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 12:23:48 +01:00
Code Issues Releases Wiki Activity

Bug in analyze_wf

Browse Source
This commit is contained in:
Anthony Scemama 2017-12-04 10:31:54 +01:00
parent 0c190934a8
commit 7131a21be6
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
plugins/analyze_wf/analyze_wf.irp.f
View File

@ -3,6 +3,7 @@ program analyze_wf
BEGIN_DOC
! Wave function analyzis
END_DOC
PROVIDE mo_tot_num psi_det psi_coef
read_wf = .True.
SOFT_TOUCH read_wf
call run()
@ -29,11 +30,11 @@ subroutine run
write(*,'(A)') '============='
write(*,'(A)') ''
do istate=1,N_states
call get_occupation_from_dets(occupation,istate)
write(*,'(A)') ''
write(*,'(A,I3)'), 'State ', istate
write(*,'(A)') '---------------'
write(*,'(A)') ''
call get_occupation_from_dets(istate,occupation)
write (*,'(A)') '======== ================'
class = 0
do i=1,mo_tot_num

5
plugins/analyze_wf/occupation.irp.f
View File

@ -1,4 +1,4 @@
subroutine get_occupation_from_dets(occupation, istate)
subroutine get_occupation_from_dets(istate,occupation)
implicit none
double precision, intent(out) :: occupation(mo_tot_num)
integer, intent(in) :: istate
@ -9,6 +9,8 @@ subroutine get_occupation_from_dets(occupation, istate)
integer :: list(N_int*bit_kind_size,2)
integer :: n_elements(2)
double precision :: c
ASSERT (istate > 0)
ASSERT (istate <= N_states)
occupation = 0.d0
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)
do ispin=1,2
do j=1,n_elements(ispin)
ASSERT ( list(j,ispin) < mo_tot_num )
occupation( list(j,ispin) ) += c
enddo
enddo