korc_fields Module



Contents


Functions

private pure function cross(a, b)

Read more…

Arguments

Type IntentOptional AttributesName
real(kind=rp), intent(in), DIMENSION(3):: a

Vector .

real(kind=rp), intent(in), DIMENSION(3):: b

Vector .

Return Value real(kind=rp), DIMENSION(3)

Cross product


Subroutines

private subroutine analytical_fields(F, Y, E, B, flag)

Read more…

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(in), DIMENSION(:,:), ALLOCATABLE:: Y

Toroidal coordinates of each particle in the simulation; Y(1,:) = , Y(2,:) = , Y(3,:) = .

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: E

Electric field components in Cartesian coordinates; E(1,:) = , E(2,:) = , E(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: B

Magnetic field components in Cartesian coordinates; B(1,:) = , B(2,:) = , B(3,:) =

integer(kind=is), intent(in), DIMENSION(:), ALLOCATABLE:: flag

Flag for each particle to decide whether it is being followed (flag=T) or not (flag=F).

public subroutine analytical_fields_p(B0, E0, R0, q0, lam, ar, X_X, X_Y, X_Z, B_X, B_Y, B_Z, E_X, E_Y, E_Z, flag_cache)

Arguments

Type IntentOptional AttributesName
real(kind=rp), intent(in) :: B0
real(kind=rp), intent(in) :: E0
real(kind=rp), intent(in) :: R0
real(kind=rp), intent(in) :: q0
real(kind=rp), intent(in) :: lam
real(kind=rp), intent(in) :: ar
real(kind=rp), intent(in), DIMENSION(8):: X_X
real(kind=rp), intent(in), DIMENSION(8):: X_Y
real(kind=rp), intent(in), DIMENSION(8):: X_Z
real(kind=rp), intent(out), DIMENSION(8):: B_X
real(kind=rp), intent(out), DIMENSION(8):: B_Y
real(kind=rp), intent(out), DIMENSION(8):: B_Z
real(kind=rp), intent(out), DIMENSION(8):: E_X
real(kind=rp), intent(out), DIMENSION(8):: E_Y
real(kind=rp), intent(out), DIMENSION(8):: E_Z
integer(kind=is), intent(inout), DIMENSION(8):: flag_cache

private subroutine analytical_fields_GC_init(params, F, Y, E, B, gradB, curlB, flag, PSIp)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(in), DIMENSION(:,:), ALLOCATABLE:: Y

Cylindrical coordinates of each particle in the simulation; Y(1,:) = , Y(2,:) = , Y(3,:) = .

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: E

Electric field components in cylindricalcoordinates; E(1,:) = , E(2,:) = , E(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: B

Magnetic field components in cylindrical coordinates; B(1,:) = , B(2,:) = , B(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: gradB

Gradient of magnitude of magnetic field in cylindrical coordinates; gradB(1,:) = , B(2,:) = , B(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: curlB

Curl of magnetic field unit vector in cylindrical coordinates

integer(kind=is), intent(in), DIMENSION(:), ALLOCATABLE:: flag

Flag for each particle to decide whether it is being followed (flag=T) or not (flag=F).

real(kind=rp), intent(inout), DIMENSION(:), ALLOCATABLE:: PSIp

private subroutine analytical_fields_GC(params, F, Y, E, B, gradB, curlB, flag, PSIp)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(in), DIMENSION(:,:), ALLOCATABLE:: Y

Cylindrical coordinates of each particle in the simulation; Y(1,:) = , Y(2,:) = , Y(3,:) = .

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: E

Electric field components in cylindricalcoordinates; E(1,:) = , E(2,:) = , E(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: B

Magnetic field components in cylindrical coordinates; B(1,:) = , B(2,:) = , B(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: gradB

Gradient of magnitude of magnetic field in cylindrical coordinates; gradB(1,:) = , B(2,:) = , B(3,:) =

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: curlB

Curl of magnetic field unit vector in cylindrical coordinates

integer(kind=is), intent(in), DIMENSION(:), ALLOCATABLE:: flag

Flag for each particle to decide whether it is being followed (flag=T) or not (flag=F).

real(kind=rp), intent(inout), DIMENSION(:), ALLOCATABLE:: PSIp

public subroutine analytical_fields_Bmag_p(F, Y_R, Y_PHI, Y_Z, Bmag, E_PHI)

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F
real(kind=rp), intent(in), DIMENSION(8):: Y_R
real(kind=rp), intent(in), DIMENSION(8):: Y_PHI
real(kind=rp), intent(in), DIMENSION(8):: Y_Z
real(kind=rp), intent(out), DIMENSION(8):: Bmag
real(kind=rp), intent(out), DIMENSION(8):: E_PHI

public subroutine add_analytical_E_p(params, tt, F, E_PHI, Y_R)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(inout) :: params
integer(kind=ip), intent(in) :: tt
type(FIELDS), intent(in) :: F
real(kind=rp), intent(inout), DIMENSION(8):: E_PHI
real(kind=rp), intent(in), DIMENSION(8):: Y_R

public subroutine analytical_fields_GC_p(F, Y_R, Y_PHI, Y_Z, B_R, B_PHI, B_Z, E_R, E_PHI, E_Z, curlB_R, curlB_PHI, curlB_Z, gradB_R, gradB_PHI, gradB_Z, PSIp)

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F
real(kind=rp), intent(in), DIMENSION(8):: Y_R
real(kind=rp), intent(in), DIMENSION(8):: Y_PHI
real(kind=rp), intent(in), DIMENSION(8):: Y_Z
real(kind=rp), intent(out), DIMENSION(8):: B_R
real(kind=rp), intent(out), DIMENSION(8):: B_PHI
real(kind=rp), intent(out), DIMENSION(8):: B_Z
real(kind=rp), intent(out), DIMENSION(8):: E_R
real(kind=rp), intent(out), DIMENSION(8):: E_PHI
real(kind=rp), intent(out), DIMENSION(8):: E_Z
real(kind=rp), intent(out), DIMENSION(8):: curlB_R
real(kind=rp), intent(out), DIMENSION(8):: curlB_PHI
real(kind=rp), intent(out), DIMENSION(8):: curlB_Z
real(kind=rp), intent(out), DIMENSION(8):: gradB_R
real(kind=rp), intent(out), DIMENSION(8):: gradB_PHI
real(kind=rp), intent(out), DIMENSION(8):: gradB_Z
real(kind=rp), intent(out), DIMENSION(8):: PSIp

private subroutine uniform_magnetic_field(F, B)

Read more…

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: B

Magnetic field components in Cartesian coordinates; B(1,:) = , B(2,:) = , B(3,:) =

private subroutine uniform_electric_field(F, E)

Read more…

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: E

Electric field components in Cartesian coordinates; E(1,:) = , E(2,:) = , E(3,:) =

private subroutine analytical_electric_field_cyl(F, Y, E, flag)

Read more…

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(in), DIMENSION(:,:), ALLOCATABLE:: Y

Cylindrical coordinates of each particle in the simulation; Y(1,:) = , Y(2,:) = , Y(3,:) = .

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: E

Electric field components in Cartesian coordinates; E(1,:) = , E(2,:) = , E(3,:) =

integer(kind=is), intent(in), DIMENSION(:), ALLOCATABLE:: flag

Flag for each particle to decide whether it is being followed (flag=T) or not (flag=F).

public subroutine mean_F_field(F, Fo, op_field)

Read more…

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

real(kind=rp), intent(out) :: Fo

Mean electric or magnetic field.

type(KORC_STRING), intent(in) :: op_field

String that specifies what mean field will be calculated. Its value can be 'B' or 'E'.

private subroutine get_analytical_fields(params, vars, F)

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

type(PARTICLES), intent(inout) :: vars

An instance of the KORC derived type PARTICLES.

type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

private subroutine uniform_fields(vars, F)

Read more…

Arguments

Type IntentOptional AttributesName
type(PARTICLES), intent(inout) :: vars

An instance of the KORC derived type PARTICLES.

type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

public subroutine unitVectors(params, Xo, F, b1, b2, b3, flag)

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

real(kind=rp), intent(in), DIMENSION(:,:), ALLOCATABLE:: Xo

Array with the position of the simulated particles.

type(FIELDS), intent(in) :: F

F An instance of the KORC derived type FIELDS.

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: b1

Basis vector pointing along the local magnetic field, that is, along .

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: b2

Basis vector perpendicular to b1

real(kind=rp), intent(inout), DIMENSION(:,:), ALLOCATABLE:: b3

Basis vector perpendicular to b1 and b2.

integer(kind=is), intent(inout), optional DIMENSION(:), ALLOCATABLE:: flag

Flag for each particle to decide whether it is being followed (flag=T) or not (flag=F).

public subroutine get_fields(params, vars, F)

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

type(PARTICLES), intent(inout) :: vars

An instance of the KORC derived type PARTICLES.

type(FIELDS), intent(in) :: F

An instance of the KORC derived type FIELDS.

public subroutine calculate_SC_E1D(params, F, Vden)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F
real(kind=rp), intent(in), dimension(F%dim_1D):: Vden

public subroutine calculate_SC_E1D_FS(params, F, dintJphidPSIP)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F
real(kind=rp), intent(in), dimension(F%dim_1D):: dintJphidPSIP

public subroutine calculate_SC_p(params, F, B_R, B_PHI, B_Z, Y_R, Y_Z, V_PLL, V_MU, m_cache, flag_cache, Vden)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(in) :: F
real(kind=rp), intent(in), dimension(8):: B_R
real(kind=rp), intent(in), dimension(8):: B_PHI
real(kind=rp), intent(in), dimension(8):: B_Z
real(kind=rp), intent(in), dimension(8):: Y_R
real(kind=rp), intent(in), dimension(8):: Y_Z
real(kind=rp), intent(in), dimension(8):: V_PLL
real(kind=rp), intent(in), dimension(8):: V_MU
real(kind=rp), intent(in) :: m_cache
integer(kind=is), intent(in), dimension(8):: flag_cache
real(kind=rp), intent(out), dimension(F%dim_1D):: Vden

public subroutine calculate_SC_p_FS(params, F, B_R, B_PHI, B_Z, PSIp, V_PLL, V_MU, m_cache, flag_cache, dintJphidPSIP)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(in) :: F
real(kind=rp), intent(in), dimension(8):: B_R
real(kind=rp), intent(in), dimension(8):: B_PHI
real(kind=rp), intent(in), dimension(8):: B_Z
real(kind=rp), intent(in), dimension(8):: PSIp
real(kind=rp), intent(in), dimension(8):: V_PLL
real(kind=rp), intent(in), dimension(8):: V_MU
real(kind=rp), intent(in) :: m_cache
integer(kind=is), intent(in), dimension(8):: flag_cache
real(kind=rp), intent(out), dimension(F%dim_1D):: dintJphidPSIP

public subroutine init_SC_E1D(params, F, spp)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F
type(SPECIES), intent(in) :: spp

public subroutine init_SC_E1D_FS(params, F, spp)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F
type(SPECIES), intent(in) :: spp

public subroutine reinit_SC_E1D(params, F)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F

public subroutine reinit_SC_E1D_FS(params, F)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F

public subroutine initialize_fields(params, F)

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(inout) :: params

Core KORC simulation parameters.

type(FIELDS), intent(out) :: F

An instance of the KORC derived type FIELDS.

private subroutine initialize_GC_fields(F)

Computes the auxiliary fields and that are used in the RHS of the evolution equations for the GC orbit model.

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(inout) :: F

An instance of the KORC derived type FIELDS.

private subroutine initialize_GC_fields_3D(F)

Computes the auxiliary fields and that are used in the RHS of the evolution equations for the GC orbit model.

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(inout) :: F

An instance of the KORC derived type FIELDS.

public subroutine define_SC_time_step(params, F)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(inout) :: params
type(FIELDS), intent(inout) :: F

public subroutine load_dim_data_from_hdf5(params, F)

@brief Subroutine that loads the size of the arrays having the electric and magnetic field data. @details All the information of externally calculated fields must be given in a rectangular, equally spaced mesh in the space of cylindrical coordinates. If the fields are axisymmetric, then the fields must be in a rectangular mesh on the -plane.

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F

public subroutine which_fields_in_file(params, Bfield, Efield, Bflux, dBfield)

@brief Subroutine that queries the HDF5 file what data are present in the HDF5 input file (sanity check).

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
logical, intent(out) :: Bfield
logical, intent(out) :: Efield
logical, intent(out) :: Bflux
logical, intent(out) :: dBfield

public subroutine load_field_data_from_hdf5(params, F)

@brief Subroutine that loads the fields data from the HDF5 input file.

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F

public subroutine load_1D_FS_from_hdf5(params, F)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F

public subroutine allocate_1D_FS_arrays(params, F)

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

type(FIELDS), intent(inout) :: F

An instance of the KORC derived type FIELDS. In this variable we keep the loaded data.

public subroutine ALLOCATE_2D_FIELDS_ARRAYS(params, F, bfield, bflux, dbfield, efield)

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params

Core KORC simulation parameters.

type(FIELDS), intent(inout) :: F

An instance of the KORC derived type FIELDS. In this variable we keep the loaded data.

logical, intent(in) :: bfield
logical, intent(in) :: bflux

Logical variable that specifies if the variables that keep the poloidal magnetic flux data is allocated (bflux=T) or not (bflux=F).

logical, intent(in) :: dbfield

Logical variable that specifies if the variables that keep the magnetic field data is allocated (bfield=T) or not (bfield=F).

logical, intent(in) :: efield

Logical variable that specifies if the variables that keep the electric field data is allocated (efield=T) or not (efield=F).

public subroutine ALLOCATE_3D_FIELDS_ARRAYS(params, F, bfield, efield, dbfield)

@brief Subroutine that allocates the variables keeping the 3-D fields data.

Read more…

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F
logical, intent(in) :: bfield
logical, intent(in) :: efield
logical, intent(in) :: dbfield

private subroutine ALLOCATE_V_FIELD_2D(F, dims)

@brief Subroutine that allocates the cylindrical components of an axisymmetric field.

Read more…

Arguments

Type IntentOptional AttributesName
type(V_FIELD_2D), intent(inout) :: F
integer, intent(in), DIMENSION(3):: dims

private subroutine ALLOCATE_V_FIELD_3D(F, dims)

@brief Subroutine that allocates the cylindrical components of a 3-D field.

Read more…

Arguments

Type IntentOptional AttributesName
type(V_FIELD_3D), intent(inout) :: F
integer, intent(in), DIMENSION(3):: dims

public subroutine DEALLOCATE_FIELDS_ARRAYS(F)

@brief Subroutine that deallocates all the variables of the electric and magnetic fields.

Read more…

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(inout) :: F