rk_module_variable_step Module

High-order variable step size Runge-Kutta integration methods.

Currently have four methods: * Fehlberg 7(8) * Fehlberg 8(9) * Verner 8(9) * Feagin 8(10) * Feagin 12(10) * Feagin 14(12)

Warning

This is a work in progress.


Uses

  • module~~rk_module_variable_step~~UsesGraph module~rk_module_variable_step rk_module_variable_step module~kind_module kind_module module~rk_module_variable_step->module~kind_module module~numbers_module numbers_module module~rk_module_variable_step->module~numbers_module iso_fortran_env iso_fortran_env module~kind_module->iso_fortran_env module~numbers_module->module~kind_module

Used by

  • module~~rk_module_variable_step~~UsedByGraph module~rk_module_variable_step rk_module_variable_step module~fortran_astrodynamics_toolkit fortran_astrodynamics_toolkit module~fortran_astrodynamics_toolkit->module~rk_module_variable_step

Abstract Interfaces

abstract interface

  • private pure function norm_func(x) result(xmag)

    Vector norm function. Must return a value .

    Arguments

    Type IntentOptional Attributes Name
    real(kind=wp), intent(in), dimension(:) :: x

    a vector

    Return Value real(kind=wp)

    the magnitude of the vector

abstract interface

  • private pure function order_func(me) result(p)

    Arguments

    Type IntentOptional Attributes Name
    class(rk_variable_step_class), intent(in) :: me

    Return Value integer

    order of the method

abstract interface

  • private subroutine deriv_func(me, t, x, xdot)

    derivative function

    Arguments

    Type IntentOptional Attributes Name
    class(rk_variable_step_class), intent(inout) :: me
    real(kind=wp), intent(in) :: t

    time

    real(kind=wp), intent(in), dimension(:) :: x

    state vector

    real(kind=wp), intent(out), dimension(:) :: xdot

    derivative of state vector

abstract interface

  • private subroutine event_func(me, t, x, g)

    event function

    Arguments

    Type IntentOptional Attributes Name
    class(rk_variable_step_class), intent(inout) :: me
    real(kind=wp), intent(in) :: t

    time

    real(kind=wp), intent(in), dimension(:) :: x

    state vector

    real(kind=wp), intent(out) :: g

    g(t,x). The goal is to stop the integration when g=0.

abstract interface

  • private subroutine report_func(me, t, x)

    report function

    Arguments

    Type IntentOptional Attributes Name
    class(rk_variable_step_class), intent(inout) :: me
    real(kind=wp), intent(in) :: t

    time

    real(kind=wp), intent(in), dimension(:) :: x

    state vector

abstract interface

  • private subroutine step_func(me, t, x, h, xf, terr)

    rk step function

    Arguments

    Type IntentOptional Attributes Name
    class(rk_variable_step_class), intent(inout) :: me
    real(kind=wp), intent(in) :: t

    initial time

    real(kind=wp), intent(in), dimension(me%n) :: x

    initial state vector

    real(kind=wp), intent(in) :: h

    time step

    real(kind=wp), intent(out), dimension(me%n) :: xf

    final state vector

    real(kind=wp), intent(out), dimension(me%n) :: terr

    truncation error estimate


Derived Types

type, public ::  stepsize_class

Algorithms for adjusting the step size for variable-step Runge-Kutta integrators.

Components

Type Visibility Attributes Name Initial
real(kind=wp), private :: hmax = huge(one)

maximum allowed step size

real(kind=wp), private :: hmin = two*epsilon(one)

minimum allowed step size

real(kind=wp), private :: hfactor_reject = 1.0e-3_wp

minimum allowed factor for decreasing step size after rejected step

real(kind=wp), private :: hfactor_accept = 100.0_wp

maximum allowed factor for increasing step size after accepted step

integer, private :: accept_mode = 1

method to determine if step is accepted [1,2]

