numerical_differentiation_module Module

Numerical differentiation module for computing the Jacobian matrix (the derivative matrix of m functions w.r.t. n variables) using finite differences.


Uses

  • module~~numerical_differentiation_module~~UsesGraph module~numerical_differentiation_module numerical_differentiation_module iso_fortran_env iso_fortran_env module~numerical_differentiation_module->iso_fortran_env module~diff_module diff_module module~numerical_differentiation_module->module~diff_module module~dsm_module dsm_module module~numerical_differentiation_module->module~dsm_module module~numdiff_cache_module numdiff_cache_module module~numerical_differentiation_module->module~numdiff_cache_module module~numdiff_kinds_module numdiff_kinds_module module~numerical_differentiation_module->module~numdiff_kinds_module module~numdiff_utilities_module numdiff_utilities_module module~numerical_differentiation_module->module~numdiff_utilities_module module~diff_module->module~numdiff_kinds_module module~dsm_module->module~numdiff_kinds_module module~numdiff_cache_module->iso_fortran_env module~numdiff_cache_module->module~numdiff_kinds_module module~numdiff_cache_module->module~numdiff_utilities_module module~numdiff_kinds_module->iso_fortran_env module~numdiff_utilities_module->module~numdiff_kinds_module

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private, parameter :: zero = 0.0_wp

Interfaces

public interface finite_diff_method

