norms_type Derived Type

type, private :: norms_type

Define a type to hold the set of normalisations, we could imagine extending this in the future to provide a normalise/denormalise routine which can be used to automatically convert quantities


Contents

Source Code


Components

Type Visibility Attributes Name Initial
real, private :: def_val = default_value
logical, private :: some_norms_set = .false.
logical, private :: all_norms_set = .false.
logical, private :: initialised = .false.
integer, private :: nnorm
character(len=6), public, dimension(:), allocatable :: names
real, private :: mref

Reference mass in atomic mass units

real, private :: zref

Reference charge in units of the elementary charge

real, private :: nref

Reference density in

real, private :: tref

Reference temperature in

real, private :: aref

Reference length in

real, private :: vref

Reference (thermal) velocity in

real, private :: bref

Reference magnetic field in Tesla,

real, private :: rhoref

Reference Larmor radius in


Type-Bound Procedures

procedure, public :: init => norms_init

  • private subroutine norms_init(self, normalisations_config_in)

    Initialise the norms object

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(inout) :: self
    type(normalisations_config_type), intent(in), optional :: normalisations_config_in

procedure, public :: finish => norms_finish

  • private subroutine norms_finish(self)

    Reset and free memory

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(inout) :: self

procedure, public :: reset => norms_reset

  • private subroutine norms_reset(self)

    Reset the properties

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(inout) :: self

procedure, private, :: read_parameters => norms_read_parameters

procedure, private, :: set_value => norms_set_value

  • private subroutine norms_set_value(self, val_name, val)

    Sets the value of a particular normalisation, determined by the passed val_name string. Unknown val_name values result in a warning message on proc0.

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(inout) :: self
    character(len=*), intent(in) :: val_name
    real, intent(in) :: val

procedure, public :: get_value => norms_get_value

  • private function norms_get_value(self, val_name)

    Get the value of the normalisation associated with val_name. Unknown values of val_name result in a call to mp_abort.

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(in) :: self
    character(len=*), intent(in) :: val_name

    Return Value real

procedure, private, :: check_if_set => norms_check_if_set

  • private function norms_check_if_set(self, val_name)

    Decide if a given normalisation has been set

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(in) :: self
    character(len=*), intent(in) :: val_name

    Return Value logical

procedure, private, :: set_logicals => norms_set_logicals

  • private subroutine norms_set_logicals(self)

    Decide if all/some of the normalisations have been set

    Arguments

    Type IntentOptional Attributes Name
    class(norms_type), intent(inout) :: self

Source Code

  type norms_type
     private
     !Internal parameters
     real :: def_val = default_value !Default value, used to check if parameter has been set.

     !Note def_val is really a parameter, but not allowed to define params in derived type
     logical :: some_norms_set=.false.
     logical :: all_norms_set=.false.
     logical :: initialised = .false.

     !The following is used to help automate loops over normalisations
     integer :: nnorm
     character(len=6), dimension(:), allocatable, public :: names

     !The normalisations
     real :: mref !< Reference mass in atomic mass units
     real :: zref !< Reference charge in units of the elementary charge
     real :: nref !< Reference density in \(m^{-3}\)
     real :: tref !< Reference temperature in \(eV\)
     real :: aref !< Reference length in \(m\)
     real :: vref !< Reference (thermal) velocity in \(m/s\)
     real :: bref !< Reference magnetic field in Tesla, \(T\)
     real :: rhoref !< Reference Larmor radius in \(m\)
   contains
     private
     procedure, public :: init => norms_init
     procedure, public :: finish => norms_finish
     procedure, public :: reset => norms_reset
     procedure :: read_parameters => norms_read_parameters
     procedure :: set_value => norms_set_value
     procedure, public :: get_value => norms_get_value
     procedure :: check_if_set => norms_check_if_set
     procedure :: set_logicals => norms_set_logicals
  end type norms_type