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