constructor

  • private function initialize_finite_difference_method(id, name, class, dx_factors, df_factors, df_den_factor) result(me)

    Constructor for a finite_diff_method.

    Note

    factors are input as integers for convenience, but are converted to reals for the actual computations. (note: this means we can't currently define methods that have non-integer factors).

    Arguments

    Type IntentOptional Attributes Name
    integer, intent(in) :: id

    unique ID for the method

    character(len=*), intent(in) :: name

    the name of the method

    integer, intent(in) :: class

    2=backward diffs, 3=central diffs, etc...

    integer, intent(in), dimension(:) :: dx_factors

    multiplicative factors for dx perturbation

    integer, intent(in), dimension(:) :: df_factors

    multiplicative factors for accumulating function evaluations

    integer, intent(in) :: df_den_factor

    denominator factor for finite difference equation (times dx)

    Return Value type(finite_diff_method)


Abstract Interfaces

abstract interface

  • private subroutine func(me, x, f, funcs_to_compute)

    The function (vector array of output functions f, computed from a vector of input variables x). This must be defined for all computations.

    Arguments

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

    array of variables (size n)

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

    array of functions (size m)

    integer, intent(in), dimension(:) :: funcs_to_compute

    the elements of the function vector that need to be computed (the other are ignored)

abstract interface

  • private subroutine spars_f(me, x)

    The function to compute the sparsity pattern. It populates the irow and icol variables in the class.

    Arguments

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

    vector of variables (size n)

abstract interface

  • private subroutine info_f(me, column, i, x)

    User-defined info function (optional). Informs user what is being done during Jacobian computation. It can be used to perform any setup operations that need to done on the user's end.

    Arguments

    Type IntentOptional Attributes Name
    class(numdiff_type), intent(inout) :: me
    integer, intent(in), dimension(:) :: column

    the columns being computed.

    integer, intent(in) :: i

    perturbing these columns for the ith time (1,2,...)

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

    the nominal variable vector

abstract interface

  • private subroutine jacobian_f(me, x, dx, jac)

    Actual function for computing the Jacobian called by compute_jacobian.

    Arguments

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

    vector of variables (size n)

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

    absolute perturbation (>0) for each variable

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

    sparse jacobian vector (size num_nonzero_elements)


Derived Types

type, public ::  finite_diff_method

defines the finite difference method used to compute the Jacobian.

Read more…

Components

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

unique ID for the method

character(len=:), private, allocatable :: name

the name of the method

integer, private :: class = 0

2=backward diffs, 3=central diffs, etc...

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

multiplicative factors for dx perturbation

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

multiplicative factors for accumulating function evaluations

real(kind=wp), private :: df_den_factor = zero

denominator factor for finite difference equation (times dx)

Constructor

constructor

private function initialize_finite_difference_method (id, name, class, dx_factors, df_factors, df_den_factor)

Constructor for a finite_diff_method.

Read more…

Type-Bound Procedures

procedure, public :: get_formula
procedure, public :: print => print_finite_difference_method

type, public ::  meth_array

to store an array of finite_diff_method types this is used when the mode=2 option is used in numdiff_type

Components

Type Visibility Attributes Name Initial
type(finite_diff_method), private, dimension(:), allocatable :: meth

type, public ::  sparsity_pattern

A sparsity pattern

Components

Type Visibility Attributes Name Initial
logical, private :: sparsity_computed = .false.

has the sparsity pattern already been computed?

integer, private :: num_nonzero_elements = 0

number of nonzero elements in the jacobian (will be the dimension of irow and icol)

integer, private, dimension(:), allocatable :: irow

sparsity pattern - rows of non-zero elements

integer, private, dimension(:), allocatable :: icol

sparsity pattern - columns of non-zero elements

logical, private :: linear_sparsity_computed = .false.

if the linear pattern has been populated

integer, private :: num_nonzero_linear_elements = 0

number of constant elements in the jacobian

integer, private, dimension(:), allocatable :: linear_irow

linear sparsity pattern - rows of non-zero elements

integer, private, dimension(:), allocatable :: linear_icol

linear sparsity pattern - columns of non-zero elements

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

linear elements of the jacobian

integer, private, dimension(:), allocatable :: indices

index vector [1,2,...,num_nonzero_elements] for putting df into jac

integer, private :: maxgrp = 0

the number of groups in the partition of the columns of a.

integer, private, dimension(:), allocatable :: ngrp

specifies the partition of the columns of a. column jcol belongs to group ngrp(jcol). size(n)

Type-Bound Procedures

procedure, private :: dsm_wrapper
procedure, private :: compute_indices
procedure, public :: destroy => destroy_sparsity
procedure, public :: print => print_sparsity
procedure, public :: columns_in_partition_group

type, public ::  numdiff_type

base type for sparsity and Jacobian computations.

Components

Type Visibility Attributes Name Initial
logical, private :: exception_raised = .false.

if true, an exception has been raised

integer, private :: istat = 0

a non-zero value will cause all routine to exit. this can be set to -1 by calling terminate.

character(len=:), private, allocatable :: error_msg

error message (if istat/=0)

integer, private :: n = 0

number of x variables

integer, private :: m = 0

number of f functions

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

lower bounds on x

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

upper bounds on x

logical, private :: print_messages = .true.

if true, warning messages are printed to the error_unit for any errors.

integer, private :: chunk_size = 100

chuck size for allocating the arrays (>0)

integer, private :: perturb_mode = 1

perturbation mode:

Read more…
real(kind=wp), private, dimension(:), allocatable :: dpert

perturbation vector for x

logical, private :: partition_sparsity_pattern = .false.

to partition the sparsity pattern using dsm

type(sparsity_pattern), private :: sparsity

the sparsity pattern

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

lower bounds on x for computing sparsity (optional)

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

upper bounds on x for computing sparsity (optional)

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

perturbation vector for x when computing sparsity for sparsity_mode=4

integer, private :: num_sparsity_points = 3

for sparsity_mode=4, the number of jacobian evaluations used to estimate the sparsity pattern. See compute_sparsity_random_2

integer, private :: sparsity_perturb_mode = 1

perturbation mode (if sparsity_mode=4):

Read more…
logical, private :: compute_linear_sparsity_pattern = .false.

to also compute the linear sparsity pattern

real(kind=wp), private :: linear_sparsity_tol = epsilon(1.0_wp)

the equality tolerance for derivatives to indicate a constant jacobian element (linear sparsity)

real(kind=wp), private :: function_precision_tol = epsilon(1.0_wp)

the function precision. two functions values that are the within this tolerance are considered the same value. This is used when estimating the sparsity pattern when sparsity_mode=2 in compute_sparsity_random

integer, private :: mode = 1

1 = use meth (specified methods), 2 = use class (specified class, method is selected on-the-fly).

type(finite_diff_method), private, dimension(:), allocatable :: meth

the finite difference method to use compute the nth column of the Jacobian size(n). Either this or class is used

integer, private, dimension(:), allocatable :: class

the class of method to use to compute the nth column of the Jacobian size(n). Either this or meth is used

type(meth_array), private, dimension(:), allocatable :: class_meths

array of methods for the specified classes. used with class when mode=2

real(kind=wp), private :: eps = 1.0e-9_wp

tolerance parameter for diff

real(kind=wp), private :: acc = 0.0_wp

tolerance parameter for diff

type(function_cache), private :: cache

if using the function cache

logical, private :: use_diff = .false.

if we are using the Neville's process method, rather than finite differences

procedure(func), private, pointer :: problem_func => null()

the user-defined function

procedure(func), private, pointer :: compute_function => null()

compute the user-defined function this can point to the problem_func or, if using the cache, it points to compute_function_with_cache.

procedure(spars_f), private, pointer :: compute_sparsity => null()

for computing the sparsity pattern

procedure(info_f), private, pointer :: info_function => null()

an optional function the user can define which is called when each column of the jacobian is computed. It can be used to perform any setup operations.

procedure(jacobian_f), private, pointer :: jacobian_function => null()

the low-level function called by compute_jacobian that actually computes the jacobian.

Type-Bound Procedures

procedure, public :: initialize => initialize_numdiff ../../

initialize the class

procedure, public :: diff_initialize => initialize_numdiff_for_diff ../../

initialize the class

procedure, public :: compute_jacobian ../../

main routine to compute the Jacobian using the selected options. It returns the sparse (vector) form.

procedure, public :: compute_jacobian_dense ../../

return the dense size(m,n) matrix form of the Jacobian.

procedure, public :: compute_jacobian_times_vector ../../

returns the product of the Jacobian matrix and an input vector

procedure, public :: destroy => destroy_numdiff_type ../../

destroy the class

procedure, public :: print_sparsity_pattern ../../

print the sparsity pattern in vector form to a file

procedure, public :: print_sparsity_matrix ../../

print the sparsity pattern in matrix form to a file

procedure, public :: set_sparsity_pattern ../../

manually set the sparsity pattern

procedure, public :: select_finite_diff_method ../../

select a method in a specified class so that the variable bounds are not violated when by the perturbations.

procedure, public :: select_finite_diff_method_for_partition_group

version of select_finite_diff_method for partitioned sparsity pattern.

procedure, public :: set_numdiff_bounds ../../

can be called to change the variable bounds.

procedure, public :: compute_sparsity_pattern ../../

if the user needs to compute the sparsity pattern manually. (otherwise it will be done the first time the Jacobian is computed)

procedure, public :: get_sparsity_pattern ../../

returns the sparsity pattern (if it is allocated)

procedure, public :: terminate ../../

can be called by user to stop the computation

procedure, public :: failed ../../

to check if an exception was raised.

procedure, public :: get_error_status ../../

the status of error condition

procedure, public :: set_dpert ../../

change the dpert values

procedure, private :: destroy_sparsity_pattern ../../

destroy the sparsity pattern

procedure, private :: compute_perturb_vector
procedure, private :: compute_perturbation_vector ../../

computes the variable perturbation factor

procedure, private :: compute_sparsity_perturbation_vector
procedure, private :: perturb_x_and_compute_f
procedure, private :: perturb_x_and_compute_f_partitioned
procedure, private :: set_numdiff_sparsity_bounds
procedure, private :: set_sparsity_mode
procedure, private :: generate_dense_sparsity_partition
procedure, private :: compute_jacobian_for_sparsity
procedure, private :: resize_sparsity_vectors
procedure, private :: raise_exception
procedure, private :: clear_exceptions

Functions

private function initialize_finite_difference_method(id, name, class, dx_factors, df_factors, df_den_factor) result(me)

Constructor for a finite_diff_method.

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: id

unique ID for the method

character(len=*), intent(in) :: name

the name of the method

integer, intent(in) :: class

2=backward diffs, 3=central diffs, etc...

integer, intent(in), dimension(:) :: dx_factors

multiplicative factors for dx perturbation

integer, intent(in), dimension(:) :: df_factors

multiplicative factors for accumulating function evaluations

integer, intent(in) :: df_den_factor

denominator factor for finite difference equation (times dx)

Return Value type(finite_diff_method)

public function get_all_methods_in_class(class) result(list_of_methods)

Returns all the methods with the given class (i.e., number of points in the formula).

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: class

the class is the number of points in the finite different computation

Return Value type(meth_array)

all the methods with the specified class

private pure function failed(me)

Returns True if an exception has been raised.

Arguments

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

Return Value logical

private function integer_to_string(i, with_sign) result(str)

Convert an integer to a string.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: i

the integer

logical, intent(in), optional :: with_sign

also include the sign (default is False)

Return Value character(len=:), allocatable

integer converted to a string


Subroutines

private subroutine print_finite_difference_method(me, iunit)

Print the contents of a finite_diff_method. Used for debugging.

Arguments

Type IntentOptional Attributes Name
class(finite_diff_method), intent(in) :: me
integer, intent(in) :: iunit

file unit for printing (assumed to be opened)

private subroutine compute_function_with_cache(me, x, f, funcs_to_compute)

Wrapper for computing the function, using the cache.

Arguments

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

array of variables (size n)

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

array of functions (size m)

integer, intent(in), dimension(:) :: funcs_to_compute

the elements of the function vector that need to be computed (the other are ignored)

private subroutine get_formula(me, formula)

Return a string with the finite difference formula.

Read more…

Arguments

Type IntentOptional Attributes Name
class(finite_diff_method), intent(in) :: me
character(len=:), intent(out), allocatable :: formula

public subroutine get_finite_diff_formula(id, formula, name)

Return a string with the finite difference formula. Input is the method id code.

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: id

the id code for the method

character(len=:), intent(out), allocatable :: formula

the formula string

character(len=:), intent(out), optional, allocatable :: name

private subroutine get_finite_difference_method(id, fd, found)

Return a finite_diff_method given the id code. (the id codes begin at 1, are sequential, and uniquely define the method).

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: id

the id code for the method

type(finite_diff_method), intent(out) :: fd

this method (can be used in compute_jacobian)

logical, intent(out) :: found

true if it was found

private subroutine select_finite_diff_method(me, x, xlow, xhigh, dx, list_of_methods, fd, status_ok)

Select a finite diff method of a given class so that the perturbations of x will not violate the variable bounds.

Arguments

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

the variable value

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

the variable lower bound

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

the variable upper bound

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

the perturbation value (>0)

type(meth_array), intent(in) :: list_of_methods

list of available methods to choose from

type(finite_diff_method), intent(out) :: fd

this method can be used

logical, intent(out) :: status_ok

true if it really doesn't violate the bounds (say, the bounds are very close to each other) if status_ok=False, then the first method in the given class is returned in fd.

private subroutine select_finite_diff_method_for_partition_group(me, x, xlow, xhigh, dx, list_of_methods, fd, status_ok)

Select a finite diff method of a given class so that the perturbations of x will not violate the variable bounds for any variable in the group.

Read more…

Arguments

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

the variable values

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

the variable lower bounds

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

the variable upper bounds

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

the perturbation values (>0)

type(meth_array), intent(in) :: list_of_methods

list of available methods to choose from

type(finite_diff_method), intent(out) :: fd

this method can be used

logical, intent(out) :: status_ok

true if it really doesn't violate the bounds (say, the bounds are very close to each other) if status_ok=False, then the first method in the given class is returned in fd.

private subroutine initialize_numdiff_for_diff(me, n, m, xlow, xhigh, problem_func, sparsity_mode, info, chunk_size, eps, acc, cache_size, xlow_for_sparsity, xhigh_for_sparsity, dpert_for_sparsity, sparsity_perturb_mode, linear_sparsity_tol, function_precision_tol, num_sparsity_points, print_messages)

Alternate version of initialize_numdiff routine when using diff to compute the Jacobian.

Arguments

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

number of x variables

integer, intent(in) :: m

number of f functions

real(kind=wp), intent(in), dimension(n) :: xlow

lower bounds on x

real(kind=wp), intent(in), dimension(n) :: xhigh

upper bounds on x

procedure(func) :: problem_func

the user function that defines the problem (returns m functions)

integer, intent(in) :: sparsity_mode

the sparsity computation method:

Read more…
procedure(info_f), optional :: info

a function the user can define which is called when each column of the jacobian is computed. It can be used to perform any setup operations.

integer, intent(in), optional :: chunk_size

chunk size for allocating the arrays (must be >0) [default is 100]

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

tolerance parameter for diff if not present, default is 1.0e-9_wp

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

tolerance parameter for diff if not present, default is 0.0_wp

integer, intent(in), optional :: cache_size

if present, this is the cache size for the function cache (default is not to enable cache)

real(kind=wp), intent(in), optional, dimension(n) :: xlow_for_sparsity

lower bounds on x used for sparsity computation (when sparsity_mode is 2). If not present, then xlow is used.

real(kind=wp), intent(in), optional, dimension(n) :: xhigh_for_sparsity

upper bounds on x used for sparsity computation (when sparsity_mode is 2). If not present, then xhigh is used.

real(kind=wp), intent(in), optional, dimension(n) :: dpert_for_sparsity

required if sparsity_mode=4

integer, intent(in), optional :: sparsity_perturb_mode

perturbation mode (required if sparsity_mode=4):

Read more…
real(kind=wp), intent(in), optional :: linear_sparsity_tol

the equality tolerance for derivatives to indicate a constant jacobian element (linear sparsity)

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

the function precision. two functions values that are the within this tolerance are considered the same value. This is used when estimating the sparsity pattern when sparsity_mode=2 in compute_sparsity_random

integer, intent(in), optional :: num_sparsity_points

for sparsity_mode=4, the number of jacobian evaluations used to estimate the sparsity pattern.

logical, intent(in), optional :: print_messages

if true, print error messages to error_unit. default is True.

private subroutine set_numdiff_bounds(me, xlow, xhigh)

Change the variable bounds in a numdiff_type.

Read more…

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(:) :: xlow

lower bounds on x

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

upper bounds on x

private subroutine set_sparsity_mode(me, sparsity_mode, xlow_for_sparsity, xhigh_for_sparsity)

Set sparsity mode.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in) :: sparsity_mode

