10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00

Corrected S^2 eigenfunction bug

This commit is contained in:
Anthony Scemama 2014-10-28 17:56:29 +01:00
parent 82a285774c
commit b983563551
2 changed files with 6 additions and 0 deletions

View File

@ -222,6 +222,9 @@ class H_apply(object):
self.data["size_max"] = str(1024*128) self.data["size_max"] = str(1024*128)
self.data["copy_buffer"] = """ self.data["copy_buffer"] = """
call copy_H_apply_buffer_to_wf call copy_H_apply_buffer_to_wf
if (s2_eig) then
call make_s2_eigenfunction
endif
SOFT_TOUCH psi_det psi_coef N_det SOFT_TOUCH psi_det psi_coef N_det
selection_criterion_min = min(selection_criterion_min, maxval(select_max))*0.1d0 selection_criterion_min = min(selection_criterion_min, maxval(select_max))*0.1d0
selection_criterion = selection_criterion_min selection_criterion = selection_criterion_min

View File

@ -148,6 +148,7 @@ subroutine make_s2_eigenfunction
integer, parameter :: bufsze = 1000 integer, parameter :: bufsze = 1000
logical, external :: is_in_wavefunction logical, external :: is_in_wavefunction
print *, irp_here
! !TODO DEBUG ! !TODO DEBUG
! do i=1,N_det ! do i=1,N_det
! do j=i+1,N_det ! do j=i+1,N_det
@ -174,9 +175,11 @@ subroutine make_s2_eigenfunction
do i=1,N_occ_pattern do i=1,N_occ_pattern
call occ_pattern_to_dets_size(psi_occ_pattern(1,1,i),s,elec_alpha_num,N_int) call occ_pattern_to_dets_size(psi_occ_pattern(1,1,i),s,elec_alpha_num,N_int)
s += 1
if (s > smax) then if (s > smax) then
deallocate(d) deallocate(d)
allocate ( d(N_int,2,s) ) allocate ( d(N_int,2,s) )
smax = s
endif endif
call occ_pattern_to_dets(psi_occ_pattern(1,1,i),d,s,elec_alpha_num,N_int) call occ_pattern_to_dets(psi_occ_pattern(1,1,i),d,s,elec_alpha_num,N_int)
do j=1,s do j=1,s