<commit_before>module determinant_enumeration

! Module for complete enumeration of determinant Hilbert space.
! Used only in FCI and simple_fciqmc calculations.
! Rather a memory hog! ;-)

use const
use determinants

implicit none

!--- Info for FCI calculations ---

! Store of determinant information.
! This will quickly become a memory issue, but for dealing with the FCI of small
! systems it is ok.

! Rather than creating an array of derived types containing information about
! each determinant, which leads to a serious memory overhead due to the need for
! pointers/allocatable arrays in the derived type, we instead create 3 separate
! variables.

! Bit list of the Slater determinant.  See note for f in determinants module.
! We only store determinants of the same Ms and (for momentum space
! calculations) same ksum at a time.
integer(i0), allocatable :: dets_list(:,:) ! (basis_length,ndets)

! Number of determinants stored in dets.
! This is the number of determinants enumerated in enumerate_determinants with
! the desired spin and momentum symmetry.
integer :: ndets

! Total (exact) size of determinant space.
! Number of determinants of each symmetry.
integer, allocatable :: sym_space_size(:) ! (nsym)

! If true then the determinant list is written to determinant_file.
logical :: write_determinants = .false.
character(255) :: determinant_file = 'DETS'
integer :: det_unit

contains

!--- Initialisation and finalisation ---

    subroutine init_determinant_enumeration()

        ! Initialise determinant enumeration info,
        ! Note that memory allocation is done in the determinant enumeration
        ! routines.

        use utils, only: get_free_unit

        if (write_determinants) then
            det_unit = get_free_unit()
            open(det_unit, file=determinant_file, status='unknown')
        end if

    end subroutine init_determinant_enumeration

    subroutine end_determinant_enumeration()

        ! Clean up.

        use checking, only: check_deallocate

        integer :: ierr

        if (allocated(dets_list)) then
            deallocate(dets_list, stat=ierr)
            call check_deallocate('dets_list',ierr)
        end if
        if (allocated(sym_space_size)) then
            deallocate(sym_space_size, stat=ierr)
            call check_deallocate('sym_space_size',ierr)
        end if

        if (write_determinants) close(det_unit, status='keep')

    end subroutine end_determinant_enumeration

!--- Hilbert space enumeration ---

    subroutine enumerate_determinants(init, ref_sym, occ_list0)

        ! Find the Slater determinants that can be formed from the
        ! basis functions.

        ! On initialisation the number of determinants in each symmetry block
        ! for the specified spin polarisation is counted and store in
        ! the module-level variable sym_space_size.  Subseuent calls store
        ! determinants of the desired symmetry in the module-level variable
        ! dets_list array.

        ! In:
        !    init: if true, count the number of determinants rather than store
        !        them.  This must be done for each spin polarisation before
        !        subsequent calls to store the determinants.
        !    ref_sym(optional): index of an irreducible representation.  Only determinants
        !        with the same symmetry  are stored.  *MUST* be specified if
        !        init is false.
        !    occ_list0(optional): list of occupied orbitals in a determinant.
        !        Used as the reference determinant if a truncated CI space is
        !        being used.  *MUST* be specified if truncate_space is true.

        use checking, only: check_allocate, check_deallocate
        use errors, only: stop_all
        use utils, only: binom_i, get_free_unit, int_fmt
        use bit_utils, only: first_perm, bit_permutation, decode_bit_string

        use basis, only: basis_length
        use calc, only: truncate_space, truncation_level
        use excitations, only: get_excitation_level
        use system, only: sym0, sym_max, nel, system_type, hub_real, heisenberg, ueg
        use symmetry, only: cross_product, symmetry_orb_list
        use ueg_system, only: ueg_basis_index

        logical, intent(in) :: init
        integer, intent(in), optional :: ref_sym
        integer, intent(in), optional :: occ_list0(nel)

        integer :: i, j, iel, idet, ierr
        integer :: nbeta_combinations
        integer, allocatable :: nalpha_combinations(:)
        integer :: sym_beta, sym, Ms, excit_level_alpha, excit_level_beta
        character(4) :: fmt1
        integer(i0) :: f(basis_length)
        integer, allocatable :: occ(:), comb(:,:), unocc(:)
        integer :: k(ndim), k_beta(ndim)
        type(det_info) :: d0

        if (init) then
            if (allocated(sym_space_size)) then
                deallocate(sym_space_size, stat=ierr)
                call check_deallocate('sym_space_size',ierr)
            end if
            allocate(sym_space_size(sym0:sym_max), stat=ierr)
            call check_allocate('sym_space_size',nsym,ierr)
            sym_space_size = 0
        else
            if (.not.present(ref_sym)) then
                call stop_all('enumerate_determinants', 'ref_sym must be specified when storing determinants.')
            end if
            if (allocated(dets_list)) then
                deallocate(dets_list, stat=ierr)
                call check_deallocate('dets_list',ierr)
            end if

            ndets = sym_space_size(ref_sym)

            allocate(dets_list(basis_length, ndets), stat=ierr)
            call check_allocate('dets_list',basis_length*ndets,ierr)
        end if

        call alloc_det_info(d0)

        ! For fermionic systems, we generate the alpha string and beta string
        ! separately and then combine them to form a determinant.
        ! If the Hilbert space is truncated, then only strings within the
        ! required excitation level are generated.
        ! For each beta string we generate, we then generate each
        ! (excitation-allowed) alpha string.  Hence if the Hilbert space is
        ! truncated, then the number of possilbe alpha strings is a function of
        ! the excitation level of the beta string.
        ! If the Hilbert space is not truncated, then all alpha strings can be
        ! combined with all beta strings.
        ! This scheme makes the generation of determinants in a truncated
        ! Hilbert space fast (as we only generate determinants within the
        ! truncated space and not those outside the truncated space but in the
        ! full Hilbert space).
        if (truncate_space) then
            if (.not.present(occ_list0)) then
                call stop_all('enumerate_determinants', 'Require reference for truncated CI spaces.')
            end if
            allocate(nalpha_combinations(0:nbeta), stat=ierr)
            nalpha_combinations = 0
            nbeta_combinations = 0
            ! Identical to the settings in the else statements if truncation_level == nel.
            do i = 0, truncation_level
                nbeta_combinations = nbeta_combinations + binom_i(nbeta, i)*binom_i(nvirt_beta, i)
                do j = 0, min(truncation_level-i, nalpha)
                    nalpha_combinations(i) = nalpha_combinations(i) + binom_i(nalpha, j)*binom_i(nvirt_alpha, j)
                end do
            end do
            call encode_det(occ_list0, d0%f)
            call decode_det_spinocc_spinunocc(d0%f, d0)
        else
            ! No matter what the excitation level of the beta string, all alpha
            ! combinations are allowed.
            allocate(nalpha_combinations(0:0), stat=ierr)
            nbeta_combinations = binom_i(nbasis/2, nbeta)
            nalpha_combinations = binom_i(nbasis/2, nalpha)
            truncation_level = nel
        end if
        call check_allocate('nalpha_combinations',size(nalpha_combinations),ierr)
        allocate(comb(2*truncation_level, 2), stat=ierr)
        call check_allocate('comb', size(comb), ierr)<commit_msg>Bug fix CI determinant enumeration.<commit_after>module determinant_enumeration