the sparsity computation method: 1 - assume dense, 2 - three-point simple method, 3 - will be specified by the user in a subsequent call to set_sparsity_pattern. 4 - computes a two-point jacobian at num_sparsity_points points.

real(kind=wp), intent(in), optional, dimension(:) :: xlow_for_sparsity

lower bounds on x used for sparsity computation (when sparsity_mode is 2). If not present, then xlow is used.

real(kind=wp), intent(in), optional, dimension(:) :: xhigh_for_sparsity

upper bounds on x used for sparsity computation (when sparsity_mode is 2). If not present, then xhigh is used.

private subroutine set_numdiff_sparsity_bounds(me, xlow, xhigh)

Sets the variable bounds for sparsity in a numdiff_type. These are only used for sparsity_mode=2.

Read more…

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), optional, dimension(:) :: xlow

lower bounds on x to be used for sparsity computation. If not present, then then xlow values in the class are used.

real(kind=wp), intent(in), optional, dimension(:) :: xhigh

upper bounds on x to be used for sparsity computation. If not present, then then xhigh values in the class are used.

private subroutine set_dpert(me, dpert)

Change the dpert vector. Can be used after the class has been initialized to change the perturbation step sizes (e.g., after an iteration).

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(:) :: dpert

perturbation vector for x

