cobyla_module Module

COBYLA: Constrained Optimization BY Linear Approximations.

Minimize an objective function F([X1,X2,...,XN]) subject to M inequality constraints.

References

History

  • Mike Powell (May 7th, 1992) -- There are no restrictions on the use of the software, nor do I offer any guarantees of success.
  • Jacob Williams, July 2015 : refactoring of the code into modern Fortran.

Note

There is a need for a linear programming problem to be solved subject to a Euclidean norm trust region constraint. Therefore SUBROUTINE TRSTLP is provided, but you may have some software that you prefer to use instead.


Uses

  • module~~cobyla_module~~UsesGraph module~cobyla_module cobyla_module module~kind_module kind_module module~cobyla_module->module~kind_module iso_fortran_env iso_fortran_env module~kind_module->iso_fortran_env

Used by

  • module~~cobyla_module~~UsedByGraph module~cobyla_module cobyla_module module~powellopt powellopt module~powellopt->module~cobyla_module

Abstract Interfaces

abstract interface

  • private subroutine func(n, m, x, f, con)

    calcfc interface

    Arguments

    Type IntentOptional Attributes Name
    integer, intent(in) :: n
    integer, intent(in) :: m
    real(kind=wp), intent(in), dimension(*) :: x
    real(kind=wp), intent(out) :: f
    real(kind=wp), intent(out), dimension(*) :: con

Subroutines

public subroutine cobyla(n, m, x, rhobeg, rhoend, iprint, maxfun, calcfc)

This subroutine minimizes an objective function F(X) subject to M inequality constraints on X, where X is a vector of variables that has N components. The algorithm employs linear approximations to the objective and constraint functions, the approximations being formed by linear interpolation at N+1 points in the space of the variables. We regard these interpolation points as vertices of a simplex. The parameter RHO controls the size of the simplex and it is reduced automatically from RHOBEG to RHOEND. For each RHO the subroutine tries to achieve a good vector of variables for the current size, and then RHO is reduced until the value RHOEND is reached. Therefore RHOBEG and RHOEND should be set to reasonable initial changes to and the required accuracy in the variables respectively, but this accuracy should be viewed as a subject for experimentation because it is not guaranteed.

Read more…

Arguments

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

number of variables

integer, intent(in) :: m

number of inequality constraints

real(kind=wp), intent(inout), dimension(*) :: x

Initial values of the variables must be set in X(1),X(2),...,X(N). On return they will be changed to the solution.

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

reasonable initial change to variables (see description of RHO)

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

required accuracy (see description of RHO)

integer, intent(in) :: iprint

IPRINT should be set to 0, 1, 2 or 3, which controls the amount of printing during the calculation. Specifically, there is no output if IPRINT=0 and there is output only at the end of the calculation if IPRINT=1. Otherwise each new value of RHO and SIGMA is printed. Further, the vector of variables and some function information are given either when RHO is reduced or when each new value of F(X) is computed in the cases IPRINT=2 or IPRINT=3 respectively. Here SIGMA is a penalty parameter, it being assumed that a change to X is an improvement if it reduces the merit function F(X)+SIGMA*MAX(0.0,-C1(X),-C2(X),...,-CM(X)), where C1,C2,...,CM denote the constraint functions that should become nonnegative eventually, at least to the precision of RHOEND. In the printed output the displayed term that is multiplied by SIGMA is called MAXCV, which stands for 'MAXimum Constraint Violation'.

integer, intent(inout) :: maxfun

MAXFUN is an integer variable that must be set by the user to a limit on the number of calls of CALCFC. The value of MAXFUN will be altered to the number of calls of CALCFC that are made.

procedure(func) :: calcfc

In order to define the objective and constraint functions, we require a subroutine that has the name and arguments SUBROUTINE CALCFC (N,M,X,F,CON) DIMENSION X(),CON() The values of N and M are fixed and have been defined already, while X is now the current vector of variables. The subroutine should return the objective and constraint functions at X in F and CON(1),CON(2), ...,CON(M). Note that we are trying to adjust X so that F(X) is as small as possible subject to the constraint functions being nonnegative.

private subroutine cobylb(n, m, mpp, x, rhobeg, rhoend, iprint, maxfun, con, sim, simi, datmat, a, vsig, veta, sigbar, dx, w, iact, calcfc)

Arguments

Type IntentOptional Attributes Name
integer :: n
integer :: m
integer :: mpp
real :: x
real :: rhobeg
real :: rhoend
integer :: iprint
integer :: maxfun
real :: con
real :: sim
real :: simi
real :: datmat
real :: a
real :: vsig
real :: veta
real :: sigbar
real :: dx
real :: w
integer :: iact
procedure(func) :: calcfc

private subroutine trstlp(n, m, a, b, rho, dx, ifull, iact, z, zdota, vmultc, sdirn, dxnew, vmultd)

Arguments

Type IntentOptional Attributes Name
integer :: n
integer :: m
real :: a
real :: b
real :: rho
real :: dx
integer :: ifull
integer :: iact
real :: z
real :: zdota
real :: vmultc
real :: sdirn
real :: dxnew
real :: vmultd

public subroutine cobyla_test()

Test routine for cobyla.

Read more…

Arguments

None