mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
CSC storage for singles alpha
This commit is contained in:
parent
fd882fc0c9
commit
a888564851
@ -107,6 +107,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
|
|||||||
integer, allocatable :: idx(:), idx0(:)
|
integer, allocatable :: idx(:), idx0(:)
|
||||||
logical, allocatable :: is_single_a(:)
|
logical, allocatable :: is_single_a(:)
|
||||||
integer :: maxab, n_singles_a, kcol_prev, nmax
|
integer :: maxab, n_singles_a, kcol_prev, nmax
|
||||||
|
integer*8 :: k8
|
||||||
double precision, allocatable :: v_t(:,:), s_t(:,:)
|
double precision, allocatable :: v_t(:,:), s_t(:,:)
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: v_t, s_t
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: v_t, s_t
|
||||||
|
|
||||||
@ -129,14 +130,15 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
|
|||||||
!$OMP psi_bilinear_matrix_transp_columns, &
|
!$OMP psi_bilinear_matrix_transp_columns, &
|
||||||
!$OMP psi_bilinear_matrix_transp_order, N_st, &
|
!$OMP psi_bilinear_matrix_transp_order, N_st, &
|
||||||
!$OMP psi_bilinear_matrix_order_transp_reverse, &
|
!$OMP psi_bilinear_matrix_order_transp_reverse, &
|
||||||
!$OMP singles_alpha, psi_bilinear_matrix_columns_loc, &
|
!$OMP singles_alpha_csc, singles_alpha_csc_idx, &
|
||||||
|
!$OMP psi_bilinear_matrix_columns_loc, &
|
||||||
!$OMP singles_alpha_size, sze_8, istart, iend, istep, &
|
!$OMP singles_alpha_size, sze_8, istart, iend, istep, &
|
||||||
!$OMP ishift, idx0, u_t, maxab, v_0, s_0) &
|
!$OMP ishift, idx0, u_t, maxab, v_0, s_0) &
|
||||||
!$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, &
|
!$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, is_single_a,l_a, l_b, nmax, &
|
||||||
!$OMP buffer, singles, doubles, n_singles, n_doubles, &
|
!$OMP buffer, singles, doubles, n_singles, n_doubles, &
|
||||||
!$OMP tmp_det2, hij, sij, idx, l, kcol_prev, v_t, &
|
!$OMP tmp_det2, hij, sij, idx, l, kcol_prev, v_t, &
|
||||||
!$OMP singles_a, n_singles_a, s_t)
|
!$OMP singles_a, n_singles_a, s_t, k8)
|
||||||
|
|
||||||
! Alpha/Beta double excitations
|
! Alpha/Beta double excitations
|
||||||
! =============================
|
! =============================
|
||||||
@ -164,8 +166,8 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
|
|||||||
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int, krow)
|
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int, krow)
|
||||||
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int, kcol)
|
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int, kcol)
|
||||||
|
|
||||||
do k=1,singles_alpha(0,krow)
|
do k8=singles_alpha_csc_idx(krow), singles_alpha_csc_idx(krow+1)-1
|
||||||
is_single_a( singles_alpha(k,krow) ) = .True.
|
is_single_a( singles_alpha_csc(k8) ) = .True.
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if (kcol /= kcol_prev) then
|
if (kcol /= kcol_prev) then
|
||||||
@ -208,8 +210,8 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif
|
|||||||
l_a = l_a+1
|
l_a = l_a+1
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do k=1,singles_alpha(0,krow)
|
do k8=singles_alpha_csc_idx(krow), singles_alpha_csc_idx(krow+1)-1
|
||||||
is_single_a( singles_alpha(k,krow) ) = .False.
|
is_single_a( singles_alpha_csc(k8) ) = .False.
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|||||||
@ -706,17 +706,17 @@ subroutine get_all_spin_singles_and_doubles(buffer, idx, spindet, Nint, size_buf
|
|||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree
|
||||||
|
|
||||||
! select case (Nint)
|
select case (Nint)
|
||||||
! case (1)
|
case (1)
|
||||||
! call get_all_spin_singles_and_doubles_1(buffer, idx, spindet(1), size_buffer, singles, doubles, n_singles, n_doubles)
|
call get_all_spin_singles_and_doubles_1(buffer, idx, spindet(1), size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
! return
|
return
|
||||||
! case (2)
|
! case (2)
|
||||||
! call get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
! call get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
! return
|
! return
|
||||||
! case (3)
|
! case (3)
|
||||||
! call get_all_spin_singles_and_doubles_3(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
! call get_all_spin_singles_and_doubles_3(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
! return
|
! return
|
||||||
! end select
|
end select
|
||||||
|
|
||||||
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
@ -780,17 +780,17 @@ subroutine get_all_spin_singles(buffer, idx, spindet, Nint, size_buffer, singles
|
|||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
||||||
|
|
||||||
! select case (Nint)
|
select case (Nint)
|
||||||
! case (1)
|
case (1)
|
||||||
! call get_all_spin_singles_1(buffer, idx, spindet(1), size_buffer, singles, n_singles)
|
call get_all_spin_singles_1(buffer, idx, spindet(1), size_buffer, singles, n_singles)
|
||||||
! return
|
return
|
||||||
! case (2)
|
! case (2)
|
||||||
! call get_all_spin_singles_2(buffer, idx, spindet, size_buffer, singles, n_singles)
|
! call get_all_spin_singles_2(buffer, idx, spindet, size_buffer, singles, n_singles)
|
||||||
! return
|
! return
|
||||||
! case (3)
|
! case (3)
|
||||||
! call get_all_spin_singles_3(buffer, idx, spindet, size_buffer, singles, n_singles)
|
! call get_all_spin_singles_3(buffer, idx, spindet, size_buffer, singles, n_singles)
|
||||||
! return
|
! return
|
||||||
! end select
|
end select
|
||||||
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
@ -807,7 +807,7 @@ subroutine get_all_spin_singles(buffer, idx, spindet, Nint, size_buffer, singles
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
do k=2,Nint
|
do k=2,Nint
|
||||||
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
if ( (degree <= 2).and.(xorvec(k) /= 0_8) ) then
|
||||||
degree = degree + popcnt(xorvec(k))
|
degree = degree + popcnt(xorvec(k))
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -844,17 +844,17 @@ subroutine get_all_spin_doubles(buffer, idx, spindet, Nint, size_buffer, doubles
|
|||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
||||||
|
|
||||||
! select case (Nint)
|
select case (Nint)
|
||||||
! case (1)
|
case (1)
|
||||||
! call get_all_spin_doubles_1(buffer, idx, spindet(1), size_buffer, doubles, n_doubles)
|
call get_all_spin_doubles_1(buffer, idx, spindet(1), size_buffer, doubles, n_doubles)
|
||||||
! return
|
return
|
||||||
! case (2)
|
case (2)
|
||||||
! call get_all_spin_doubles_2(buffer, idx, spindet, size_buffer, doubles, n_doubles)
|
call get_all_spin_doubles_2(buffer, idx, spindet, size_buffer, doubles, n_doubles)
|
||||||
! return
|
return
|
||||||
! case (3)
|
! case (3)
|
||||||
! call get_all_spin_doubles_3(buffer, idx, spindet, size_buffer, doubles, n_doubles)
|
! call get_all_spin_doubles_3(buffer, idx, spindet, size_buffer, doubles, n_doubles)
|
||||||
! return
|
! return
|
||||||
! end select
|
end select
|
||||||
|
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
@ -916,12 +916,51 @@ BEGIN_PROVIDER [ integer, singles_alpha_size ]
|
|||||||
singles_alpha_size = elec_alpha_num * (mo_tot_num - elec_alpha_num)
|
singles_alpha_size = elec_alpha_num * (mo_tot_num - elec_alpha_num)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, singles_alpha, (0:singles_alpha_size, N_det_alpha_unique) ]
|
BEGIN_PROVIDER [ integer*8, singles_alpha_csc_idx, (N_det_alpha_unique+1) ]
|
||||||
|
&BEGIN_PROVIDER [ integer*8, singles_alpha_csc_size ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Dimension of the singles_alpha array
|
! Dimension of the singles_alpha array
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i
|
integer :: i,j
|
||||||
|
integer, allocatable :: idx0(:), s(:)
|
||||||
|
allocate (idx0(N_det_alpha_unique))
|
||||||
|
do i=1, N_det_alpha_unique
|
||||||
|
idx0(i) = i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP SHARED(N_det_alpha_unique, psi_det_alpha_unique, &
|
||||||
|
!$OMP idx0, N_int, singles_alpha_csc, &
|
||||||
|
!$OMP singles_alpha_size, singles_alpha_csc_idx) &
|
||||||
|
!$OMP PRIVATE(i,s,j)
|
||||||
|
allocate (s(singles_alpha_size))
|
||||||
|
!$OMP DO SCHEDULE(static,1)
|
||||||
|
do i=1, N_det_alpha_unique
|
||||||
|
call get_all_spin_singles( &
|
||||||
|
psi_det_alpha_unique, idx0, psi_det_alpha_unique(1,i), N_int, &
|
||||||
|
N_det_alpha_unique, s, j)
|
||||||
|
singles_alpha_csc_idx(i+1) = int(j,8)
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
deallocate(s)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
deallocate(idx0)
|
||||||
|
|
||||||
|
singles_alpha_csc_idx(1) = 1_8
|
||||||
|
do i=2, N_det_alpha_unique+1
|
||||||
|
singles_alpha_csc_idx(i) = singles_alpha_csc_idx(i) + singles_alpha_csc_idx(i-1)
|
||||||
|
enddo
|
||||||
|
singles_alpha_csc_size = singles_alpha_csc_idx(N_det_alpha_unique+1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, singles_alpha_csc, (singles_alpha_csc_size) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Dimension of the singles_alpha array
|
||||||
|
END_DOC
|
||||||
|
integer :: i, k
|
||||||
integer, allocatable :: idx0(:)
|
integer, allocatable :: idx0(:)
|
||||||
allocate (idx0(N_det_alpha_unique))
|
allocate (idx0(N_det_alpha_unique))
|
||||||
do i=1, N_det_alpha_unique
|
do i=1, N_det_alpha_unique
|
||||||
@ -929,16 +968,295 @@ BEGIN_PROVIDER [ integer, singles_alpha, (0:singles_alpha_size, N_det_alpha_uniq
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||||
!$OMP SHARED(singles_alpha, N_det_alpha_unique, psi_det_alpha_unique, &
|
!$OMP SHARED(N_det_alpha_unique, psi_det_alpha_unique, &
|
||||||
!$OMP idx0, N_int) &
|
!$OMP idx0, N_int, singles_alpha_csc, singles_alpha_csc_idx) &
|
||||||
!$OMP PRIVATE(i) SCHEDULE(static,1)
|
!$OMP PRIVATE(i,k) SCHEDULE(static,1)
|
||||||
do i=1, N_det_alpha_unique
|
do i=1, N_det_alpha_unique
|
||||||
call get_all_spin_singles( &
|
call get_all_spin_singles( &
|
||||||
psi_det_alpha_unique, idx0, psi_det_alpha_unique(1,i), N_int, &
|
psi_det_alpha_unique, idx0, psi_det_alpha_unique(1,i), N_int, &
|
||||||
N_det_alpha_unique, singles_alpha(1,i), singles_alpha(0,i))
|
N_det_alpha_unique, singles_alpha_csc(singles_alpha_csc_idx(i)), &
|
||||||
|
k)
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
deallocate(idx0)
|
deallocate(idx0)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Returns the indices of all the single and double excitations in the list of
|
||||||
|
! unique alpha determinants.
|
||||||
|
!
|
||||||
|
! /!\ : The buffer is transposed !
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: size_buffer, idx(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: buffer(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: spindet
|
||||||
|
integer, intent(out) :: singles(size_buffer)
|
||||||
|
integer, intent(out) :: doubles(size_buffer)
|
||||||
|
integer, intent(out) :: n_singles
|
||||||
|
integer, intent(out) :: n_doubles
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
include 'Utils/constants.include.F'
|
||||||
|
integer :: degree
|
||||||
|
|
||||||
|
|
||||||
|
n_singles = 1
|
||||||
|
n_doubles = 1
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do i=1,size_buffer
|
||||||
|
degree = popcnt( xor( spindet, buffer(i) ) )
|
||||||
|
if ( degree == 4 ) then
|
||||||
|
doubles(n_doubles) = idx(i)
|
||||||
|
n_doubles = n_doubles+1
|
||||||
|
else if ( degree == 2 ) then
|
||||||
|
singles(n_singles) = idx(i)
|
||||||
|
n_singles = n_singles+1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
n_singles = n_singles-1
|
||||||
|
n_doubles = n_doubles-1
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_all_spin_singles_1(buffer, idx, spindet, size_buffer, singles, n_singles)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Returns the indices of all the single excitations in the list of
|
||||||
|
! unique alpha determinants.
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: size_buffer, idx(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: buffer(size_buffer)
|
||||||
|
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 :: degree
|
||||||
|
|
||||||
|
n_singles = 1
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do i=1,size_buffer
|
||||||
|
degree = popcnt(xor( spindet, buffer(i) ))
|
||||||
|
if ( degree == 2 ) then
|
||||||
|
singles(n_singles) = idx(i)
|
||||||
|
n_singles = n_singles+1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
n_singles = n_singles-1
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_all_spin_doubles_1(buffer, idx, spindet, size_buffer, doubles, n_doubles)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Returns the indices of all the double excitations in the list of
|
||||||
|
! unique alpha determinants.
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: size_buffer, idx(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: buffer(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: spindet
|
||||||
|
integer, intent(out) :: doubles(size_buffer)
|
||||||
|
integer, intent(out) :: n_doubles
|
||||||
|
integer :: i
|
||||||
|
include 'Utils/constants.include.F'
|
||||||
|
integer :: degree
|
||||||
|
|
||||||
|
n_doubles = 1
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do i=1,size_buffer
|
||||||
|
degree = popcnt(xor( spindet, buffer(i) ))
|
||||||
|
if ( degree == 4 ) then
|
||||||
|
doubles(n_doubles) = idx(i)
|
||||||
|
n_doubles = n_doubles+1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
n_doubles = n_doubles-1
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Returns the indices of all the single and double excitations in the list of
|
||||||
|
! unique alpha determinants.
|
||||||
|
!
|
||||||
|
! /!\ : The buffer is transposed !
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: size_buffer, idx(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: buffer(2,size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: spindet(2)
|
||||||
|
integer, intent(out) :: singles(size_buffer)
|
||||||
|
integer, intent(out) :: doubles(size_buffer)
|
||||||
|
integer, intent(out) :: n_singles
|
||||||
|
integer, intent(out) :: n_doubles
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
include 'Utils/constants.include.F'
|
||||||
|
integer(bit_kind) :: xorvec(2)
|
||||||
|
integer :: degree
|
||||||
|
|
||||||
|
integer, external :: align_double
|
||||||
|
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree
|
||||||
|
|
||||||
|
n_singles = 1
|
||||||
|
n_doubles = 1
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do i=1,size_buffer
|
||||||
|
|
||||||
|
xorvec(1) = xor( spindet(1), buffer(1,i) )
|
||||||
|
xorvec(2) = xor( spindet(2), buffer(2,i) )
|
||||||
|
|
||||||
|
if (xorvec(1) /= 0_8) then
|
||||||
|
degree = popcnt(xorvec(1))
|
||||||
|
else
|
||||||
|
degree = 0
|
||||||
|
endif
|
||||||
|
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
if ( (degree <= 4).and.(xorvec(2) /= 0_8) ) then
|
||||||
|
degree = degree + popcnt(xorvec(2))
|
||||||
|
endif
|
||||||
|
|
||||||
|
if ( degree == 4 ) then
|
||||||
|
doubles(n_doubles) = idx(i)
|
||||||
|
n_doubles = n_doubles+1
|
||||||
|
else if ( degree == 2 ) then
|
||||||
|
singles(n_singles) = idx(i)
|
||||||
|
n_singles = n_singles+1
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
n_singles = n_singles-1
|
||||||
|
n_doubles = n_doubles-1
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_all_spin_singles_2(buffer, idx, spindet, size_buffer, singles, n_singles)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Returns the indices of all the single excitations in the list of
|
||||||
|
! unique alpha determinants.
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: size_buffer, idx(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: buffer(2,size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: spindet(2)
|
||||||
|
integer, intent(out) :: singles(size_buffer)
|
||||||
|
integer, intent(out) :: n_singles
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
include 'Utils/constants.include.F'
|
||||||
|
integer(bit_kind) :: xorvec(2)
|
||||||
|
integer :: degree
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
||||||
|
|
||||||
|
n_singles = 1
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do i=1,size_buffer
|
||||||
|
|
||||||
|
xorvec(1) = xor( spindet(1), buffer(1,i) )
|
||||||
|
xorvec(2) = xor( spindet(2), buffer(2,i) )
|
||||||
|
|
||||||
|
if (xorvec(1) /= 0_8) then
|
||||||
|
degree = popcnt(xorvec(1))
|
||||||
|
else
|
||||||
|
degree = 0
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (degree > 2) cycle
|
||||||
|
|
||||||
|
if ( xorvec(2) /= 0_8 ) then
|
||||||
|
degree = degree + popcnt(xorvec(2))
|
||||||
|
endif
|
||||||
|
|
||||||
|
if ( degree == 2 ) then
|
||||||
|
singles(n_singles) = idx(i)
|
||||||
|
n_singles = n_singles+1
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
n_singles = n_singles-1
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_all_spin_doubles_2(buffer, idx, spindet, size_buffer, doubles, n_doubles)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Returns the indices of all the double excitations in the list of
|
||||||
|
! unique alpha determinants.
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: size_buffer, idx(size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: buffer(2,size_buffer)
|
||||||
|
integer(bit_kind), intent(in) :: spindet(2)
|
||||||
|
integer, intent(out) :: doubles(size_buffer)
|
||||||
|
integer, intent(out) :: n_doubles
|
||||||
|
|
||||||
|
integer :: i, degree
|
||||||
|
include 'Utils/constants.include.F'
|
||||||
|
integer(bit_kind) :: xorvec(2)
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
||||||
|
|
||||||
|
n_doubles = 1
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
do i=1,size_buffer
|
||||||
|
|
||||||
|
xorvec(1) = xor( spindet(1), buffer(1,i) )
|
||||||
|
xorvec(2) = xor( spindet(2), buffer(2,i) )
|
||||||
|
|
||||||
|
if (xorvec(1) /= 0_8) then
|
||||||
|
degree = popcnt(xorvec(1))
|
||||||
|
else
|
||||||
|
degree = 0
|
||||||
|
endif
|
||||||
|
|
||||||
|
!DIR$ VECTOR ALIGNED
|
||||||
|
if ( (degree <= 4).and.(xorvec(2) /= 0_8) ) then
|
||||||
|
degree = degree + popcnt(xorvec(2))
|
||||||
|
endif
|
||||||
|
|
||||||
|
if ( degree == 4 ) then
|
||||||
|
doubles(n_doubles) = idx(i)
|
||||||
|
n_doubles = n_doubles+1
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
n_doubles = n_doubles-1
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user