integer, private :: max_attempts = 100

maximum number of attempts to decrease step size before giving up

logical, private :: relative_err = .false.

to use tol*h in the hfactor equation

real(kind=wp), private :: safety_factor = 0.9_wp

for hfactor equation (>0)

integer, private :: p_exponent_offset = 0

p + this value in the exponent (0 or 1)

procedure(norm_func), private, nopass, pointer :: norm => maxval_func

routine for computing the norm of the state

Type-Bound Procedures

procedure, public :: initialize => stepsize_class_constructor
procedure, public :: compute_stepsize
procedure, public :: destroy => destroy_stepsize_class

type, public ::  rk_variable_step_class

Main integration class for variable step size Runge-Kutta methods

Components

Type Visibility Attributes Name Initial
integer, private :: n = 0

user specified number of variables

procedure(deriv_func), private, pointer :: f => null()

user-specified derivative function

procedure(report_func), private, pointer :: report => null()

user-specified report function

procedure(event_func), private, pointer :: g => null()

event function (stop when this is zero)

class(stepsize_class), private, allocatable :: stepsize_method

the method for varying the step size

real(kind=wp), private, dimension(:), allocatable :: rtol

relative tolerance (size(n))

real(kind=wp), private, dimension(:), allocatable :: atol

absolute tolerance (size(n))

integer, private :: p = 0

order of the method

integer, private :: hinit_method = 1

if automatically computing the inital step size, which method to use. 1 = hstart, 2 = hinit.

integer, private :: num_rejected_steps = 0

number of rejected steps

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure(step_func), private, deferred :: step ../../

the step routine for the rk method

procedure(order_func), private, deferred :: order ../../

returns p, the order of the method

procedure, private :: hstart ../../

for automatically computing the initial step size [this is from DDEABM]

procedure, private :: hinit ../../

for automatically computing the initial step size [this is from DOP853]

type, public, extends(rk_variable_step_class) ::  rkf78_class

Runga-Kutta Fehlberg 7(8) method.

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure, public :: step => rkf78
procedure, public :: order => rkf78_order

type, public, extends(rk_variable_step_class) ::  rkf89_class

Runga-Kutta Fehlberg 8(9) method.

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure, public :: step => rkf89
procedure, public :: order => rkf89_order

type, public, extends(rk_variable_step_class) ::  rkv89_class

Runga-Kutta Verner 8(9) method.

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure, public :: step => rkv89
procedure, public :: order => rkv89_order

type, public, extends(rk_variable_step_class) ::  rkf108_class

Runga-Kutta Feagin 8(10) method.

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure, public :: step => rkf108
procedure, public :: order => rkf108_order

type, public, extends(rk_variable_step_class) ::  rkf1210_class

Runga-Kutta Feagin 12(10) method.

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure, public :: step => rkf1210
procedure, public :: order => rkf1210_order

type, public, extends(rk_variable_step_class) ::  rkf1412_class

Runga-Kutta Feagin 14(12) method.

Type-Bound Procedures

procedure, public :: initialize ../../

initialize the class (set n,f, and report)

procedure, public :: destroy ../../

destructor

procedure, public, non_overridable :: integrate ../../

main integration routine

procedure, public, non_overridable :: integrate_to_event ../../

integration with event finding

procedure, public :: step => rkf1412
procedure, public :: order => rkf1412_order

Functions

public pure function norm2_func(x) result(xmag)

Use intrinsic norm2(x) for computing the vector norm.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in), dimension(:) :: x

Return Value real(kind=wp)

public pure function maxval_func(x) result(xmag)

Use maxval(abs(x)) for computing the vector norm.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in), dimension(:) :: x

Return Value real(kind=wp)

private pure function rkf78_order(me) result(p)

Returns the order of the rkf78 method.

Arguments

Type IntentOptional Attributes Name
class(rkf78_class), intent(in) :: me

Return Value integer