private subroutine initialize_numdiff(me, n, m, xlow, xhigh, perturb_mode, dpert, problem_func, sparsity_mode, jacobian_method, jacobian_methods, class, classes, info, chunk_size, partition_sparsity_pattern, cache_size, xlow_for_sparsity, xhigh_for_sparsity, dpert_for_sparsity, sparsity_perturb_mode, linear_sparsity_tol, function_precision_tol, num_sparsity_points)

Initialize a numdiff_type class. This must be called first.

Read more…

Arguments

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

number of x variables

integer, intent(in) :: m

number of f functions

real(kind=wp), intent(in), dimension(n) :: xlow

lower bounds on x

real(kind=wp), intent(in), dimension(n) :: xhigh

upper bounds on x

integer, intent(in) :: perturb_mode

perturbation mode: 1 - perturbation is dx=dpert, 2 - perturbation is dx=dpert*x, 3 - perturbation is dx=dpert*(1+x)

real(kind=wp), intent(in), dimension(n) :: dpert

perturbation vector for x

procedure(func) :: problem_func

the user function that defines the problem (returns m functions)

integer, intent(in) :: sparsity_mode

the sparsity computation method: 1 - assume dense, 2 - three-point simple method, 3 - will be specified by the user in a subsequent call to set_sparsity_pattern. 4 - computes a two-point jacobian at num_sparsity_points points.

