guga_propvec_pchb_doubles_main.F90 Source File

#include "macros.h"

module guga_prop_vec_pchb_doubles_main
    use constants, only: stdout
    use SystemData, only: tUHF
    use util_mod, only: EnumBase_t, stop_all
    use fortran_strings, only: to_upper, split
    use property_vector_index, only: AlsoGUGA_PropertyIndexer_t

    use guga_base_class, only: DoublesGUGABase_t
    use guga_prop_vec_pchb_doubles_select_holes, only: PropVec_PCHB_FastFast_t, &
        PropVec_PCHB_FullFull_t, &
        PCHB_HoleAlgorithm_t, PCHB_HoleAlgorithm_vals_t, &
        WeightingChoice_t, WeightingChoice_vals_t
    use guga_prop_vec_pchb_doubles_select_particles, only: &
        PCHB_ParticleSelection_t, &
        PCHB_ParticleSelection_vals_t

    better_implicit_none

    private

    public :: PCHB_DoublesOptions_t, PCHB_DoublesOptions_vals_t, allocate_and_init

    type :: PCHB_DoublesOptions_t
        type(PCHB_ParticleSelection_t) :: particle_selection
        type(PCHB_HoleAlgorithm_t)  :: hole_selection
        type(WeightingChoice_t)  :: weighting
    contains
        procedure :: is_valid
        procedure :: to_str
    end type

    type :: PCHB_DoublesOptions_vals_t
        type(PCHB_ParticleSelection_vals_t) :: &
            particle_selection = PCHB_ParticleSelection_vals_t()
        type(PCHB_HoleAlgorithm_vals_t) :: &
            hole_selection = PCHB_HoleAlgorithm_vals_t()
        type(WeightingChoice_vals_t) :: &
            weighting = WeightingChoice_vals_t()
    end type

    type(PCHB_DoublesOptions_vals_t), parameter :: &
        doubles_options_vals = PCHB_DoublesOptions_vals_t()

contains

    subroutine allocate_and_init(indexer, options, use_lookup, create_lookup, generator)
        class(AlsoGUGA_PropertyIndexer_t), intent(in) :: indexer
        type(PCHB_DoublesOptions_t), intent(in) :: options
        logical, intent(in) :: use_lookup, create_lookup
            !! Use the supergroup lookup
        class(DoublesGUGABase_t), allocatable, intent(inout) :: generator
        routine_name("allocate_and_init")

        if (options%hole_selection == doubles_options_vals%hole_selection%FAST_FAST) then
            allocate(PropVec_PCHB_FastFast_t :: generator)
        else if (options%hole_selection == doubles_options_vals%hole_selection%FULL_FULL) then
            allocate(PropVec_PCHB_FullFull_t :: generator)
        end if

        select type(generator)
        type is(PropVec_PCHB_FastFast_t)
            call generator%init(&
                indexer, options%particle_selection, options%weighting, use_lookup, create_lookup)
        type is(PropVec_PCHB_FullFull_t)
            call generator%init(&
                indexer, options%particle_selection, options%weighting, use_lookup, create_lookup)
        class default
            call stop_all(this_routine, "Error. Should never be here.")
        end select
    end subroutine

    logical elemental function is_valid(this)
        class(PCHB_DoublesOptions_t), intent(in) :: this
#ifdef WARNING_WORKAROUND_
        associate(this => this); end associate
#endif
        is_valid = .true.
    end function

    pure function to_str(this) result(res)
        class(PCHB_DoublesOptions_t), intent(in) :: this
        character(:), allocatable :: res
        res = this%particle_selection%to_str()//':'//this%hole_selection%to_str()//' '//this%weighting%to_str()
    end function

end module