order of the method

private pure function rkf89_order(me) result(p)

Returns the order of the rkf89 method.

Arguments

Type IntentOptional Attributes Name
class(rkf89_class), intent(in) :: me

Return Value integer

order of the method

private pure function rkv89_order(me) result(p)

Returns the order of the rkv89 method.

Arguments

Type IntentOptional Attributes Name
class(rkv89_class), intent(in) :: me

Return Value integer

order of the method

private pure function rkf108_order(me) result(p)

Returns the order of the rkf108 method.

Arguments

Type IntentOptional Attributes Name
class(rkf108_class), intent(in) :: me

Return Value integer

order of the method

private pure function rkf1210_order(me) result(p)

Returns the order of the rkf1210 method.

Arguments

Type IntentOptional Attributes Name
class(rkf1210_class), intent(in) :: me

Return Value integer

order of the method

private pure function rkf1412_order(me) result(p)

Returns the order of the rkf1412 method.

Arguments

Type IntentOptional Attributes Name
class(rkf1412_class), intent(in) :: me

Return Value integer

order of the method

private function hinit(me, x, y, posneg, f0, hmax, atol, rtol)

computation of an initial step size guess

Read more…

Arguments

Type IntentOptional Attributes Name
class(rk_variable_step_class), intent(inout) :: me
real(kind=wp), intent(in) :: x
real(kind=wp), intent(in), dimension(:) :: y

dimension(n)

real(kind=wp), intent(in) :: posneg

posneg = sign(1.0_wp,xend-x)

real(kind=wp), intent(in), dimension(:) :: f0

dimension(n)

real(kind=wp), intent(in) :: hmax
real(kind=wp), intent(in), dimension(:) :: atol
real(kind=wp), intent(in), dimension(:) :: rtol

Return Value real(kind=wp)


Subroutines

private pure subroutine stepsize_class_constructor(me, hmin, hmax, hfactor_reject, hfactor_accept, norm, accept_mode, relative_err, safety_factor, p_exponent_offset, max_attempts)

Constructor for a stepsize_class.

Read more…

Arguments

Type IntentOptional Attributes Name
class(stepsize_class), intent(inout) :: me
real(kind=wp), intent(in), optional :: hmin

minimum allowed step size (>0)

real(kind=wp), intent(in), optional :: hmax

maximum allowed step size (>0)

real(kind=wp), intent(in), optional :: hfactor_reject

minimum allowed factor for decreasing step size after rejected step (>0)

real(kind=wp), intent(in), optional :: hfactor_accept

maximum allowed factor for decreasing step size after accepted step (>0)

procedure(norm_func), optional :: norm

the user-specified function

integer, intent(in), optional :: accept_mode

method to determine if step is accepted [1,2]

logical, intent(in), optional :: relative_err

to use tol*h in the hfactor equation

real(kind=wp), intent(in), optional :: safety_factor

for hfactor equation (>0)

integer, intent(in), optional :: p_exponent_offset

p + this value in the exponent (0 or 1)

integer, intent(in), optional :: max_attempts

max step size change attempts after rejected step

private subroutine destroy_stepsize_class(me)

Destructor for stepsize_class.

Arguments

Type IntentOptional Attributes Name
class(stepsize_class), intent(out) :: me

private pure subroutine compute_stepsize(me, h, tol, err, p, hnew, accept)

Compute the new step size using the specific method.

Arguments

Type IntentOptional Attributes Name
class(stepsize_class), intent(in) :: me
real(kind=wp), intent(in) :: h

current step size (<>0)

real(kind=wp), intent(in) :: tol

abs error tolerance (>0)

real(kind=wp), intent(in) :: err

truncation error estimate (>0)

integer, intent(in) :: p

order of the method

real(kind=wp), intent(out) :: hnew

new step size (<>0)

logical, intent(out) :: accept

if the step is accepted