integer, intent(in), optional :: jacobian_method

id code for the finite difference method to use for all n variables. see get_finite_difference_method

integer, intent(in), optional, dimension(n) :: jacobian_methods

id codes for the finite difference method to use for each variable. see get_finite_difference_method

integer, intent(in), optional :: class

method class for the finite difference method to use for all n variables. see get_finite_difference_method

integer, intent(in), optional, dimension(n) :: classes

method class for the finite difference methods to use for each variable. see get_finite_difference_method

procedure(info_f), optional :: info

a function the user can define which is called when each column of the jacobian is computed. It can be used to perform any setup operations.

integer, intent(in), optional :: chunk_size

chunk size for allocating the arrays (must be >0) [default is 100]

logical, intent(in), optional :: partition_sparsity_pattern

if the sparisty pattern is to be partitioned using DSM [default is False]

integer, intent(in), optional :: cache_size

if present, this is the cache size for the function cache (default is not to enable cache)

real(kind=wp), intent(in), optional, dimension(n) :: xlow_for_sparsity

lower bounds on x used for sparsity computation (when sparsity_mode is 2). If not present, then xlow is used.

real(kind=wp), intent(in), optional, dimension(n) :: xhigh_for_sparsity

upper bounds on x used for sparsity computation (when sparsity_mode is 2). If not present, then xhigh is used.

