<commit_before>module determinant_decoders

! Generation, inspection and manipulation of Slater determinants.

use const
use determinant_data
use parallel, only: parent

implicit none

contains

!--- Decode determinant bit strings ---

    pure subroutine decode_det_occ(sys, f, d, excit_gen_data)

        ! Decode determinant bit string into integer list containing the
        ! occupied orbitals.
        !
        ! In:
        !    sys: system being studied (contains required basis information).
        !    f(tot_string_len): bit string representation of the Slater
        !        determinant.
        ! Out:
        !    d: det_info_t variable.  The following components are set:
        !        occ_list: integer list of occupied spin-orbitals in the
        !            Slater determinant.

        use system, only: sys_t
        use excit_gens, only: excit_gen_data_t
        use determinants, only: decode_det

        type(sys_t), intent(in) :: sys
        integer(i0), intent(in) :: f(sys%basis%tot_string_len)
        type(det_info_t), intent(inout) :: d
        type(excit_gen_data_t), optional, intent(in) :: excit_gen_data

        call decode_det(sys%basis, f, d%occ_list)

    end subroutine decode_det_occ
    
    pure subroutine decode_det_spinocc(sys, f, d, excit_gen_data)

        ! Decode determinant bit string into integer list containing the
        ! occupied orbitals and integer lists containing occupied alpha and
        ! beta orbitals.
        ! In:
        !    f(tot_string_len): bit string representation of the Slater
        !        determinant.
        ! Out:
        !    d: det_info_t variable.  The following components are set:
        !        occ_list: integer list of occupied spin-orbitals in the
        !            Slater determinant.
        !        occ_list_alpha/_beta: integer list of occupied alpha/beta
        !            spin-orbitals in the Slater determinant.

        use system, only: sys_t
        use excit_gens, only: excit_gen_data_t
        use determinants, only: decode_det

        type(sys_t), intent(in) :: sys
        integer(i0), intent(in) :: f(sys%basis%tot_string_len)
        type(det_info_t), intent(inout) :: d
        integer :: i, ialpha, ibeta
        type(excit_gen_data_t), optional, intent(in) :: excit_gen_data

        call decode_det(sys%basis, f, d%occ_list)

        ialpha = 1
        ibeta = 1

        do i = 1, sys%nel
            associate(orb=>d%occ_list(i))
                if (sys%basis%basis_fns(orb)%ms > 0) then
                    d%occ_list_alpha(ialpha) = orb
                    ialpha = ialpha + 1
                else
                    d%occ_list_beta(ibeta) = orb
                    ibeta = ibeta + 1
                end if
            end associate
        end do

    end subroutine decode_det_spinocc
    
    pure subroutine decode_det_occ_unocc(sys, f, d, excit_gen_data)

        ! Decode determinant bit string into integer lists containing the
        ! occupied and unoccupied orbitals.
        !
        ! We return the lists for alpha and beta electrons separately.
        !
        ! In:
        !    f(tot_string_len): bit string representation of the Slater
        !        determinant.
        ! Out:
        !    d: det_info_t variable.  The following components are set:
        !        occ_list: integer list of occupied spin-orbitals in the
        !            Slater determinant.
        !        unocc_list: integer list of unoccupied
        !            spin-orbitals in the Slater determinant.

        use system, only: sys_t
        use excit_gens, only: excit_gen_data_t

        type(sys_t), intent(in) :: sys
        integer(i0), intent(in) :: f(sys%basis%tot_string_len)
        type(det_info_t), intent(inout) :: d
        type(excit_gen_data_t), optional, intent(in) :: excit_gen_data
        integer :: i, j, iocc, iunocc, orb, last_basis_ind

        ! A bit too much to do the chunk-based decoding of the occupied list and then fill
        ! in the remaining information.  We only use this in Hubbard model calculations in
        ! k-space, so for now just do a (slow) bit-wise inspection.

        iocc = 0
        iunocc = 0
        orb = 0

        do i = 1, sys%basis%bit_string_len - 1
            ! Manual unrolling allows us to avoid 2 mod statements
            ! and some branching.
            ! [todo] - note above still relevant?
            do j = 0, i0_end
                orb = orb + 1
                if (btest(f(i), j)) then
                    iocc = iocc + 1
                    d%occ_list(iocc) = orb
                else
                    iunocc = iunocc + 1
                    d%unocc_list(iunocc) = orb
                end if
            end do
        end do

        ! Deal with the last element in the determinant bit array separately.
        ! Note that decoding a bit string is surprisingly slow (or, more
        ! importantly, adds up when doing billions of times).
        ! Treating the last element as a special case rather than having an if
        ! statement in the above loop results a speedup of the Hubbard k-space
        ! FCIQMC calculations of 1.5%.
        last_basis_ind = sys%basis%nbasis - i0_length*(sys%basis%bit_string_len-1) - 1
        do j = 0, last_basis_ind, 2
            orb = orb + 1
            if (btest(f(i), j)) then
                iocc = iocc + 1
                d%occ_list(iocc) = orb
            else
                iunocc = iunocc + 1
                d%unocc_list(iunocc) = orb
            end if
        end do<commit_msg>bug fix hbs decoder<commit_after>module determinant_decoders

! Generation, inspection and manipulation of Slater determinants.

use const
use determinant_data
use parallel, only: parent

