create_diagonal_with_hashtable Subroutine

public subroutine create_diagonal_with_hashtable(nI, iLut, sign, err)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: iLut(0:niftot)
real(kind=dp), intent(in) :: sign(lenof_sign)
integer, intent(out) :: err

Contents


Source Code

    subroutine create_diagonal_with_hashtable(nI, iLut, sign, err)
        ! this subroutine is somewhat a variant of create_particle_with_hashtable
        ! that takes a global sign with many entries as it appears in diagonal spawning events
        integer, intent(in) :: nI(nel)
        integer(n_int), intent(in) :: iLut(0:niftot)
        real(dp), intent(in) :: sign(lenof_sign)
        integer, intent(out) :: err
        integer :: ind, hash_val, run, proc
        integer, parameter :: flags = 0
        logical :: tSuccess
        real(dp) :: old_sign(lenof_sign)
        character(*), parameter :: this_routine = "create_diagonal_with_hashtable"

        err = 0

        call hash_table_lookup(nI, iLut, nifd, spawn_ht, SpawnedParts, ind, hash_val, tSuccess)
        if (tSuccess) then
            ! if it already exists, add in the
            call extract_sign(SpawnedParts(:, ind), old_sign)
            call encode_sign(SpawnedParts(:, ind), old_sign + sign)

            ! check for initiator criterium
            if (tTruncInitiator) then
                do run = 1, inum_runs
                    if (tInitCoherentRule) then
                        if (.not. is_run_unnocc(old_sign, run) .or. test_flag( &
                            ilut, get_initiator_flag_by_run(run))) then
                            call set_flag(SpawnedParts(:, ind), get_initiator_flag_by_run(run))
                        end if
                    else
                        if (test_flag(ilut, get_initiator_flag_by_run(run))) then
                            call set_flag(SpawnedParts(:, ind), get_initiator_flag_by_run(run))
                        end if
                    end if
                end do
            end if
        else
            proc = DetermineDetNode(nel, nI, 0)

            if (checkValidSpawnedList(proc)) then
                err = 1
                return
            end if

            call encode_bit_rep(SpawnedParts(:, ValidSpawnedList(proc)), ilut(0:nifd), &
                                sign, flags)

            if (tTruncInitiator) then
                do run = 1, inum_runs
                    if (test_flag(ilut, get_initiator_flag_by_run(run))) call set_flag( &
                        SpawnedParts(:, ValidSpawnedList(proc)), get_initiator_flag_by_run(run))
                end do
            end if

            call add_hash_table_entry(spawn_ht, ValidSpawnedList(proc), hash_val)
            ValidSpawnedList(proc) = ValidSpawnedList(proc) + 1
        end if
    end subroutine create_diagonal_with_hashtable