real(kind=wp), intent(in), optional, dimension(n) :: dpert_for_sparsity

for sparsity_mode=4, the perturbation

integer, intent(in), optional :: sparsity_perturb_mode

perturbation mode (required if sparsity_mode=4): 1 - perturbation is dx=dpert, 2 - perturbation is dx=dpert*x, 3 - perturbation is dx=dpert*(1+x)

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

the equality tolerance for derivatives to indicate a constant jacobian element (linear sparsity)

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

the function precision. two functions values that are the within this tolerance are considered the same value. This is used when estimating the sparsity pattern when sparsity_mode=2 in compute_sparsity_random

integer, intent(in), optional :: num_sparsity_points

for sparsity_mode=4, the number of jacobian evaluations used to estimate the sparsity pattern.

private subroutine destroy_numdiff_type(me)

destroy the numdiff_type class.

Arguments

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

private subroutine destroy_sparsity(me)

destroy a sparsity_pattern type.

Arguments

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

private subroutine dsm_wrapper(me, n, m, info)

Wrapper for dsm to compute the sparsity pattern partition.

Arguments

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

number of columns of jacobian matrix

integer, intent(in) :: m

number of rows of jacobian matrix

integer, intent(out) :: info

status output from dsm

private subroutine columns_in_partition_group(me, igroup, n_cols, cols, nonzero_rows, indices, status_ok)

Returns the columns in a sparsity partition group.

Read more…

Arguments

Type IntentOptional Attributes Name
class(sparsity_pattern), intent(in) :: me
integer, intent(in) :: igroup

group number. Should be >0 and <=me%mxgrp

integer, intent(out) :: n_cols

number of columns in the igroup group.

integer, intent(out), dimension(:), allocatable :: cols

the column numbers in the igroup group. (if none, then it is not allocated)

integer, intent(out), dimension(:), allocatable :: nonzero_rows

the row numbers of all the nonzero Jacobian elements in this group

integer, intent(out), dimension(:), allocatable :: indices

nonzero indices in jac for a group

logical, intent(out) :: status_ok

true if the partition is valid

private subroutine destroy_sparsity_pattern(me)

Destroy the sparsity pattern in the class.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me

private subroutine compute_indices(me)

Computes the indices vector in the class.

Arguments

Type IntentOptional Attributes Name
class(sparsity_pattern), intent(inout) :: me

private subroutine set_sparsity_pattern(me, irow, icol, linear_irow, linear_icol, linear_vals, maxgrp, ngrp)

To specify the sparsity pattern directly if it is already known.

Read more…

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in), dimension(:) :: irow

sparsity pattern nonzero elements row indices

integer, intent(in), dimension(:) :: icol

sparsity pattern nonzero elements column indices

integer, intent(in), optional, dimension(:) :: linear_irow

linear sparsity pattern nonzero elements row indices

integer, intent(in), optional, dimension(:) :: linear_icol

linear sparsity pattern nonzero elements column indices

real(kind=wp), intent(in), optional, dimension(:) :: linear_vals

linear sparsity values (constant elements of the Jacobian)

integer, intent(in), optional :: maxgrp

DSM sparsity partition [only used if me%partition_sparsity_pattern=True]

integer, intent(in), optional, dimension(:) :: ngrp

DSM sparsity partition (size n) [only used if me%partition_sparsity_pattern=True]

private subroutine compute_sparsity_dense(me, x)

assume all elements of Jacobian are non-zero.

Arguments

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

vector of variables (size n)

