LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-03 10:05:57 +01:00
Code Issues Releases Wiki Activity

Fixed Davidson

Browse Source
This commit is contained in:
Anthony Scemama 2017-04-18 15:27:26 +02:00
parent ae0815bfac
commit 6b49eb5906
2 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Davidson/u0Hu0.irp.f
View File

@ -106,7 +106,6 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
integer, allocatable :: singles_a(:)
integer, allocatable :: singles_b(:)
integer, allocatable :: idx(:), idx0(:)
logical, allocatable :: is_single_a(:)
integer :: maxab, n_singles_a, n_singles_b, kcol_prev, nmax
integer*8 :: k8
double precision, allocatable :: v_t(:,:), s_t(:,:)
@ -136,7 +135,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
!$OMP singles_alpha_size, sze_8, istart, iend, istep, &
!$OMP ishift, idx0, u_t, maxab, v_0, s_0) &
!$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, &
!$OMP lcol, lrow, is_single_a,l_a, l_b, nmax, &
!$OMP lcol, lrow, l_a, l_b, nmax, &
!$OMP buffer, singles, doubles, n_singles, n_doubles, &
!$OMP tmp_det2, hij, sij, idx, l, kcol_prev, v_t, &
!$OMP singles_a, n_singles_a, singles_b, &
@ -151,9 +150,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
singles_b(maxab), &
doubles(maxab), &
idx(maxab), &
v_t(N_st,N_det), s_t(N_st,N_det), &
is_single_a(N_det_alpha_unique))
is_single_a = .False.
v_t(N_st,N_det), s_t(N_st,N_det))
kcol_prev=-1
v_t = 0.d0
@ -171,7 +168,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
if (kcol /= kcol_prev) then
call get_all_spin_singles( &
psi_det_beta_unique(1,kcol+1), idx0(kcol+1), tmp_det(1,2), N_int, N_det_beta_unique-kcol+2,&
psi_det_beta_unique(1,kcol+1), idx0(kcol+1), tmp_det(1,2), N_int, N_det_beta_unique-kcol,&
singles_b, n_singles_b)
endif
kcol_prev = kcol

7
src/Determinants/spindeterminants.irp.f
View File

@ -1043,12 +1043,13 @@ subroutine get_all_spin_singles_1(buffer, idx, spindet, size_buffer, singles, n_
integer(bit_kind), intent(in) :: spindet
integer, intent(out) :: singles(size_buffer)
integer, intent(out) :: n_singles
integer :: i
include 'Utils/constants.include.F'
integer :: i
integer(bit_kind) :: xorvec
integer :: degree
!DIR$ ATTRIBUTES ALIGN : 64 :: xorvec
include 'Utils/constants.include.F'
n_singles = 1
!DIR$ VECTOR ALIGNED
do i=1,size_buffer
degree = popcnt(xor( spindet, buffer(i) ))
if ( degree == 2 ) then