slsqp_module Module

Module containing the object-oriented interface to the SLSQP method. It is called using the slsqp_solver class, which is the only public entity in this module.


Uses

  • module~~slsqp_module~~UsesGraph module~slsqp_module slsqp_module ieee_arithmetic ieee_arithmetic module~slsqp_module->ieee_arithmetic iso_fortran_env iso_fortran_env module~slsqp_module->iso_fortran_env module~slsqp_core slsqp_core module~slsqp_module->module~slsqp_core module~slsqp_kinds slsqp_kinds module~slsqp_module->module~slsqp_kinds module~slsqp_support slsqp_support module~slsqp_module->module~slsqp_support module~slsqp_core->ieee_arithmetic module~slsqp_core->module~slsqp_kinds module~slsqp_core->module~slsqp_support module~bvls_module bvls_module module~slsqp_core->module~bvls_module module~slsqp_kinds->iso_fortran_env module~slsqp_support->module~slsqp_kinds module~bvls_module->module~slsqp_kinds module~bvls_module->module~slsqp_support

Abstract Interfaces

abstract interface

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

    for computing the function

    Arguments

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

    optimization variable vector

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

    value of the objective function

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

    the constraint vector dimension(m), equality constraints (if any) first.

abstract interface

  • private subroutine grad(me, x, g, a)

    for computing the gradients

    Arguments

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

    optimization variable vector

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

    objective function partials w.r.t x dimension(n)

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

    gradient matrix of constraints w.r.t. x dimension(m,n)

abstract interface

  • private subroutine iterfunc(me, iter, x, f, c)

    for reporting an iteration

    Arguments

    Type IntentOptional Attributes Name
    class(slsqp_solver), intent(inout) :: me
    integer, intent(in) :: iter

    iteration number

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

    optimization variable vector

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

    value of the objective function

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

    the constraint vector dimension(m), equality constraints (if any) first.


Derived Types

type, public ::  slsqp_solver

The main class used to interface with the SLSQP solver.

Components

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

number of optimization variables ()

integer, private :: m = 0

number of constraints ()

integer, private :: meq = 0

number of equality constraints ()

integer, private :: max_iter = 0

maximum number of iterations

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

accuracy tolerance

real(kind=wp), private :: tolf = -one

accuracy tolerance over f: if then stop

real(kind=wp), private :: toldf = -one

accuracy tolerance over df: if then stop. It's different from acc in the case of positive derivative

real(kind=wp), private :: toldx = -one

accuracy tolerance over dx: if then stop

integer, private :: gradient_mode = 0

how the gradients are computed:

Read more…
real(kind=wp), private :: gradient_delta = 1.0e8_wp

perturbation step size to approximate gradients by finite differences (gradient_mode 1-3).

real(kind=wp), private :: alphamin = 0.1_wp

min for line search

real(kind=wp), private :: alphamax = 1.0_wp

max for line search

integer, private :: iprint = output_unit

unit number of status printing (0 for no printing)

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

lower bound on x

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

upper bound on x

integer, private :: l_w = 0

size of w

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

real work array

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

problem function subroutine

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

gradient subroutine

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

for reporting an iteration

integer, private :: linesearch_mode = 1

linesearch mode:

Read more…
type(linmin_data), private :: linmin

data formerly within linmin. Only used when linesearch_mode=2

type(slsqpb_data), private :: slsqpb

data formerly within slsqpb.

integer, private :: nnls_mode = 1

Which NNLS method to use:

Read more…
integer, private :: max_iter_ls = 0

max iterations in the least squares problem. if <=0, defaults to 3*n. (use by either nnls or bvls)

logical, private :: user_triggered_stop = .false.

if the abort method has been called to stop the iterations

real(kind=wp), private :: infinite_bound = huge(one)

"infinity" for the upper and lower bounds. if xl<=-infinite_bound or xu>=infinite_bound then these bounds are considered nonexistant.

Type-Bound Procedures

procedure, public :: initialize => initialize_slsqp
procedure, public :: destroy => destroy_slsqp
procedure, public :: optimize => slsqp_wrapper
procedure, public :: abort => stop_iterations
procedure, private :: report_message ../../

for reporting messages to the user


Functions

private pure function mode_to_status_message(imode) result(message)

Convert the slsqp mode flag to a message string.

Arguments

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

Return Value character(len=:), allocatable


Subroutines

private subroutine stop_iterations(me)

A method that the user can call to stop the iterations. (it can be called in any of the functions). SLSQP will stop at the end of the next iteration.

Arguments

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

private subroutine initialize_slsqp(me, n, m, meq, max_iter, acc, f, g, xl, xu, status_ok, linesearch_mode, iprint, report, alphamin, alphamax, gradient_mode, gradient_delta, tolf, toldf, toldx, max_iter_ls, nnls_mode, infinite_bound)

initialize the slsqp_solver class. see slsqp for more details.

Arguments

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

the number of variables,

integer, intent(in) :: m

total number of constraints,

integer, intent(in) :: meq

number of equality constraints,

integer, intent(in) :: max_iter

maximum number of iterations

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

accuracy

procedure(func) :: f

problem function

procedure(grad) :: g

function to compute gradients (must be associated if gradient_mode=0)

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

lower bounds on x. xl(i)=NaN (or xl(i)<=-infinite_bound) indicates to ignore ith bound

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

upper bounds on x. xu(i)=NaN (or xu(i)>=infinite_bound) indicates to ignore ith bound

logical, intent(out) :: status_ok

will be false if there were errors

integer, intent(in), optional :: linesearch_mode

1 = inexact (default), 2 = exact

integer, intent(in), optional :: iprint

unit number of status messages (default=output_unit)

procedure(iterfunc), optional :: report

user-defined procedure that will be called once per iteration

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

minimum alpha for linesearch [default 0.1]

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

maximum alpha for linesearch [default 1.0]

integer, intent(in), optional :: gradient_mode

how the gradients are to be computed:

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

perturbation step size (>epsilon) to compute the approximated gradient by finite differences (gradient_mode 1-3). note that this is an absolute step that does not respect the xl or xu variable bounds.

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

stopping criterion if then stop.

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

stopping criterion if then stop

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

stopping criterion if then stop

integer, intent(in), optional :: max_iter_ls

maximum number of iterations in the nnls problem

integer, intent(in), optional :: nnls_mode

Which NNLS method to use:

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

"infinity" for the upper and lower bounds. if xl<=-infinite_bound or xu>=infinite_bound then these bounds are considered nonexistant. If not present then huge() is used for this.

private subroutine destroy_slsqp(me)

destructor for slsqp_solver.

Arguments

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

private subroutine slsqp_wrapper(me, x, istat, iterations, status_message)

main routine for calling slsqp.

Arguments

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

in: initial optimization variables, out: solution.

integer, intent(out) :: istat

status code (see mode in slsqp).

integer, intent(out), optional :: iterations

number of iterations

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

string status message corresponding to istat

private subroutine report_message(me, str, ival, rval, fatal)

Report a message from an slsqp_solver class. This uses the iprint variable in the class as the unit number for printing. Note: for fatal errors, if no unit is specified, the error_unit is used.

Arguments

Type IntentOptional Attributes Name
class(slsqp_solver), intent(in) :: me
character(len=*), intent(in) :: str

the message to report.

integer, intent(in), optional :: ival

optional integer to print after the message.

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

optional real to print after the message.

logical, intent(in), optional :: fatal

if True, then the program is stopped (default=False).