private subroutine initialize(me, n, f, rtol, atol, stepsize_method, hinit_method, report, g)

Initialize the rk_variable_step_class.

Arguments

Type IntentOptional Attributes Name
class(rk_variable_step_class), intent(inout) :: me
integer, intent(in) :: n

number of equations

procedure(deriv_func) :: f

derivative function

real(kind=wp), intent(in), dimension(:) :: rtol

relative tolerance (if size=1, then same tol used for all equations)

real(kind=wp), intent(in), dimension(:) :: atol

absolute tolerance (if size=1, then same tol used for all equations)

class(stepsize_class), intent(in) :: stepsize_method

method for varying the step size

integer, intent(in), optional :: hinit_method

which method to use for automatic initial step size computation. 1 = use hstart, 2 = use hinit.

procedure(report_func), optional :: report

for reporting the steps

procedure(event_func), optional :: g

for stopping at an event

private subroutine destroy(me)

Destructor for rk_variable_step_class.

Arguments

Type IntentOptional Attributes Name
class(rk_variable_step_class), intent(out) :: me

private subroutine integrate(me, t0, x0, h, tf, xf, ierr)

Main integration routine for the rk_variable_step_class.

Arguments

Type IntentOptional Attributes Name
class(rk_variable_step_class), intent(inout) :: me
real(kind=wp), intent(in) :: t0

initial time

real(kind=wp), intent(in), dimension(:) :: x0

initial state

real(kind=wp), intent(in) :: h

initial abs(time step)

real(kind=wp), intent(in) :: tf

final time

real(kind=wp), intent(out), dimension(:) :: xf

final state

integer, intent(out), optional :: ierr

0 = no errors, <0 = error. if not present, an error will stop program.

private subroutine integrate_to_event(me, t0, x0, h, tmax, tol, tf, xf, gf, ierr)

Event-finding integration routine for the rk_variable_step_class. Integrates until g(t,x)=0, or until t=tf (whichever happens first).

Read more…

Arguments

Type IntentOptional Attributes Name
class(rk_variable_step_class), intent(inout) :: me
real(kind=wp), intent(in) :: t0

initial time

real(kind=wp), intent(in), dimension(me%n) :: x0

initial state

real(kind=wp), intent(in) :: h

abs(time step)

real(kind=wp), intent(in) :: tmax

max final time if event not located

real(kind=wp), intent(in) :: tol

function tolerance for root finding

real(kind=wp), intent(out) :: tf

actual final time reached

real(kind=wp), intent(out), dimension(me%n) :: xf

final state (at tf)

real(kind=wp), intent(out) :: gf

g value at tf

integer, intent(out), optional :: ierr

0 = no errors, <0 = error. if not present, an error will stop program.

private subroutine rkf78(me, t, x, h, xf, terr)

Fehlberg's 7(8) algorithm.

Read more…

Arguments

Type IntentOptional Attributes Name
class(rkf78_class), intent(inout) :: me
real(kind=wp), intent(in) :: t
real(kind=wp), intent(in), dimension(me%n) :: x
real(kind=wp), intent(in) :: h
real(kind=wp), intent(out), dimension(me%n) :: xf
real(kind=wp), intent(out), dimension(me%n) :: terr

private subroutine rkf89(me, t, x, h, xf, terr)

Fehlberg 8(9) method.

Read more…

Arguments

Type IntentOptional Attributes Name
class(rkf89_class), intent(inout) :: me
real(kind=wp), intent(in) :: t

initial time

real(kind=wp), intent(in), dimension(me%n) :: x

initial state

real(kind=wp), intent(in) :: h

time step

real(kind=wp), intent(out), dimension(me%n) :: xf

state at time t+h

real(kind=wp), intent(out), dimension(me%n) :: terr

truncation error estimate

private subroutine rkv89(me, t, x, h, xf, terr)

Runge Kutta Verner 8(9)

Read more…

Arguments

