subroutine init_initiator_space(space_in)
use DetBitOps, only: ilut_lt, ilut_gt
use DeterminantData, only: write_det
use FciMCData, only: SpawnedParts, InitSpace_Init_Time
use sort_mod, only: sort
use SystemData, only: nel
type(subspace_in) :: space_in
integer :: i, ierr
integer :: nI(nel)
integer(MPIArg) :: mpi_temp
character(len=*), parameter :: t_r = "init_initiator_space"
call MPIBarrier(ierr, tTimeIn=.false.)
call set_timer(InitSpace_Init_Time)
write(stdout, '(/,12("="),1x,a30,1x,12("="))') "Initiator space initialisation"; call neci_flush(stdout)
allocate(initiator_sizes(0:nProcessors - 1))
allocate(initiator_displs(0:nProcessors - 1))
initiator_sizes = 0_MPIArg
initiator_displs = 0_MPIArg
if (.not. (tStartCAS .or. space_in%tPops .or. space_in%tDoubles .or. space_in%tCAS .or. space_in%tRAS .or. &
space_in%tOptimised .or. space_in%tLowE .or. space_in%tRead .or. space_in%tMP1 .or. &
space_in%tFCI .or. space_in%tHeisenbergFCI .or. space_in%tHF)) then
call stop_all("init_initiator_space", "You have not selected an initiator space to use.")
end if
! Call the enumerating subroutines to create all excitations and add these states to
! SpawnedParts on the correct processor. As they do this, they count the size of the
! deterministic space (on their own processor only).
write(stdout, '("Generating the initiator space...")'); call neci_flush(stdout)
call generate_initiator_space(space_in)
! So that all procs store the size of the deterministic spaces on all procs.
mpi_temp = initiator_sizes(iProcIndex)
call MPIAllGather(mpi_temp, initiator_sizes, ierr)
initiator_space_size = sum(initiator_sizes)
initiator_space_size_int = int(initiator_space_size)
write(stdout, '("Total size of initiator space:",1X,i8)') initiator_space_size
write(stdout, '("Size of initiator space on this processor:",1X,i8)') initiator_sizes(iProcIndex)
call neci_flush(stdout)
! Calculate the indices in the full vector at which the various processors take over, relative
! to the first index position in the vector (i.e. the array disps in MPI routines).
initiator_displs(0) = 0
do i = 1, nProcessors - 1
initiator_displs(i) = initiator_displs(i - 1) + initiator_sizes(i - 1)
end do
call sort(SpawnedParts(0:NIfTot, 1:initiator_sizes(iProcIndex)), ilut_lt, ilut_gt)
! Do a check that no states are in the initiator space twice. The list is sorted
! already so simply check states next to each other in the list.
do i = 2, initiator_sizes(iProcIndex)
if (all(SpawnedParts(0:nifd, i - 1) == SpawnedParts(0:nifd, i))) then
call decode_bit_det(nI, SpawnedParts(:, i))
write(stdout, '("State found twice:")')
write(stdout, *) SpawnedParts(:, i)
call write_det(stdout, nI, .true.)
call stop_all(t_r, "The same state has been found twice in the initiator space.")
end if
end do
! Store every determinant from all processors on all processors, in initiator_space.
call store_whole_initiator_space()
! Create the hash table to address the initiator determinants.
call initialise_shared_rht(initiator_space, initiator_space_size_int, initiator_ht)
call set_initiator_space_flags()
SpawnedParts = 0_n_int
! Call MPIBarrier here so that InitSpace_Init_Time will give the
! initialisation time for all processors to finish.
call MPIBarrier(ierr, tTimeIn=.false.)
call halt_timer(InitSpace_Init_Time)
write(stdout, '("Initialisation of initiator space complete.")')
write(stdout, '("Total time (seconds) taken for initiator space initialisation:", f9.3, /)') &
get_total_time(InitSpace_Init_Time)
call neci_flush(stdout)
end subroutine init_initiator_space