<commit_before>module check_input
! Parse input options and check input for validity.

implicit none

contains

    subroutine check_sys(sys)

        ! Check the input parameters for the system.

        ! I don't pretend this is the most comprehensive of tests, but at least
        ! make sure a few things are not completely insane.

        ! In:
        !    sys: system object, as set in read_input.

        use system

        use errors, only: stop_all, warning

        type(sys_t), intent(in) :: sys

        integer :: ivec, jvec
        character(*), parameter :: this='check_sys'

        if (sys%system /= heisenberg) then
            if (sys%nel < 0) call stop_all(this,'Number of electrons must be positive.')
            if (sys%nel == 0 .and. sys%Ms /= huge(1)) call stop_all(this, &
                                        'Must specify both or neither of nel and Ms.')
            if (sys%nel /= 0 .and. sys%Ms == huge(1)) call stop_all(this, &
                                        'Must specify both or neither of nel and Ms.')
        end if

        if (sys%system /= ueg .and. sys%system /= read_in .and. sys%system /= ringium) then
            if (.not.(allocated(sys%lattice%lattice))) call stop_all(this, 'Lattice vectors not provided')
            do ivec = 1, sys%lattice%ndim
                do jvec = ivec+1, sys%lattice%ndim
                    if (dot_product(sys%lattice%lattice(:,ivec), sys%lattice%lattice(:,jvec)) /= 0) then
                        call stop_all(this, 'Lattice vectors are not orthogonal.')
                    end if
                end do
            end do
        end if

        if (sys%system == heisenberg) then
            if (abs(sys%heisenberg%staggered_magnetic_field) > depsilon .and. (.not.sys%lattice%bipartite_lattice)) &
                call stop_all(this, 'Cannot set a staggered field for this lattice because it is frustrated.')
            if (abs(sys%heisenberg%staggered_magnetic_field) > depsilon .and. abs(sys%heisenberg%magnetic_field) > depsilon) &
                call stop_all(this, 'Cannot set a uniform and a staggered field at the same time.')
        else if (sys%system == hub_k .or. sys%system == hub_real) then
            if (sys%nel > 2*sys%lattice%nsites) call stop_all(this, 'More than two electrons per site.')
        end if

        if (sys%system /= read_in) then
            if (sys%lattice%ndim > 3) call stop_all(this, 'Limited to 1, 2 or 3 dimensions')
            if (sys%system == ueg .and. sys%lattice%ndim == 1) call stop_all(this, 'UEG only functional in 2D and 3D')
        end if

        if (sys%momentum_space .or. sys%system == read_in) then
            if (sys%real_lattice%finite_cluster) call stop_all(this,'"finite" keyword only valid for calculations in real-space.')
        end if

        if (sys%system == ringium .and. sys%ringium%radius < depsilon) call stop_all(this, 'Ringium must have a positive radius.')

        if (sys%system == read_in .and. sys%read_in%max_broadcast_chunk /= ((2_int_64**31) - 1_int_64)) &
            call warning(this, 'Not using default max_broadcast_chunk. This option is only intended for testing of &
                &broadcasting functionality and gives no benefit to functionality.')

        if (sys%read_in%comp .and. sys%read_in%uhf) call warning(this, &
                            'UHF translational symmetry currently untested. Use with caution!')

    end subroutine check_sys

    subroutine check_fciqmc_opts(sys, fciqmc_in)

        ! Check the FCIQMC specific options.

        ! In:
        !   sys: system being studied.
        !   fciqmc_in: FCIQMC input options.

        use qmc_data, only: fciqmc_in_t, single_basis, no_guiding, neel_singlet_guiding, neel_singlet
        use system, only: sys_t, heisenberg
        use errors, only: stop_all

        type(sys_t), intent(in) :: sys
        type(fciqmc_in_t), intent(in) :: fciqmc_in

        character(*), parameter :: this = 'check_fciqmc_opts'

        if (sys%system /= heisenberg) then
            if (fciqmc_in%trial_function /= single_basis) &
                call stop_all(this, 'Only a single determinant can be used as the reference state for this system. &
                                     &Other trial functions are not available.')
            if (fciqmc_in%guiding_function /= no_guiding) &
                call stop_all(this, 'Importance sampling is only avaliable for the Heisenberg model currently.')
         else
            if (fciqmc_in%guiding_function == neel_singlet_guiding .and. fciqmc_in%trial_function /= neel_singlet) &
                call stop_all(this, &
                    'This guiding function is only available when using the Neel singlet state as an energy estimator.')
        end if

        if (fciqmc_in%init_spin_inv_D0 .and. sys%Ms /= 0) then
            call stop_all(this, &
                'Flipping the reference state will give a state which has a different value of Ms and so cannot be used here.')
        end if


    end subroutine check_fciqmc_opts

    subroutine check_qmc_opts(qmc_in, sys, need_length, restarting)

        ! Check options common to QMC methods.

        ! In:
        !   qmc_in: QMC input options.
        !   need_length: whether the size of main/spawned particle arrays is needed.
        !       false if using simple fciqmc algorithm or restarting from memory.
        !   restarting: whether the calculation is restarting from a previous one.

        use qmc_data, only: qmc_in_t
        use errors, only: stop_all
        use system, only: sys_t

        type(qmc_in_t), intent(in) :: qmc_in
        type(sys_t), intent(in) :: sys
        logical, intent(in) :: need_length, restarting

        character(*), parameter :: this = 'check_qmc_opts'


        if (qmc_in%tau <= 0) call stop_all(this,'Tau must be positive.')
        if (qmc_in%shift_damping <= 0) call stop_all(this,'Shift damping must be positive.')

        if (need_length) then
            if (qmc_in%walker_length == 0) call stop_all(this,'Walker length must not be zero.')
            if (qmc_in%spawned_walker_length == 0) call stop_all(this,'Spawned walker length must not be zero.')
        end if

        if (.not. restarting) then
            if (qmc_in%D0_population <= 0) call stop_all(this, 'Initial population must be positive.')
        end if

        if (sys%read_in%comp .and. qmc_in%quasi_newton) call stop_all(this, 'Quasi-Newton not currently &
            &compatible with complex systems.')

    end subroutine check_qmc_opts

    subroutine check_fci_opts(sys, fci_in, lanczos)

        ! Check the input options provided in the fci table.

        ! In:
        !   sys: system being studied.
        !   fci_in: input options for FCI.
        !   lanczos: is this a lanczos or full diagonalisation?

        use fci_utils, only: fci_in_t
        use system, only: sys_t, read_in

        use errors, only: stop_all

        type(sys_t), intent(in) :: sys
        type(fci_in_t), intent(in) :: fci_in
        logical, intent(in) :: lanczos

        character(*), parameter :: this = 'check_fci_opts'

        if (sys%system == read_in) then
            if (fci_in%analyse_fci_wfn /= 0 .and. sys%read_in%dipole_int_file == '') then
                call stop_all(this, 'Cannot analyse FCI wavefunction without a dipole integrals file.')
            end if
        end if

        if (lanczos) then
            if (fci_in%lanczos_string_len <= 0) call stop_all(this,'Lanczos basis not positive.')
            if (fci_in%nlanczos_eigv <= 0) call stop_all(this,'# lanczos eigenvalues not positive.')<commit_msg>Add an extra couple of checks to qmc_in.<commit_after>module check_input
! Parse input options and check input for validity.

implicit none

contains

    subroutine check_sys(sys)

        ! Check the input parameters for the system.

        ! I don't pretend this is the most comprehensive of tests, but at least
        ! make sure a few things are not completely insane.

        ! In:
        !    sys: system object, as set in read_input.

        use system

        use errors, only: stop_all, warning

        type(sys_t), intent(in) :: sys

        integer :: ivec, jvec
        character(*), parameter :: this='check_sys'

        if (sys%system /= heisenberg) then
            if (sys%nel < 0) call stop_all(this,'Number of electrons must be positive.')
            if (sys%nel == 0 .and. sys%Ms /= huge(1)) call stop_all(this, &
                                        'Must specify both or neither of nel and Ms.')
            if (sys%nel /= 0 .and. sys%Ms == huge(1)) call stop_all(this, &
                                        'Must specify both or neither of nel and Ms.')
        end if

        if (sys%system /= ueg .and. sys%system /= read_in .and. sys%system /= ringium) then
            if (.not.(allocated(sys%lattice%lattice))) call stop_all(this, 'Lattice vectors not provided')
            do ivec = 1, sys%lattice%ndim
                do jvec = ivec+1, sys%lattice%ndim
                    if (dot_product(sys%lattice%lattice(:,ivec), sys%lattice%lattice(:,jvec)) /= 0) then
                        call stop_all(this, 'Lattice vectors are not orthogonal.')
                    end if
                end do
            end do
        end if

        if (sys%system == heisenberg) then
            if (abs(sys%heisenberg%staggered_magnetic_field) > depsilon .and. (.not.sys%lattice%bipartite_lattice)) &
                call stop_all(this, 'Cannot set a staggered field for this lattice because it is frustrated.')
            if (abs(sys%heisenberg%staggered_magnetic_field) > depsilon .and. abs(sys%heisenberg%magnetic_field) > depsilon) &
                call stop_all(this, 'Cannot set a uniform and a staggered field at the same time.')
        else if (sys%system == hub_k .or. sys%system == hub_real) then
            if (sys%nel > 2*sys%lattice%nsites) call stop_all(this, 'More than two electrons per site.')
        end if

        if (sys%system /= read_in) then
            if (sys%lattice%ndim > 3) call stop_all(this, 'Limited to 1, 2 or 3 dimensions')
            if (sys%system == ueg .and. sys%lattice%ndim == 1) call stop_all(this, 'UEG only functional in 2D and 3D')
        end if

        if (sys%momentum_space .or. sys%system == read_in) then
            if (sys%real_lattice%finite_cluster) call stop_all(this,'"finite" keyword only valid for calculations in real-space.')
        end if

        if (sys%system == ringium .and. sys%ringium%radius < depsilon) call stop_all(this, 'Ringium must have a positive radius.')

        if (sys%system == read_in .and. sys%read_in%max_broadcast_chunk /= ((2_int_64**31) - 1_int_64)) &
            call warning(this, 'Not using default max_broadcast_chunk. This option is only intended for testing of &
                &broadcasting functionality and gives no benefit to functionality.')

        if (sys%read_in%comp .and. sys%read_in%uhf) call warning(this, &
                            'UHF translational symmetry currently untested. Use with caution!')

    end subroutine check_sys

    subroutine check_fciqmc_opts(sys, fciqmc_in)

        ! Check the FCIQMC specific options.

        ! In:
        !   sys: system being studied.
        !   fciqmc_in: FCIQMC input options.

        use qmc_data, only: fciqmc_in_t, single_basis, no_guiding, neel_singlet_guiding, neel_singlet
        use system, only: sys_t, heisenberg
        use errors, only: stop_all

        type(sys_t), intent(in) :: sys
        type(fciqmc_in_t), intent(in) :: fciqmc_in

        character(*), parameter :: this = 'check_fciqmc_opts'

        if (sys%system /= heisenberg) then
            if (fciqmc_in%trial_function /= single_basis) &
                call stop_all(this, 'Only a single determinant can be used as the reference state for this system. &
                                     &Other trial functions are not available.')
            if (fciqmc_in%guiding_function /= no_guiding) &
                call stop_all(this, 'Importance sampling is only avaliable for the Heisenberg model currently.')
         else
            if (fciqmc_in%guiding_function == neel_singlet_guiding .and. fciqmc_in%trial_function /= neel_singlet) &
                call stop_all(this, &
                    'This guiding function is only available when using the Neel singlet state as an energy estimator.')
        end if

        if (fciqmc_in%init_spin_inv_D0 .and. sys%Ms /= 0) then
            call stop_all(this, &
                'Flipping the reference state will give a state which has a different value of Ms and so cannot be used here.')
        end if


    end subroutine check_fciqmc_opts

    subroutine check_qmc_opts(qmc_in, sys, need_length, restarting)

        ! Check options common to QMC methods.

        ! In:
        !   qmc_in: QMC input options.
        !   need_length: whether the size of main/spawned particle arrays is needed.
        !       false if using simple fciqmc algorithm or restarting from memory.
        !   restarting: whether the calculation is restarting from a previous one.

        use qmc_data, only: qmc_in_t
        use errors, only: stop_all
        use system, only: sys_t

        type(qmc_in_t), intent(in) :: qmc_in
        type(sys_t), intent(in) :: sys
        logical, intent(in) :: need_length, restarting

        character(*), parameter :: this = 'check_qmc_opts'


        if (qmc_in%tau <= 0) call stop_all(this,'Tau must be positive.')
        if (qmc_in%shift_damping <= 0) call stop_all(this,'Shift damping must be positive.')

        if (need_length) then
            if (qmc_in%walker_length == 0) call stop_all(this,'Walker length must not be zero.')
            if (qmc_in%spawned_walker_length == 0) call stop_all(this,'Spawned walker length must not be zero.')
        end if

        if (.not. restarting) then
            if (qmc_in%D0_population <= 0) call stop_all(this, 'Initial population must be positive.')
        end if

        if (sys%read_in%comp .and. qmc_in%quasi_newton) call stop_all(this, 'Quasi-Newton not currently &
            &compatible with complex systems.')

        if (qmc_in%ncycles <= 0) call stop_all(this, 'mc_cycles must be positive.')
        if (qmc_in%nreport <= 0) call stop_all(this, 'nreports must be positive.')

    end subroutine check_qmc_opts

    subroutine check_fci_opts(sys, fci_in, lanczos)

        ! Check the input options provided in the fci table.

        ! In:
        !   sys: system being studied.
        !   fci_in: input options for FCI.
        !   lanczos: is this a lanczos or full diagonalisation?

        use fci_utils, only: fci_in_t
        use system, only: sys_t, read_in

        use errors, only: stop_all

        type(sys_t), intent(in) :: sys
        type(fci_in_t), intent(in) :: fci_in
        logical, intent(in) :: lanczos

        character(*), parameter :: this = 'check_fci_opts'

        if (sys%system == read_in) then
            if (fci_in%analyse_fci_wfn /= 0 .and. sys%read_in%dipole_int_file == '') then
                call stop_all(this, 'Cannot analyse FCI wavefunction without a dipole integrals file.')
            end if
        end if

        if (lanczos) then
            if (fci_in%lanczos_string_len <= 0) call stop_all(this,'Lanczos basis not positive.')
            if (fci_in%nlanczos_eigv <= 0) call stop_all(this,'# lanczos eigenvalues not positive.')
{'fraction_non_alphanumeric': 0.09086192360075232, 'fraction_numerical': 0.004669563525520462, 'mean_word_length': 2.292058070025619, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4511467', 'n_tokens_mistral': 4934, 'n_tokens_neox': 4644, 'n_words': 1508}