implicit none

contains

!--- Decode determinant bit strings ---

    pure subroutine decode_det_occ(sys, f, d, excit_gen_data)

        ! Decode determinant bit string into integer list containing the
        ! occupied orbitals.
        !
        ! In:
        !    sys: system being studied (contains required basis information).
        !    f(tot_string_len): bit string representation of the Slater
        !        determinant.
        ! Out:
        !    d: det_info_t variable.  The following components are set:
        !        occ_list: integer list of occupied spin-orbitals in the
        !            Slater determinant.

        use system, only: sys_t
        use excit_gens, only: excit_gen_data_t
        use determinants, only: decode_det

        type(sys_t), intent(in) :: sys
        integer(i0), intent(in) :: f(sys%basis%tot_string_len)
        type(det_info_t), intent(inout) :: d
        type(excit_gen_data_t), optional, intent(in) :: excit_gen_data

        call decode_det(sys%basis, f, d%occ_list)

    end subroutine decode_det_occ
    
    pure subroutine decode_det_spinocc(sys, f, d, excit_gen_data)

        ! Decode determinant bit string into integer list containing the
        ! occupied orbitals and integer lists containing occupied alpha and
        ! beta orbitals.
        ! In:
        !    f(tot_string_len): bit string representation of the Slater
        !        determinant.
        ! Out:
        !    d: det_info_t variable.  The following components are set:
        !        occ_list: integer list of occupied spin-orbitals in the
        !            Slater determinant.
        !        occ_list_alpha/_beta: integer list of occupied alpha/beta
        !            spin-orbitals in the Slater determinant.

        use system, only: sys_t
        use excit_gens, only: excit_gen_data_t
        use determinants, only: decode_det

        type(sys_t), intent(in) :: sys
        integer(i0), intent(in) :: f(sys%basis%tot_string_len)
        type(det_info_t), intent(inout) :: d
        integer :: i, ialpha, ibeta
        type(excit_gen_data_t), optional, intent(in) :: excit_gen_data

        call decode_det(sys%basis, f, d%occ_list)

        ialpha = 1
        ibeta = 1

        do i = 1, sys%nel
            associate(orb=>d%occ_list(i))
                if (sys%basis%basis_fns(orb)%ms > 0) then
                    d%occ_list_alpha(ialpha) = orb
                    ialpha = ialpha + 1
                else
                    d%occ_list_beta(ibeta) = orb
                    ibeta = ibeta + 1
                end if
            end associate
        end do

    end subroutine decode_det_spinocc
    
    pure subroutine decode_det_occ_unocc(sys, f, d, excit_gen_data)

        ! Decode determinant bit string into integer lists containing the
        ! occupied and unoccupied orbitals.
        !
        ! We return the lists for alpha and beta electrons separately.
        !
        ! In:
        !    f(tot_string_len): bit string representation of the Slater
        !        determinant.
        ! Out:
        !    d: det_info_t variable.  The following components are set:
        !        occ_list: integer list of occupied spin-orbitals in the
        !            Slater determinant.
        !        unocc_list: integer list of unoccupied
        !            spin-orbitals in the Slater determinant.

        use system, only: sys_t
        use excit_gens, only: excit_gen_data_t

        type(sys_t), intent(in) :: sys
        integer(i0), intent(in) :: f(sys%basis%tot_string_len)
        type(det_info_t), intent(inout) :: d
        type(excit_gen_data_t), optional, intent(in) :: excit_gen_data
        integer :: i, j, iocc, iunocc, orb, last_basis_ind

        ! A bit too much to do the chunk-based decoding of the occupied list and then fill
        ! in the remaining information.  We only use this in Hubbard model calculations in
        ! k-space, so for now just do a (slow) bit-wise inspection.

        iocc = 0
        iunocc = 0
        orb = 0

        do i = 1, sys%basis%bit_string_len - 1
            ! Manual unrolling allows us to avoid 2 mod statements
            ! and some branching.
            ! [todo] - note above still relevant?
            do j = 0, i0_end
                orb = orb + 1
                if (btest(f(i), j)) then
                    iocc = iocc + 1
                    d%occ_list(iocc) = orb
                else
                    iunocc = iunocc + 1
                    d%unocc_list(iunocc) = orb
                end if
            end do
        end do

        ! Deal with the last element in the determinant bit array separately.
        ! Note that decoding a bit string is surprisingly slow (or, more
        ! importantly, adds up when doing billions of times).
        ! Treating the last element as a special case rather than having an if
        ! statement in the above loop results a speedup of the Hubbard k-space
        ! FCIQMC calculations of 1.5%.
        last_basis_ind = sys%basis%nbasis - i0_length*(sys%basis%bit_string_len-1) - 1
        do j = 0, last_basis_ind
            orb = orb + 1
            if (btest(f(i), j)) then
                iocc = iocc + 1
                d%occ_list(iocc) = orb
            else
                iunocc = iunocc + 1
                d%unocc_list(iunocc) = orb
            end if
        end do
{'fraction_non_alphanumeric': 0.0700098858632156, 'fraction_numerical': 0.0053024175429136336, 'mean_word_length': 1.8037288989669942, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 7, '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': '4796272', 'n_tokens_mistral': 3343, 'n_tokens_neox': 3122, 'n_words': 1041}