LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

compute s_z2_sz in diag_S_mat_elem

Browse Source
This commit is contained in:
Kevin Gasperich 2020-08-21 12:30:14 -05:00 committed by GitHub
parent 253ec57ae0
commit 770b4f6628
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/determinants/s2.irp.f
View File

@ -8,24 +8,35 @@ double precision function diag_S_mat_elem(key_i,Nint)
BEGIN_DOC
! Returns <i|S^2|i>
END_DOC
integer :: nup, i
integer(bit_kind) :: xorvec(N_int_max)
integer :: nup, ntot, i
integer(bit_kind) :: xorvec(N_int_max), upvec(N_int_max)
do i=1,Nint
xorvec(i) = xor(key_i(i,1),key_i(i,2))
enddo
do i=1,Nint
xorvec(i) = iand(xorvec(i),key_i(i,1))
upvec(i) = iand(xorvec(i),key_i(i,1))
enddo
! nup is number of alpha unpaired
! ntot is total number of unpaired
nup = 0
ntot = 0
do i=1,Nint
if (xorvec(i) /= 0_bit_kind) then
nup += popcnt(xorvec(i))
ntot += popcnt(xorvec(i))
if (upvec(i) /= 0_bit_kind) then
nup += popcnt(upvec(i))
endif
endif
enddo
diag_S_mat_elem = dble(nup)
double precision :: sz
sz = nup - 0.5d0*ntot
!<S^2> = <S+ S-> + Sz(Sz-1)
diag_S_mat_elem = nup + sz*(sz-1)
end