mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-30 12:43:40 +02:00
Rewrite get_phase_qp_to_cfg
This commit is contained in:
parent
1691c74539
commit
52701979ce
@ -1,9 +1,9 @@
|
|||||||
BEGIN_PROVIDER [ integer, NSOMOMax]
|
BEGIN_PROVIDER [ integer, NSOMOMax]
|
||||||
&BEGIN_PROVIDER [ integer, NCSFMax]
|
&BEGIN_PROVIDER [ integer, NCSFMax]
|
||||||
&BEGIN_PROVIDER [ integer*8, NMO]
|
&BEGIN_PROVIDER [ integer*8, NMO]
|
||||||
&BEGIN_PROVIDER [ integer, NBFMax]
|
&BEGIN_PROVIDER [ integer, NBFMax]
|
||||||
&BEGIN_PROVIDER [ integer, n_CSF]
|
&BEGIN_PROVIDER [ integer, n_CSF]
|
||||||
&BEGIN_PROVIDER [ integer, maxDetDimPerBF]
|
&BEGIN_PROVIDER [ integer, maxDetDimPerBF]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Documentation for NSOMOMax
|
! Documentation for NSOMOMax
|
||||||
@ -22,7 +22,7 @@
|
|||||||
integer NSOMO
|
integer NSOMO
|
||||||
integer dimcsfpercfg
|
integer dimcsfpercfg
|
||||||
integer detDimperBF
|
integer detDimperBF
|
||||||
real*8 :: coeff
|
real*8 :: coeff
|
||||||
integer MS
|
integer MS
|
||||||
integer ncfgpersomo
|
integer ncfgpersomo
|
||||||
detDimperBF = 0
|
detDimperBF = 0
|
||||||
@ -31,21 +31,20 @@
|
|||||||
n_CSF = cfg_seniority_index(0)-1
|
n_CSF = cfg_seniority_index(0)-1
|
||||||
ncfgprev = cfg_seniority_index(0)
|
ncfgprev = cfg_seniority_index(0)
|
||||||
do i = 0-iand(MS,1)+2, NSOMOMax,2
|
do i = 0-iand(MS,1)+2, NSOMOMax,2
|
||||||
if(cfg_seniority_index(i) .EQ. -1)then
|
if(cfg_seniority_index(i) .EQ. -1)then
|
||||||
ncfgpersomo = N_configuration + 1
|
ncfgpersomo = N_configuration + 1
|
||||||
else
|
else
|
||||||
ncfgpersomo = cfg_seniority_index(i)
|
ncfgpersomo = cfg_seniority_index(i)
|
||||||
endif
|
endif
|
||||||
ncfg = ncfgpersomo - ncfgprev
|
ncfg = ncfgpersomo - ncfgprev
|
||||||
!detDimperBF = max(1,nint((binom(i,(i+1)/2))))
|
!detDimperBF = max(1,nint((binom(i,(i+1)/2))))
|
||||||
dimcsfpercfg = max(1,nint((binom(i-2,(i-2+1)/2)-binom(i-2,((i-2+1)/2)+1))))
|
dimcsfpercfg = max(1,nint((binom(i-2,(i-2+1)/2)-binom(i-2,((i-2+1)/2)+1))))
|
||||||
n_CSF += ncfg * dimcsfpercfg
|
n_CSF += ncfg * dimcsfpercfg
|
||||||
!if(cfg_seniority_index(i+2) == -1) EXIT
|
!if(cfg_seniority_index(i+2) == -1) EXIT
|
||||||
!if(detDimperBF > maxDetDimPerBF) maxDetDimPerBF = detDimperBF
|
!if(detDimperBF > maxDetDimPerBF) maxDetDimPerBF = detDimperBF
|
||||||
ncfgprev = cfg_seniority_index(i)
|
ncfgprev = cfg_seniority_index(i)
|
||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
subroutine get_phase_qp_to_cfg(Ialpha, Ibeta, phaseout)
|
subroutine get_phase_qp_to_cfg(Ialpha, Ibeta, phaseout)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
@ -62,41 +61,44 @@ subroutine get_phase_qp_to_cfg(Ialpha, Ibeta, phaseout)
|
|||||||
integer(bit_kind),intent(in) :: Ialpha(N_int)
|
integer(bit_kind),intent(in) :: Ialpha(N_int)
|
||||||
integer(bit_kind),intent(in) :: Ibeta(N_int)
|
integer(bit_kind),intent(in) :: Ibeta(N_int)
|
||||||
real*8,intent(out) :: phaseout
|
real*8,intent(out) :: phaseout
|
||||||
integer(bit_kind) :: mask(N_int), deta(N_int), detb(N_int)
|
integer(bit_kind) :: mask, mask2(N_int), deta(N_int), detb(N_int)
|
||||||
integer :: nbetas
|
integer :: nbetas
|
||||||
integer :: count, k
|
integer :: count, k
|
||||||
if (N_int >1 ) then
|
|
||||||
stop 'TODO: get_phase_qp_to_cfg '
|
|
||||||
endif
|
|
||||||
|
|
||||||
nbetas = 0
|
! Remove the DOMOs
|
||||||
mask = 0_bit_kind
|
mask2 = IAND(Ialpha,Ibeta)
|
||||||
count = 0
|
deta = IEOR(Ialpha,mask2)
|
||||||
deta = Ialpha
|
detb = IEOR(Ibeta ,mask2)
|
||||||
detb = Ibeta
|
|
||||||
! remove the domos
|
! Find how many alpha electrons there are in all the N_ints
|
||||||
mask = IAND(deta,detb)
|
integer :: Na(N_int)
|
||||||
deta = IEOR(deta,mask)
|
do k=1,N_int
|
||||||
detb = IEOR(detb,mask)
|
Na(k) = popcnt(deta(k))
|
||||||
mask = 0
|
enddo
|
||||||
phaseout = 1.0
|
|
||||||
k = 1
|
integer :: shift, ipos, nperm
|
||||||
do while((deta(k)).GT.0_8)
|
phaseout = 1.d0
|
||||||
mask(k) = ISHFT(1_8,count)
|
do k=1,N_int
|
||||||
if(POPCNT(IAND(deta(k),mask(k))).EQ.1)then
|
|
||||||
if(IAND(nbetas,1).EQ.0) then
|
do while(detb(k) /= 0_bit_kind)
|
||||||
phaseout *= 1.0d0
|
! Find the lowest beta electron and clear it
|
||||||
else
|
ipos = trailz(detb(k))
|
||||||
phaseout *= -1.0d0
|
detb(k) = ibclr(detb(k),ipos)
|
||||||
endif
|
|
||||||
deta(k) = IEOR(deta(k),mask(k))
|
! Create a mask will all MOs higher than the beta electron
|
||||||
else
|
mask = not(shiftl(1_bit_kind,ipos+1) - 1_bit_kind)
|
||||||
if(POPCNT(IAND(detb(k),mask(k))).EQ.1) then
|
|
||||||
nbetas += 1
|
! Apply the mask to the alpha string to count how many electrons to cross
|
||||||
detb(k) = IEOR(detb(k),mask(k))
|
nperm = popcnt( iand(mask, deta(k)) )
|
||||||
endif
|
|
||||||
endif
|
! Count how many alpha electrons are above the beta electron in the other integers
|
||||||
count += 1
|
nperm = nperm + sum(Na(k+1:N_int))
|
||||||
|
if (iand(nperm,1) == 1) then
|
||||||
|
phaseout = -phaseout
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
end subroutine get_phase_qp_to_cfg
|
end subroutine get_phase_qp_to_cfg
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user