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

Fixed bug in generate connected Is. #143.

This commit is contained in:
v1j4y 2021-02-02 20:20:16 +01:00
parent 1117aa454f
commit d1dbe58010
2 changed files with 13 additions and 9 deletions

View File

@ -48,7 +48,7 @@
nholes = 0 nholes = 0
! holes in SOMO ! holes in SOMO
do i = n_core_orb+1,n_core_orb + n_act_orb do i = n_core_orb+1,n_core_orb + n_act_orb
if(POPCNT(IAND(Isomo,IBSET(0,i-1))) .EQ. 1) then if(POPCNT(IAND(Isomo,IBSET(0_8,i-1))) .EQ. 1) then
nholes += 1 nholes += 1
listholes(nholes) = i listholes(nholes) = i
holetype(nholes) = 1 holetype(nholes) = 1
@ -56,7 +56,7 @@
end do end do
! holes in DOMO ! holes in DOMO
do i = n_core_orb+1,n_core_orb + n_act_orb do i = n_core_orb+1,n_core_orb + n_act_orb
if(POPCNT(IAND(Idomo,IBSET(0,i-1))) .EQ. 1) then if(POPCNT(IAND(Idomo,IBSET(0_8,i-1))) .EQ. 1) then
nholes += 1 nholes += 1
listholes(nholes) = i listholes(nholes) = i
holetype(nholes) = 2 holetype(nholes) = 2
@ -68,12 +68,12 @@
vmotype = -1 vmotype = -1
nvmos = 0 nvmos = 0
do i = n_core_orb+1,n_core_orb + n_act_orb do i = n_core_orb+1,n_core_orb + n_act_orb
!print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0,i-1)))), POPCNT(IAND(Idomo,(IBSET(0,i-1)))) !print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1))))
if(POPCNT(IAND(Isomo,(IBSET(0,i-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0,i-1)))) .EQ. 0) then if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) .EQ. 0) then
nvmos += 1 nvmos += 1
listvmos(nvmos) = i listvmos(nvmos) = i
vmotype(nvmos) = 1 vmotype(nvmos) = 1
else if(POPCNT(IAND(Isomo,(IBSET(0,i-1)))) .EQ. 1 .AND. POPCNT(IAND(Idomo,(IBSET(0,i-1)))) .EQ. 0 ) then else if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 1 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) .EQ. 0 ) then
nvmos += 1 nvmos += 1
listvmos(nvmos) = i listvmos(nvmos) = i
vmotype(nvmos) = 2 vmotype(nvmos) = 2
@ -219,7 +219,7 @@
end subroutine end subroutine
subroutine obtain_connected_I_foralpha(Ialpha, connectedI, nconnectedI, excitationIds, excitationTypes) subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, nconnectedI, excitationIds, excitationTypes)
implicit none implicit none
use bitmasks use bitmasks
BEGIN_DOC BEGIN_DOC
@ -237,6 +237,7 @@ subroutine obtain_connected_I_foralpha(Ialpha, connectedI, nconnectedI, excitati
! Order of operators ! Order of operators
! \alpha> = a^\dag_p a_q |I> = E_pq |I> ! \alpha> = a^\dag_p a_q |I> = E_pq |I>
END_DOC END_DOC
integer ,intent(in) :: idxI
integer(bit_kind),intent(in) :: Ialpha(N_int,2) integer(bit_kind),intent(in) :: Ialpha(N_int,2)
integer(bit_kind),intent(out) :: connectedI(N_int,2,*) integer(bit_kind),intent(out) :: connectedI(N_int,2,*)
integer,intent(out) :: nconnectedI integer,intent(out) :: nconnectedI
@ -256,7 +257,7 @@ subroutine obtain_connected_I_foralpha(Ialpha, connectedI, nconnectedI, excitati
p = 0 p = 0
q = 0 q = 0
do i=1,N_configuration do i=idxI,N_configuration
Isomo = Ialpha(1,1) Isomo = Ialpha(1,1)
Idomo = Ialpha(1,2) Idomo = Ialpha(1,2)
Jsomo = psi_configuration(1,1,i) Jsomo = psi_configuration(1,1,i)
@ -364,6 +365,7 @@ subroutine convertOrbIdsToModelSpaceIds(Ialpha, Jcfg, p, q, extype, pmodel, qmod
integer*8 :: mask integer*8 :: mask
integer :: pos0,pos0prev integer :: pos0,pos0prev
! TODO Flag (print) when model space indices is > 64
Isomo = Ialpha(1,1) Isomo = Ialpha(1,1)
Idomo = Ialpha(1,2) Idomo = Ialpha(1,2)
Jsomo = Jcfg(1,1) Jsomo = Jcfg(1,1)

View File

@ -244,7 +244,7 @@ Next step is to obtain the connected CFGs \(|I\rangle\) that belong to the selec
given a RI configuration \(|\alpha\rangle\). given a RI configuration \(|\alpha\rangle\).
#+begin_src f90 :main no :tangle configuration_CI_sigma_helpers.irp.f #+begin_src f90 :main no :tangle configuration_CI_sigma_helpers.irp.f
subroutine obtain_connected_I_foralpha(Ialpha, connectedI, nconnectedI, excitationIds, excitationTypes) subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, nconnectedI, excitationIds, excitationTypes)
implicit none implicit none
use bitmasks use bitmasks
BEGIN_DOC BEGIN_DOC
@ -262,6 +262,7 @@ subroutine obtain_connected_I_foralpha(Ialpha, connectedI, nconnectedI, excitati
! Order of operators ! Order of operators
! \alpha> = a^\dag_p a_q |I> = E_pq |I> ! \alpha> = a^\dag_p a_q |I> = E_pq |I>
END_DOC END_DOC
integer ,intent(in) :: idxI
integer(bit_kind),intent(in) :: Ialpha(N_int,2) integer(bit_kind),intent(in) :: Ialpha(N_int,2)
integer(bit_kind),intent(out) :: connectedI(N_int,2,*) integer(bit_kind),intent(out) :: connectedI(N_int,2,*)
integer,intent(out) :: nconnectedI integer,intent(out) :: nconnectedI
@ -281,7 +282,7 @@ subroutine obtain_connected_I_foralpha(Ialpha, connectedI, nconnectedI, excitati
p = 0 p = 0
q = 0 q = 0
do i=1,N_configuration do i=idxI,N_configuration
Isomo = Ialpha(1,1) Isomo = Ialpha(1,1)
Idomo = Ialpha(1,2) Idomo = Ialpha(1,2)
Jsomo = psi_configuration(1,1,i) Jsomo = psi_configuration(1,1,i)
@ -412,6 +413,7 @@ subroutine convertOrbIdsToModelSpaceIds(Ialpha, Jcfg, p, q, extype, pmodel, qmod
integer*8 :: mask integer*8 :: mask
integer :: pos0,pos0prev integer :: pos0,pos0prev
! TODO Flag (print) when model space indices is > 64
Isomo = Ialpha(1,1) Isomo = Ialpha(1,1)
Idomo = Ialpha(1,2) Idomo = Ialpha(1,2)
Jsomo = Jcfg(1,1) Jsomo = Jcfg(1,1)