try_rdm_list_realloc Subroutine

    subroutine try_rdm_list_realloc(rdm_recv, new_nelements, recv_list)

        ! For cases where the receiving RDM array is not big enough for a
        ! communication, try and reallocate it to be big enough. This also
        ! requires a temporary array to be allocated, to store the current
        ! state of the receive list.

        ! recv_list should be input as true if reallocating an receiving RDM
        ! object. It should be false if reallocating the main array in the
        ! subroutine add_rdm_1_to_rdm_2. The only difference this makes is
        ! in the message output.

        type(rdm_list_t), intent(inout) :: rdm_recv
        integer, intent(in) :: new_nelements
        logical, intent(in) :: recv_list

        integer :: old_nelements, memory_old, memory_new, ierr
        integer(int_rdm), allocatable :: temp_elements(:, :)
        character(*), parameter :: t_r = 'try_rdm_list_realloc'

        ! The number of elements currently filled in the RDM array.
        old_nelements = rdm_recv%nelements

        if (recv_list) then
            write (stdout, '("WARNING: There is not enough space in the current RDM array to receive all of the &
                      &communicated RDM elements. We will now try and reallocate this array to be large &
                      &enough. If there is not sufficient memory then the program may crash.")'); call neci_flush(stdout)
        else
            write (stdout, '("WARNING: There is not enough space in the current RDM array to add the received &
                      &RDM elements to the main RDM array. We will now try and reallocate this array to be 1.5 &
                      &times larger. If there is not sufficient memory then the program may crash.")'); call neci_flush(stdout)
        end if

        ! Memory of the old and new arrays, in bytes.
        memory_old = rdm_recv%max_nelements * (rdm_recv%sign_length + 1) * size_int_rdm
        memory_new = new_nelements * (rdm_recv%sign_length + 1) * size_int_rdm

        write(stdout, '("Old RDM array had the following size (MB):", f14.6)') real(memory_old, dp) / 1048576.0_dp
        write(stdout, '("Required new RDM array must have the following size (MB):", f14.6)') real(memory_new, dp) / 1048576.0_dp

        if (old_nelements > 0) then
            ! Allocate a temporary array to copy the old RDM list to, while we
            ! reallocate that array.
            allocate(temp_elements(0:rdm_recv%sign_length, old_nelements), stat=ierr)
            if (ierr /= 0) call stop_all(t_r, "Error while allocating temporary array to hold existing &
                                              &RDM receive array.")
            temp_elements = rdm_recv%elements(:, 1:old_nelements)
        end if

        deallocate(rdm_recv%elements, stat=ierr)
        if (ierr /= 0) call stop_all(t_r, "Error while deallocating existing RDM receive array.")

        allocate(rdm_recv%elements(0:rdm_recv%sign_length, new_nelements), stat=ierr)
        if (ierr /= 0) call stop_all(t_r, "Error while allocating RDM receive array to the new larger size.")

        ! Update the maximum number of elements for the rdm_recv object.
        rdm_recv%max_nelements = new_nelements

        if (old_nelements > 0) then
            ! Copy the existing elements back, and deallocate the temorary array.
            rdm_recv%elements(:, 1:old_nelements) = temp_elements

            deallocate(temp_elements, stat=ierr)
            if (ierr /= 0) call stop_all(t_r, "Error while deallocating temporary RDM array.")
        end if

    end subroutine try_rdm_list_realloc