create_particle_kp_estimates Subroutine

public subroutine create_particle_kp_estimates(nI_child, ilut_child, child_sign, tNearlyFull)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI_child(nel)
integer(kind=n_int), intent(in) :: ilut_child(0:NIfTot)
real(kind=dp), intent(in) :: child_sign(lenof_all_signs)
logical, intent(inout) :: tNearlyFull

Contents


Source Code

    subroutine create_particle_kp_estimates(nI_child, ilut_child, child_sign, tNearlyFull)

        use bit_rep_data, only: IlutBits
        use load_balance_calcnodes, only: DetermineDetNode
        use hash, only: hash_table_lookup, add_hash_table_entry
        use FciMCData, only: ValidSpawnedList, InitialSpawnedSlots, SpawnedParts, spawn_ht
        use kp_fciqmc_data_mod, only: MaxSpawnedEachProc
        use SystemData, only: nel

        integer, intent(in) :: nI_child(nel)
        integer(n_int), intent(in) :: ilut_child(0:NIfTot)
        real(dp), intent(in) :: child_sign(lenof_all_signs)
        logical, intent(inout) :: tNearlyFull

        integer(n_int) :: int_sign(lenof_all_signs)
        real(dp) :: real_sign(lenof_all_signs)
        integer :: proc, ind, hash_val
        logical :: tSuccess

        call hash_table_lookup(nI_child, ilut_child, nifd, spawn_ht, &
                               SpawnedParts, ind, hash_val, tSuccess)

        if (tSuccess) then
            ! If this determinant is already in the spawned array.
            ! Extract the old sign.
            real_sign = &
                transfer(SpawnedParts(IlutBits%ind_pop:IlutBits%ind_pop + lenof_all_signs - 1, ind), &
                         real_sign)
            ! Find the total new sign.
            real_sign = real_sign + child_sign
            ! Encode the new sign.
            int_sign = transfer(real_sign, int_sign)
            SpawnedParts(IlutBits%ind_pop:IlutBits%ind_pop + lenof_all_signs - 1, ind) = int_sign
        else
            ! If this determinant is a new entry to the spawned array.
            proc = DetermineDetNode(nel, nI_child, 0)

            SpawnedParts(0:nifd, ValidSpawnedList(proc)) = ilut_child(0:nifd)
            int_sign = transfer(child_sign, int_sign)
            SpawnedParts(IlutBits%ind_pop:IlutBits%ind_pop + lenof_all_signs - 1, &
                         ValidSpawnedList(proc)) = int_sign
            call add_hash_table_entry(spawn_ht, ValidSpawnedList(proc), hash_val)

            ValidSpawnedList(proc) = ValidSpawnedList(proc) + 1

            if (ValidSpawnedList(proc) - InitialSpawnedSlots(proc) > MaxSpawnedEachProc) tNearlyFull = .true.
        end if

    end subroutine create_particle_kp_estimates