private subroutine generate_dense_sparsity_partition(me)

Generate a "dense" sparsity partition.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me

private subroutine compute_sparsity_random(me, x)

Compute the sparsity pattern by computing the function at three "random" points in the [xlow_for_sparsity, xhigh_for_sparsity] interval and checking if the function values are the same.

Arguments

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

vector of variables (size n) (not used here)

private subroutine resize_sparsity_vectors(me, n_icol, n_irow, n_linear_icol, n_linear_irow, n_linear_vals)

Resize the sparsity arrays after accumulating them.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(inout) :: n_icol
integer, intent(inout) :: n_irow
integer, intent(inout) :: n_linear_icol
integer, intent(inout) :: n_linear_irow
integer, intent(inout) :: n_linear_vals

private subroutine compute_sparsity_random_2(me, x)

Compute the sparsity pattern by computing a 2-point jacobian at a specified number of "random" points (num_sparsity_points) in the [xlow_for_sparsity, xhigh_for_sparsity] interval and checking if they are the same.

Arguments

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

vector of variables (size n) (not used here)

private subroutine compute_sparsity_pattern(me, x, irow, icol, linear_irow, linear_icol, linear_vals)

Computes the sparsity pattern and return it. Uses the settings currently in the class.

Arguments

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

vector of variables (size n)

integer, intent(out), dimension(:), allocatable :: irow

sparsity pattern nonzero elements row indices

integer, intent(out), dimension(:), allocatable :: icol

sparsity pattern nonzero elements column indices

integer, intent(out), optional, dimension(:), allocatable :: linear_irow

linear sparsity pattern nonzero elements row indices

integer, intent(out), optional, dimension(:), allocatable :: linear_icol

linear sparsity pattern nonzero elements column indices

real(kind=wp), intent(out), optional, dimension(:), allocatable :: linear_vals

linear sparsity values (constant elements of the Jacobian)

private subroutine get_sparsity_pattern(me, irow, icol, linear_irow, linear_icol, linear_vals, maxgrp, ngrp)

Returns the sparsity pattern from the class. If it hasn't been computed, the output arrays will not be allocated.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(out), dimension(:), allocatable :: irow

sparsity pattern nonzero elements row indices

integer, intent(out), dimension(:), allocatable :: icol

sparsity pattern nonzero elements column indices

integer, intent(out), optional, dimension(:), allocatable :: linear_irow

linear sparsity pattern nonzero elements row indices

integer, intent(out), optional, dimension(:), allocatable :: linear_icol

linear sparsity pattern nonzero elements column indices

real(kind=wp), intent(out), optional, dimension(:), allocatable :: linear_vals

linear sparsity values (constant elements of the Jacobian)

integer, intent(out), optional :: maxgrp

DSM sparsity partition

integer, intent(out), optional, dimension(:), allocatable :: ngrp

DSM sparsity partition

private subroutine compute_jacobian_dense(me, x, jac)

just a wrapper for compute_jacobian, that returns a dense (m x n) matrix.

Read more…

Arguments

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

vector of variables (size n)

real(kind=wp), intent(out), dimension(:,:), allocatable :: jac

the jacobian matrix

private subroutine perturb_x_and_compute_f(me, x, dx_factor, dx, df_factor, column, idx, df)

Perturb the specified optimization variable, and compute the function. This routine is designed so that df is accumulated as each function evaluation is done, to avoid having to allocate more temporary storage.

Arguments

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

nominal variable vector

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

factor to multiply dx

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

the perturbation value for this column

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

factor to multiply function value

integer, intent(in) :: column

the variable to perturb

integer, intent(in), dimension(:) :: idx

the elements in this column of the Jacobian to compute (passed to function)

real(kind=wp), intent(inout), dimension(me%m) :: df

the accumulated function value note: for the first call, this should be set to zero

private subroutine compute_jacobian_times_vector(me, x, v, z)

Returns the product J*v, where J is the m x n Jacobian matrix and v is an n x 1 vector.

Read more…

Arguments

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

vector of variables (size n)

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

vector (size n)

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

The product J*v (size m)

private subroutine compute_jacobian(me, x, jac)

Compute the Jacobian.

Read more…

Arguments

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

vector of variables (size n)

real(kind=wp), intent(out), dimension(:), allocatable :: jac

sparse jacobian vector

private subroutine compute_jacobian_for_sparsity(me, i, class_meths, x, jac)

