subroutine generate_all_conn_space(ilut_list, space_size)
integer(n_int), intent(inout) :: ilut_list(0:, :)
integer, intent(inout) :: space_size
integer :: conn_size, conn_size_old, i, ierr
integer(n_int), allocatable :: conn_space(:, :)
integer(MPIArg) :: con_sendcounts(0:nProcessors - 1), con_recvcounts(0:nProcessors - 1)
integer(MPIArg) :: con_senddispls(0:nProcessors - 1), con_recvdispls(0:nProcessors - 1)
integer(MPIArg) :: SpawnedPartsWidth
integer :: SpawnedPartsMax
SpawnedPartsWidth = int(size(SpawnedParts, 1), MPIArg)
SpawnedPartsMax = int(SpawnedPartsWidth) - 1
if (space_size > 0) then
! Find the states connected to the trial space. This typically takes a long time, so
! it is done in parallel by letting each processor find the states connected to a
! portion of the trial space.
write(stdout, '("Calculating the number of states in the connected space...")'); call neci_flush(stdout)
call generate_connected_space(space_size, ilut_list(0:SpawnedPartsMax, 1:space_size), conn_size)
write(stdout, '("Attempting to allocate conn_space. Size =",1X,F12.3,1X,"Mb")') &
real(conn_size, dp) * SpawnedPartsWidth * 7.629392e-06_dp; call neci_flush(stdout)
allocate(conn_space(0:SpawnedPartsMax, conn_size), stat=ierr)
conn_space = 0_n_int
write(stdout, '("States found on this processor, including repeats:",1X,i8)') conn_size
write(stdout, '("Generating and storing the connected space...")'); call neci_flush(stdout)
call generate_connected_space(space_size, ilut_list(0:SpawnedPartsMax, 1:space_size), &
conn_size, conn_space)
write(stdout, '("Removing repeated states and sorting by processor...")'); call neci_flush(stdout)
call remove_repeated_states(conn_space, conn_size)
call sort_space_by_proc(conn_space(:, 1:conn_size), conn_size, con_sendcounts)
else
conn_size = 0
con_sendcounts = 0
allocate(conn_space(0, 0), stat=ierr)
write(stdout, '("This processor will not search for connected states.")'); call neci_flush(stdout)
!Although the size is zero, we should allocate it, because the rest of the code use it.
!Otherwise, we get segmentation fault later.
allocate(conn_space(0:SpawnedPartsMax, conn_size), stat=ierr)
end if
write(stdout, '("States found on this processor, without repeats:",1X,i8)') conn_size; call neci_flush(stdout)
write(stdout, '("Performing MPI communication of connected states...")'); call neci_flush(stdout)
! Send the connected states to their processors.
! con_sendcounts holds the number of states to send to other processors from this one.
! con_recvcounts will hold the number of states to be sent to this processor from the others.
call MPIAlltoAll(con_sendcounts, 1, con_recvcounts, 1, ierr)
conn_size_old = conn_size
conn_size = sum(con_recvcounts)
! The displacements necessary for mpi_alltoall.
con_sendcounts = con_sendcounts * SpawnedPartsWidth
con_recvcounts = con_recvcounts * SpawnedPartsWidth
con_senddispls(0) = 0
con_recvdispls(0) = 0
do i = 1, nProcessors - 1
con_senddispls(i) = con_senddispls(i - 1) + con_sendcounts(i - 1)
con_recvdispls(i) = con_recvdispls(i - 1) + con_recvcounts(i - 1)
end do
!write(stdout,'("Attempting to allocate temp_space. Size =",1X,F12.3,1X,"Mb")') &
! real(conn_size,dp)*SpawnedPartsWidth*7.629392e-06_dp; call neci_flush(stdout)
!allocate(temp_space(0:SpawnedPartsMax, conn_size), stat=ierr)
call MPIAlltoAllV(conn_space(:, 1:conn_size_old), con_sendcounts, con_senddispls, &
ilut_list(:, 1:conn_size), con_recvcounts, con_recvdispls, ierr)
space_size = conn_size
if (allocated(conn_space)) then
deallocate(conn_space, stat=ierr)
end if
!write(stdout,'("Attempting to allocate conn_space. Size =",1X,F12.3,1X,"Mb")') &
! real(conn_size,dp)*SpawnedPartsWidth*7.629392e-06_dp; call neci_flush(stdout)
!allocate(conn_space(0:SpawnedPartsMax, 1:conn_size), stat=ierr)
!conn_space = temp_space
!deallocate(temp_space, stat=ierr)
end subroutine generate_all_conn_space