! Module for complete enumeration of determinant Hilbert space.
! Used only in FCI and simple_fciqmc calculations.
! Rather a memory hog! ;-)

use const
use determinants

implicit none

!--- Info for FCI calculations ---

! Store of determinant information.
! This will quickly become a memory issue, but for dealing with the FCI of small
! systems it is ok.

! Rather than creating an array of derived types containing information about
! each determinant, which leads to a serious memory overhead due to the need for
! pointers/allocatable arrays in the derived type, we instead create 3 separate
! variables.

! Bit list of the Slater determinant.  See note for f in determinants module.
! We only store determinants of the same Ms and (for momentum space
! calculations) same ksum at a time.
integer(i0), allocatable :: dets_list(:,:) ! (basis_length,ndets)

! Number of determinants stored in dets.
! This is the number of determinants enumerated in enumerate_determinants with
! the desired spin and momentum symmetry.
integer :: ndets

! Total (exact) size of determinant space.
! Number of determinants of each symmetry.
integer, allocatable :: sym_space_size(:) ! (nsym)

! If true then the determinant list is written to determinant_file.
logical :: write_determinants = .false.
character(255) :: determinant_file = 'DETS'
integer :: det_unit

contains

!--- Initialisation and finalisation ---

    subroutine init_determinant_enumeration()

        ! Initialise determinant enumeration info,
        ! Note that memory allocation is done in the determinant enumeration
        ! routines.

        use utils, only: get_free_unit

        if (write_determinants) then
            det_unit = get_free_unit()
            open(det_unit, file=determinant_file, status='unknown')
        end if

    end subroutine init_determinant_enumeration

    subroutine end_determinant_enumeration()

        ! Clean up.

        use checking, only: check_deallocate

        integer :: ierr

        if (allocated(dets_list)) then
            deallocate(dets_list, stat=ierr)
            call check_deallocate('dets_list',ierr)
        end if
        if (allocated(sym_space_size)) then
            deallocate(sym_space_size, stat=ierr)
            call check_deallocate('sym_space_size',ierr)
        end if

        if (write_determinants) close(det_unit, status='keep')

    end subroutine end_determinant_enumeration