A separate version of compute_jacobian to be used only when computing the sparsity pattern in compute_sparsity_random_2. It uses class_meths and the sparsity dperts and bounds.

Read more…

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in) :: i

the column being computed

type(meth_array), intent(in) :: class_meths

set of finite diff methods to use

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

vector of variables (size n)

real(kind=wp), intent(out), dimension(:), allocatable :: jac

sparse jacobian vector

private subroutine compute_jacobian_standard(me, x, dx, jac)

Compute the Jacobian using finite differences. (one column at a time)

Arguments

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

vector of variables (size n)

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

absolute perturbation (>0) for each variable

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

sparse jacobian vector (size num_nonzero_elements)

private subroutine compute_jacobian_with_diff(me, x, dx, jac)

Compute the Jacobian one element at a time using the Neville's process algorithm diff. This takes a very large number of function evaluations, but should give a very accurate answer.

Arguments

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

vector of variables (size n)

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

absolute perturbation (>0) for each variable

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

sparse jacobian vector (size num_nonzero_elements)

private subroutine compute_jacobian_partitioned(me, x, dx, jac)

Compute the Jacobian using finite differences, (using the partitioned sparsity pattern to compute multiple columns at a time).

Arguments

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

vector of variables (size n)

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

absolute perturbation (>0) for each variable

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

sparse jacobian vector

private subroutine perturb_x_and_compute_f_partitioned(me, x, dx_factor, dx, df_factor, columns, idx, df)

Perturb the specified optimization variable, and compute the function. This routine is designed so that df is accumulated as each function evaluation is done, to avoid having to allocate more temporary storage.

Arguments

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

nominal variable vector

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

factor to multiply dx

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

the perturbation value for this column

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

factor to multiply function value

integer, intent(in), dimension(:) :: columns

the variables to perturb

integer, intent(in), dimension(:) :: idx

the elements in this column of the Jacobian to compute (passed to function)

real(kind=wp), intent(inout), dimension(me%m) :: df

the accumulated function value note: for the first call, this should be set to zero

private subroutine compute_perturb_vector(me, x, dpert, perturb_mode, dx)

Compute dx, the perturbation vector for x

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(me%n) :: x

vector of variables (size n)

real(kind=wp), intent(in), dimension(me%n) :: dpert
integer, intent(in) :: perturb_mode
real(kind=wp), intent(out), dimension(me%n) :: dx

absolute perturbation (>0) for each variable

private subroutine compute_perturbation_vector(me, x, dx)

Compute dx, the perturbation vector for x used when computing the gradients.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(me%n) :: x

vector of variables (size n)

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

absolute perturbation (>0) for each variable

private subroutine compute_sparsity_perturbation_vector(me, x, dx)

Compute dx, the perturbation vector for x used when computing the sparsity pattern.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(me%n) :: x

vector of variables (size n)

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

absolute perturbation (>0) for each variable

private subroutine print_sparsity(me, n, m, iunit, dense)

Print the sparsity pattern.

Arguments

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

number of variables (columns of jacobian)

integer, intent(in) :: m

number of functions (rows of jacobian)

integer, intent(in) :: iunit

file unit to write to. (assumed to be already opened)

logical, intent(in), optional :: dense

if present and true, the matrix form of the sparsity pattern is printed (default is vector form)

private subroutine print_sparsity_pattern(me, iunit)

Print the sparsity pattern in vector form (irow, icol).

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in) :: iunit

file unit to write to. (assumed to be already opened)

private subroutine print_sparsity_matrix(me, iunit)

Print the sparsity pattern in matrix form.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in) :: iunit

file unit to write to. (assumed to be already opened)

private subroutine terminate(me)

A user-callable routine. When called, it will terminate all computations and return. The istat return code will be set to -1. This can be called in the function or the info function.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me

private subroutine raise_exception(me, istat, routine, error_msg)

Raise an exception.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in) :: istat

error code.

character(len=*), intent(in) :: routine

the routine where the error was raised.

character(len=*), intent(in) :: error_msg

error message string.

private subroutine clear_exceptions(me)

Clear all exceptions.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me

private subroutine get_error_status(me, istat, error_msg)

Returns the current error code and message.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(in) :: me
integer, intent(out), optional :: istat

error code (istat=0 means no errors).

character(len=:), intent(out), optional, allocatable :: error_msg

error message string.