InitFCIMC_trial Subroutine

public subroutine InitFCIMC_trial()

Arguments

None

Contents

Source Code


Source Code

    subroutine InitFCIMC_trial()

        ! Use the code generated for the KPFCIQMC excited state calculations
        ! to initialise the FCIQMC simulation.

!         integer :: nexcit, ndets_this_proc, i, det(nel)
        integer :: nexcit, ndets_this_proc, det(nel)
        integer(int64) :: i

        type(basisfn) :: sym
        real(dp) :: evals(inum_runs / nreplicas)
        HElement_t(dp), allocatable :: evecs_this_proc(:, :)
        integer(MPIArg) :: space_sizes(0:nProcessors - 1), space_displs(0:nProcessors - 1)
        character(*), parameter :: this_routine = 'InitFCIMC_trial'

        nexcit = inum_runs / nreplicas

        ! Create the trial excited states
        if (allocated(trial_init_reorder)) then
            call calc_trial_states_lanczos(init_trial_in, nexcit, ndets_this_proc, &
                                           SpawnedParts, evecs_this_proc, evals, &
                                           space_sizes, space_displs, trial_init_reorder)
        else
            call calc_trial_states_lanczos(init_trial_in, nexcit, ndets_this_proc, &
                                           SpawnedParts, evecs_this_proc, evals, &
                                           space_sizes, space_displs)
        end if
        ! Determine the walker populations associated with these states
        call set_trial_populations(nexcit, ndets_this_proc, evecs_this_proc)
        ! Set the trial excited states as the FCIQMC wave functions
        call set_trial_states(ndets_this_proc, evecs_this_proc, SpawnedParts, &
                              .false., tPairedReplicas)

        deallocate(evecs_this_proc)

        if (tSetInitialRunRef) call set_initial_run_references()

        ! Add an initialisation check on symmetries.
        if ((.not. tHub) .and. (.not. tUEG)) then
            do i = 1, TotWalkers
                call decode_bit_det(det, CurrentDets(:, i))
                call getsym_wrapper(det, sym)
                if (sym%sym%S /= HFSym%sym%S .or. sym%ml /= HFSym%Ml) &
                    call stop_all(this_routine, "Invalid det found")
            end do
        end if

    end subroutine InitFCIMC_trial