init_initiator_space Subroutine

public subroutine init_initiator_space(space_in)


Type IntentOptional Attributes Name
type(subspace_in) :: space_in


Source Code

Source Code

    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, /)') &
        call neci_flush(stdout)

    end subroutine init_initiator_space