mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-06-02 03:15:25 +02:00
82 lines
1.7 KiB
Fortran
82 lines
1.7 KiB
Fortran
subroutine generate_fci_space
|
|
use bitmasks
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Generates the complete FCI space
|
|
END_DOC
|
|
integer :: i, sze, ncore
|
|
integer(bit_kind) :: o(N_int,2)
|
|
integer(bit_kind) :: u, coremask
|
|
|
|
if (mo_num > 64) then
|
|
stop 'No more than 64 MOs'
|
|
endif
|
|
|
|
ncore = 0
|
|
coremask = 0_bit_kind
|
|
do i=1,mo_num
|
|
if (trim(mo_class(i)) == 'Core') then
|
|
ncore += 1
|
|
coremask = ibset(coremask,i-1)
|
|
endif
|
|
enddo
|
|
o(1,1) = iand(full_ijkl_bitmask(1),not(coremask))
|
|
o(1,2) = 0_bit_kind
|
|
|
|
call configuration_to_dets_size(o,n_det_alpha_unique,elec_alpha_num-ncore,N_int)
|
|
TOUCH n_det_alpha_unique
|
|
|
|
integer :: k,n,m
|
|
integer(bit_kind) :: t, t1, t2
|
|
k=0
|
|
n = elec_alpha_num
|
|
m = mo_num - n
|
|
n = n
|
|
|
|
u = shiftl(1_bit_kind,n) -1
|
|
do while (u < shiftl(1_bit_kind,n+m))
|
|
if (iand(coremask, u) == coremask) then
|
|
k = k+1
|
|
psi_det_alpha_unique(1,k) = u
|
|
endif
|
|
t = ior(u,u-1)
|
|
t1 = t+1
|
|
IRP_IF WITHOUT_TRAILZ
|
|
t2 = shiftr((iand(not(t),t1)-1), popcnt(ieor(u,u-1)))
|
|
IRP_ELSE
|
|
t2 = shiftr((iand(not(t),t1)-1), trailz(u)+1)
|
|
IRP_ENDIF
|
|
u = ior(t1,t2)
|
|
enddo
|
|
|
|
|
|
call configuration_to_dets_size(o,n_det_beta_unique,elec_beta_num-ncore,N_int)
|
|
TOUCH n_det_beta_unique
|
|
|
|
k=0
|
|
n = elec_beta_num
|
|
m = mo_num - n
|
|
u = shiftl(1_bit_kind,n) -1
|
|
do while (u < shiftl(1_bit_kind,n+m))
|
|
if (iand(coremask, u) == coremask) then
|
|
k = k+1
|
|
psi_det_beta_unique(1,k) = u
|
|
endif
|
|
t = ior(u,u-1)
|
|
t1 = t+1
|
|
IRP_IF WITHOUT_TRAILZ
|
|
t2 = shiftr((iand(not(t),t1)-1), popcnt(ieor(u,u-1)))
|
|
IRP_ELSE
|
|
t2 = shiftr((iand(not(t),t1)-1), trailz(u)+1)
|
|
IRP_ENDIF
|
|
u = ior(t1,t2)
|
|
enddo
|
|
|
|
call generate_all_alpha_beta_det_products
|
|
|
|
print *, N_det
|
|
|
|
|
|
end
|
|
|