Type IntentOptional Attributes Name
class(rkv89_class), intent(inout) :: me
real(kind=wp), intent(in) :: t

initial time

real(kind=wp), intent(in), dimension(me%n) :: x

initial state

real(kind=wp), intent(in) :: h

time step

real(kind=wp), intent(out), dimension(me%n) :: xf

state at time t+h

real(kind=wp), intent(out), dimension(me%n) :: terr

truncation error estimate

private subroutine rkf108(me, t, x, h, xf, terr)

Feagin's RK8(10) method -- a 10th-order method with an embedded 8th-order method.

Read more…

Arguments

Type IntentOptional Attributes Name
class(rkf108_class), intent(inout) :: me
real(kind=wp), intent(in) :: t

initial time

real(kind=wp), intent(in), dimension(me%n) :: x

initial state

real(kind=wp), intent(in) :: h

time step

real(kind=wp), intent(out), dimension(me%n) :: xf

state at time t+h

real(kind=wp), intent(out), dimension(me%n) :: terr

truncation error estimate

private subroutine rkf1210(me, t, x, h, xf, terr)

Feagin's RK12(10) method -- a 12th-order method with an embedded 10th-order method.

Read more…

Arguments

Type IntentOptional Attributes Name
class(rkf1210_class), intent(inout) :: me
real(kind=wp), intent(in) :: t

initial time

real(kind=wp), intent(in), dimension(me%n) :: x

initial state

real(kind=wp), intent(in) :: h

time step

real(kind=wp), intent(out), dimension(me%n) :: xf

state at time t+h

real(kind=wp), intent(out), dimension(me%n) :: terr

truncation error estimate

private subroutine rkf1412(me, t, x, h, xf, terr)

Feagin's RK14(12) - a 14th-order method with an embedded 12th-order method.

Read more…

Arguments

Type IntentOptional Attributes Name
class(rkf1412_class), intent(inout) :: me
real(kind=wp), intent(in) :: t

initial time

real(kind=wp), intent(in), dimension(me%n) :: x

initial state

real(kind=wp), intent(in) :: h

time step

real(kind=wp), intent(out), dimension(me%n) :: xf

state at time t+h

real(kind=wp), intent(out), dimension(me%n) :: terr

truncation error estimate

private subroutine hstart(me, a, b, y, yprime, etol, h)

Computes a starting step size to be used in solving initial value problems in ordinary differential equations.

Read more…

Arguments

Type IntentOptional Attributes Name
class(rk_variable_step_class), intent(inout) :: me
real(kind=wp), intent(in) :: a

the initial point of integration.

real(kind=wp), intent(in) :: b

a value of the independent variable used to define the direction of integration. a reasonable choice is to set b to the first point at which a solution is desired. you can also use b, if necessary, to restrict the length of the first integration step because the algorithm will not compute a starting step length which is bigger than abs(b-a), unless b has been chosen too close to a. (it is presumed that hstart has been called with b different from a on the machine being used. also see the discussion about the parameter small.)

real(kind=wp), intent(in), dimension(me%n) :: y

the vector of initial values of the neq solution components at the initial point a.

real(kind=wp), intent(in), dimension(me%n) :: yprime

the vector of derivatives of the neq solution components at the initial point a. (defined by the differential equations in subroutine me%f)

real(kind=wp), intent(in), dimension(me%n) :: etol

the vector of error tolerances corresponding to the neq solution components. it is assumed that all elements are positive. following the first integration step, the tolerances are expected to be used by the integrator in an error test which roughly requires that abs(local error) <= etol for each vector component.

real(kind=wp), intent(out) :: h

appropriate starting step size to be attempted by the differential equation method.

public subroutine step_size_test()

Unit tests for step size adjustment routines.

Arguments

None

public subroutine rk_test_variable_step()

Unit test of the rk_module. Integrate a two-body orbit around the Earth.

Arguments

None