read_parameters Subroutine

private subroutine read_parameters(species_config_in, species_elements_config_in)

FIXME : Add documentation

Arguments

Type IntentOptional Attributes Name
type(species_config_type), intent(in), optional :: species_config_in
type(species_element_config_type), intent(in), optional, dimension(:), allocatable :: species_elements_config_in

Contents

Source Code


Source Code

  subroutine read_parameters(species_config_in, species_elements_config_in)
    use file_utils, only: input_unit, error_unit, get_indexed_namelist_unit, input_unit_exist
    use text_options, only: text_option, get_option_value
    use mp, only: proc0, mp_abort
    implicit none
    type(species_config_type), intent(in), optional :: species_config_in
    type(species_element_config_type), intent(in), dimension(:), allocatable, optional :: species_elements_config_in
    character(20) :: type, f0type
    integer :: is, ierr

    type (text_option), dimension (*), parameter :: typeopts = [ &
         text_option('default', ion_species), &
         text_option('ion', ion_species), &
         text_option('electron', electron_species), &
         text_option('e', electron_species), &
         text_option('trace', tracer_species), &
         text_option('hybrid_electron', hybrid_electron_species) &
         ]

    type (text_option), dimension (3), parameter :: f0_opts = [ &
         text_option('maxwellian', f0_maxwellian), &
         text_option('tabulated', f0_tabulated), &
         text_option('sdanalytic', f0_sdanalytic) &
         ]

    if (present(species_config_in)) species_config = species_config_in

    call species_config%init(name = 'species_knobs', requires_index = .false.)

    ! Copy out internal values into module level parameters
    me = species_config%me
    nspec = species_config%nspec
    zi_fac = species_config%zi_fac

    exist = species_config%exist
    
    if (proc0) then
       if (nspec < 1) then
          ierr = error_unit()
          write (unit=ierr, &
               fmt="('Invalid nspec in species_knobs: ', i5)") nspec
          call mp_abort('Invalid nspec in species_knobs')
       end if
    end if

    allocate (spec(nspec))

    if (present(species_elements_config_in)) species_element_config = species_elements_config_in

    if (.not.allocated(species_element_config)) allocate(species_element_config(nspec))

    if (size(species_element_config) .ne. nspec) then
       if (proc0) print*,"inconsistent number of config elements"
    endif
       
    ierr = error_unit()
    do is = 1, nspec
       call species_element_config(is)%init(name = 'species_parameters', requires_index = .true., index = is)

       ! Copy out internal values into module level parameters
       spec(is)%bess_fac = species_element_config(is)%bess_fac
       spec(is)%dens = species_element_config(is)%dens
       spec(is)%dens0 = species_element_config(is)%dens0
       spec(is)%fprim = species_element_config(is)%fprim
       spec(is)%mass = species_element_config(is)%mass
       spec(is)%nu_h = species_element_config(is)%nu_h
       spec(is)%temp = species_element_config(is)%temp
       spec(is)%tpar0 = species_element_config(is)%tpar0
       spec(is)%tperp0 = species_element_config(is)%tperp0
       spec(is)%tprim = species_element_config(is)%tprim
       spec(is)%u0 = species_element_config(is)%u0
       spec(is)%uprim = species_element_config(is)%uprim
       spec(is)%uprim2 = species_element_config(is)%uprim2
       spec(is)%vcprim = species_element_config(is)%vcprim
       spec(is)%vcrit = species_element_config(is)%vcrit
       spec(is)%vnewk = species_element_config(is)%vnewk
       spec(is)%z = species_element_config(is)%z

       call get_option_value (species_element_config(is)%type, typeopts, spec(is)%type, ierr, "type in species_parameters_x",.true.)
       call get_option_value (species_element_config(is)%f0type, f0_opts, spec(is)%f0type, ierr, "f0type in species_parameters_x",.true.)
    end do

    spec%stm = sqrt(spec%temp / spec%mass)
    spec%zstm = spec%z / sqrt(spec%temp * spec%mass)
    spec%tz = spec%temp / spec%z
    spec%zt = spec%z / spec%temp
    spec%smz = abs(sqrt(spec%temp * spec%mass) / spec%z)
  end subroutine read_parameters