equilibrium_factory_m.f90 Source File

module equilibrium_factory_m
    !! Module capable of creating equilibrium objects
    use error_handling_m, only: handle_error, error_info_t
    use status_codes_m, only: PARALLAX_ERR_EQUILIBRIUM
    use equilibrium_m, only: equilibrium_t
    use circular_equilibrium_m, only: circular_t
    use carthy_equilibrium_m, only: carthy_t
    use cerfons_equilibrium_m, only: cerfons_t
    use numerical_equilibrium_m, only: numerical_t
    use salpha_equilibrium_m, only: salpha_t
    use slab_equilibrium_m, only: slab_t
    use dommaschk_equilibrium_m, only: dommaschk_t
    use circular_toroidal_equilibrium_m, only : circular_toroidal_t
#ifdef ENABLE_FLARE
    use flare_equilibrium_m, only: flare_t
#endif
    use comm_handling_m, only: is_master
    implicit none
    save

    enum, bind(C)
        !! Enum defining the different types of equilibria that can be created
        !! by the factory
        enumerator :: CARTHY, CERFONS, CIRCULAR, NUMERICAL, SLAB, SALPHA, &
                      DOMMASCHK, CIRCULAR_TOROIDAL, FLARE
    end enum

    public :: CARTHY, CERFONS, CIRCULAR, NUMERICAL, SLAB, SALPHA, &
              DOMMASCHK, CIRCULAR_TOROIDAL, FLARE
    public :: create_equilibrium
    public :: get_equilibrium_identifier

contains

    subroutine create_equilibrium(res, identifier, filename, dbgout)
        !! Creates the selected equilibrium specified by identifier
        class(equilibrium_t), allocatable, intent(out) :: res
        !! Created equilibrium type
        integer, intent(in) :: identifier
        !! Integer specifying the equilibrium to create (see header)
        character(len = *), intent(in), optional :: filename
        !! Parameter file to read properties of the equilibrium from, if no
        !! parameter file is provided the equilibrium is initialized to default
        !! values. Default initialization is only allowed for CARTHY, CERFONS
        !! and CIRCULAR equilibria. The default initialization is suitable for
        !! unit testing.
        integer, intent(in), optional :: dbgout
        !! Integer specifying what equilibrium information to write to stdout
        integer, parameter :: DBG_NO_OUTPUT             = 0
        integer, parameter :: DBG_MINIMAL_OUTPUT        = 1
        integer, parameter :: DBG_DEBUG_OUTPUT          = 2
        integer, parameter :: DBG_DEBUG_OUTPUT_ALLPROCS = 3
        logical :: write_minimal_output, write_debug_output

        type(circular_t),          allocatable :: eq_circular
        type(carthy_t),            allocatable :: eq_carthy
        type(cerfons_t),           allocatable :: eq_cerfons
        type(numerical_t),         allocatable :: eq_numerical
        type(slab_t),              allocatable :: eq_slab
        type(salpha_t),            allocatable :: eq_salpha
        type(dommaschk_t),         allocatable :: eq_dommaschk
        type(circular_toroidal_t), allocatable :: eq_circular_toroidal
#ifdef ENABLE_FLARE
        type(flare_t),             allocatable :: eq_flare
#endif
        select case(identifier)
        case(CIRCULAR)
            allocate(eq_circular)
            call move_alloc(eq_circular, res)
        case(CARTHY)
            allocate(eq_carthy)
            call move_alloc(eq_carthy, res)
        case(CERFONS)
            allocate(eq_cerfons)
            call move_alloc(eq_cerfons, res)
        case(NUMERICAL)
            allocate(eq_numerical)
            call move_alloc(eq_numerical, res)
        case(SLAB)
            allocate(eq_slab)
            call move_alloc(eq_slab, res)
        case(SALPHA)
            allocate(eq_salpha)
            call move_alloc(eq_salpha, res)
        case(DOMMASCHK)
            allocate(eq_dommaschk)
            call move_alloc(eq_dommaschk, res)
        case(CIRCULAR_TOROIDAL)
            allocate(eq_circular_toroidal)
            call move_alloc(eq_circular_toroidal, res)
        case (FLARE)
#ifdef ENABLE_FLARE
            allocate(eq_flare)
            call move_alloc(eq_flare, res)
#else
            call handle_error("Code compiled without FLARE", &
                              PARALLAX_ERR_EQUILIBRIUM, __LINE__, __FILE__)
#endif
        case default
            call handle_error("Equilibrium ID not recognised", &
                              PARALLAX_ERR_EQUILIBRIUM, __LINE__, __FILE__, &
                              additional_info = error_info_t("ID = ", &
                                  [identifier]))
        end select

        if(present(filename)) then
            call res%init(filename)
        else
            call res%init()
        endif

        ! Determine whether this MPI process should write output
        if (present(dbgout)) then
            if (dbgout == DBG_NO_OUTPUT) then
                write_debug_output = .false.
                write_minimal_output = .false.
            elseif (dbgout == DBG_MINIMAL_OUTPUT) then
                write_debug_output = .false.
                write_minimal_output = is_master()
            elseif (dbgout == DBG_DEBUG_OUTPUT) then
                write_debug_output = is_master()
                write_minimal_output = .false.
            elseif (dbgout == DBG_DEBUG_OUTPUT_ALLPROCS) then
                write_debug_output = .true.
                write_minimal_output = .false.
            else
                call handle_error("dbgout value not recognised", &
                        PARALLAX_ERR_EQUILIBRIUM, __LINE__, __FILE__, &
                        additional_info = error_info_t("dbgout = ", &
                            [dbgout]))
            endif
        else
            write_minimal_output = is_master()
            write_debug_output = .false.
        endif

        if (write_minimal_output) then
            call res%display()
        elseif (write_debug_output) then
            call res%debug()
        endif

    end subroutine

    function get_equilibrium_identifier(eq_as_string) result(res)
        !! Returns equilibrium identifier (see header) if prescribed as string
        character(len=*), intent(in) :: eq_as_string
        !! Equilibrium type specified as string
        integer :: res

        select case(eq_as_string)
        case('CIRCULAR')
            res = CIRCULAR
        case('CIRCULAR_TOROIDAL')
            res = CIRCULAR_TOROIDAL
        case('SALPHA')
            res = SALPHA
        case('SLAB')
            res = SLAB
        case('NUMERICAL')
            res = NUMERICAL
        case('CARTHY')
            res = CARTHY
        case('CERFONS')
            res = CERFONS
        case('DOMMASCHK')
            res = DOMMASCHK
        case('FLARE')
            res = FLARE
        case default
            call handle_error('Geometry not available:' // eq_as_string, &
                              PARALLAX_ERR_EQUILIBRIUM, __LINE__, __FILE__)
        end select

    end function

end module equilibrium_factory_m