!--- Hilbert space enumeration ---

    subroutine enumerate_determinants(init, ref_sym, occ_list0)

        ! Find the Slater determinants that can be formed from the
        ! basis functions.

        ! On initialisation the number of determinants in each symmetry block
        ! for the specified spin polarisation is counted and store in
        ! the module-level variable sym_space_size.  Subseuent calls store
        ! determinants of the desired symmetry in the module-level variable
        ! dets_list array.

        ! In:
        !    init: if true, count the number of determinants rather than store
        !        them.  This must be done for each spin polarisation before
        !        subsequent calls to store the determinants.
        !    ref_sym(optional): index of an irreducible representation.  Only determinants
        !        with the same symmetry  are stored.  *MUST* be specified if
        !        init is false.
        !    occ_list0(optional): list of occupied orbitals in a determinant.
        !        Used as the reference determinant if a truncated CI space is
        !        being used.  *MUST* be specified if truncate_space is true.

        use checking, only: check_allocate, check_deallocate
        use errors, only: stop_all
        use utils, only: binom_i, get_free_unit, int_fmt
        use bit_utils, only: first_perm, bit_permutation, decode_bit_string

        use basis, only: basis_length
        use calc, only: truncate_space, truncation_level
        use excitations, only: get_excitation_level
        use system, only: sym0, sym_max, nel, system_type, hub_real, heisenberg, ueg
        use symmetry, only: cross_product, symmetry_orb_list
        use ueg_system, only: ueg_basis_index

        logical, intent(in) :: init
        integer, intent(in), optional :: ref_sym
        integer, intent(in), optional :: occ_list0(nel)

        integer :: i, j, iel, idet, ierr
        integer :: nbeta_combinations
        integer, allocatable :: nalpha_combinations(:)
        integer :: sym_beta, sym, Ms, excit_level_alpha, excit_level_beta
        character(4) :: fmt1
        integer(i0) :: f(basis_length)
        integer, allocatable :: occ(:), comb(:,:), unocc(:)
        integer :: k(ndim), k_beta(ndim)
        type(det_info) :: d0

        if (init) then
            if (allocated(sym_space_size)) then
                deallocate(sym_space_size, stat=ierr)
                call check_deallocate('sym_space_size',ierr)
            end if
            allocate(sym_space_size(sym0:sym_max), stat=ierr)
            call check_allocate('sym_space_size',nsym,ierr)
            sym_space_size = 0
        else
            if (.not.present(ref_sym)) then
                call stop_all('enumerate_determinants', 'ref_sym must be specified when storing determinants.')
            end if
            if (allocated(dets_list)) then
                deallocate(dets_list, stat=ierr)
                call check_deallocate('dets_list',ierr)
            end if

            ndets = sym_space_size(ref_sym)

            allocate(dets_list(basis_length, ndets), stat=ierr)
            call check_allocate('dets_list',basis_length*ndets,ierr)
        end if

        call alloc_det_info(d0)

        ! For fermionic systems, we generate the alpha string and beta string
        ! separately and then combine them to form a determinant.
        ! If the Hilbert space is truncated, then only strings within the
        ! required excitation level are generated.
        ! For each beta string we generate, we then generate each
        ! (excitation-allowed) alpha string.  Hence if the Hilbert space is
        ! truncated, then the number of possilbe alpha strings is a function of
        ! the excitation level of the beta string.
        ! If the Hilbert space is not truncated, then all alpha strings can be
        ! combined with all beta strings.
        ! This scheme makes the generation of determinants in a truncated
        ! Hilbert space fast (as we only generate determinants within the
        ! truncated space and not those outside the truncated space but in the
        ! full Hilbert space).
        if (truncate_space) then
            if (.not.present(occ_list0)) then
                call stop_all('enumerate_determinants', 'Require reference for truncated CI spaces.')
            end if
            allocate(nalpha_combinations(0:nbeta), stat=ierr)
            nalpha_combinations = 0
            nbeta_combinations = 0
            ! Identical to the settings in the else statements if truncation_level == nel.
            do i = 0, min(truncation_level, nbeta)
                nbeta_combinations = nbeta_combinations + binom_i(nbeta, i)*binom_i(nvirt_beta, i)
                do j = 0, min(truncation_level-i, nalpha)
                    nalpha_combinations(i) = nalpha_combinations(i) + binom_i(nalpha, j)*binom_i(nvirt_alpha, j)
                end do
            end do
            call encode_det(occ_list0, d0%f)
            call decode_det_spinocc_spinunocc(d0%f, d0)
        else
            ! No matter what the excitation level of the beta string, all alpha
            ! combinations are allowed.
            allocate(nalpha_combinations(0:0), stat=ierr)
            nbeta_combinations = binom_i(nbasis/2, nbeta)
            nalpha_combinations = binom_i(nbasis/2, nalpha)
            truncation_level = nel
        end if
        call check_allocate('nalpha_combinations',size(nalpha_combinations),ierr)
        allocate(comb(2*truncation_level, 2), stat=ierr)
        call check_allocate('comb', size(comb), ierr)
{'fraction_non_alphanumeric': 0.06761433868974041, 'fraction_numerical': 0.003955500618046972, 'mean_word_length': 2.6078037904124862, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6590123', 'n_tokens_mistral': 4670, 'n_tokens_neox': 4332, 'n_words': 1534}