generate_all_conn_space Subroutine

private subroutine generate_all_conn_space(ilut_list, space_size)


Type IntentOptional Attributes Name
integer(kind=n_int), intent(inout) :: ilut_list(0:,:)
integer, intent(inout) :: space_size


Source Code

    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)


            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