[Ipopt] Calling IPOPT and Running Example HS071_F.F from IntelFortran v11
Kelly, Jeff (ON0F)
jeff.kelly at honeywell.com
Mon Oct 4 06:55:08 EDT 2010
All;
I have resolved this issue. I am able to use the pre-compiled IPOPT
binaries with the C interface received from
https://www.coin-or.org/download/binary/Ipopt/ (i.e., Ipopt38.dll and
Ipopt.lib) where I have embedded the Intel Fortran code below for
example HS071.
This Fortran code does not use the IPOPT "Fortran interface" but the "C
interface" and to resolve the issue of the "TASK" in the Jacobian and
Hessian sparsity-pattern initialization I use the "optional" arguments
in Fortran 90 and the intrinsic function PRESENT() to determine if an
argument is NULL.
To resolve the issue of the user-data derived-type C integer pointer I
pass the user-data derived-type pointer as an integer to IpoptSolve()
using the Fortran 90 LOC(type_userdata) then when required in a callback
routine I use the Fortran 90 statement
"pointer(ptr_userdata,type_userdata)" to point to the address of the
derived-type of user-data. Unfortunately at the moment the dimensions
in the derived-type need to be known at compile time statically -
alternatively a Fortran 90 module or simply a common block can be used
to pass user-data to the callbacks.
If you search on "!jdk" you can see all of the changes I made to the
file hs071_f.f.
All the best - Jeff
C Copyright (C) 2002, 2004, 2005, 2006 Carnegie Mellon University and
others.
C All Rights Reserved.
C This code is published under the Common Public License.
C
C $Id: hs071_f.f.in 661 2006-03-12 23:19:03Z andreasw $
C
C
========================================================================
=====
C
C This is an example for the usage of IPOPT.
C It implements problem 71 from the Hock-Schittkowsky test suite:
C
C min x1*x4*(x1 + x2 + x3) + x3
C s.t. x1*x2*x3*x4 >= 25
C x1**2 + x2**2 + x3**2 + x4**2 = 40
C 1 <= x1,x2,x3,x4 <= 5
C
C Starting point:
C x = (1, 5, 5, 1)
C
C Optimal solution:
C x = (1.00000000, 4.74299963, 3.82114998, 1.37940829)
C
C
========================================================================
=====
C
C
C
========================================================================
=====
C
C Main driver program
C
C
========================================================================
=====
C
program example
C
implicit none
C
C include the Ipopt return codes
C
include 'IpReturnCodes.inc'
C
C Size of the problem (number of variables and equality constraints)
C
integer N, M, NELE_JAC, NELE_HESS, IDX_STY
parameter (N = 4, M = 2, NELE_JAC = 8, NELE_HESS = 10)
parameter (IDX_STY = 1 )
C
C Space for multipliers and constraints
C
double precision LAM(M)
double precision G(M)
C
C Vector of variables
C
double precision X(N)
C
C Vector of lower and upper bounds
C
double precision X_L(N), X_U(N), Z_L(N), Z_U(N)
double precision G_L(M), G_U(M)
C
C Private data for evaluation routines
C This could be used to pass double precision and integer arrays
untouched
C to the evaluation subroutines EVAL_*
C
double precision DAT(2)
integer IDAT(1)
C
C Place for storing the Ipopt Problem Handle
C
C for 32 bit platforms
!jdk
integer IPROBLEM
! integer IPCREATE
CC for 64 bit platforms:
C integer*8 IPROBLEM
C integer*8 IPCREATE
C
integer IERR
integer IPSOLVE, IPADDSTROPTION
integer IPADDNUMOPTION, IPADDINTOPTION
integer IPOPENOUTPUTFILE
C
double precision f
integer i
C
C Set initial point and bounds:
C
data X / 1d0, 5d0, 5d0, 1d0/
data X_L / 1d0, 1d0, 1d0, 1d0 /
data X_U / 5d0, 5d0, 5d0, 5d0 /
C
C Set bounds for the constraints
C
data G_L / 25d0, 40d0 /
data G_U / 1d40, 40d0 /
C
C The following are the Fortran routines for computing the model
C functions and their derivatives - their code can be found furhter
C down in this file.
C
!jdk
! external EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS
interface
integer function
CreateIpoptProblem(N,X_L,X_U,M,G_L,G_U,NELE_JAC,NELE_HESS,IDX_STY,
&
EV_F,EV_G,EV_GRAD_F,EV_JAC_G,EV_HESS)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_CreateIpoptProblem" ::
CreateIpoptProblem
integer :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8) :: X_L(*)
cDEC$ ATTRIBUTES REFERENCE :: X_L
real(8) :: X_U(*)
cDEC$ ATTRIBUTES REFERENCE :: X_U
integer :: M
cDEC$ ATTRIBUTES VALUE :: M
real(8) :: G_L(*)
cDEC$ ATTRIBUTES REFERENCE :: G_L
real(8) :: G_U(*)
cDEC$ ATTRIBUTES REFERENCE :: G_U
integer :: NELE_JAC
cDEC$ ATTRIBUTES VALUE :: NELE_JAC
integer :: NELE_HESS
cDEC$ ATTRIBUTES VALUE :: NELE_HESS
integer :: IDX_STY
cDEC$ ATTRIBUTES VALUE :: IDX_STY
external :: EV_F
cDEC$ ATTRIBUTES REFERENCE :: EV_F
external :: EV_G
cDEC$ ATTRIBUTES REFERENCE :: EV_G
external :: EV_GRAD_F
cDEC$ ATTRIBUTES REFERENCE :: EV_GRAD_F
external :: EV_JAC_G
cDEC$ ATTRIBUTES REFERENCE :: EV_JAC_G
external :: EV_HESS
cDEC$ ATTRIBUTES REFERENCE :: EV_HESS
end function
integer function AddIpoptIntOption(IPROBLEM,KEYWORD,OPTION)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_AddIpoptIntOption" ::
AddIpoptIntOption
integer :: IPROBLEM
cDEC$ ATTRIBUTES VALUE :: IPROBLEM
character(*) :: KEYWORD
cDEC$ ATTRIBUTES REFERENCE :: KEYWORD
integer :: OPTION
cDEC$ ATTRIBUTES VALUE :: OPTION
end function
integer function AddIpoptNumOption(IPROBLEM,KEYWORD,OPTION)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_AddIpoptNumOption" ::
AddIpoptNumOption
integer :: IPROBLEM
cDEC$ ATTRIBUTES VALUE :: IPROBLEM
character(*) :: KEYWORD
cDEC$ ATTRIBUTES REFERENCE :: KEYWORD
real(8) :: OPTION
cDEC$ ATTRIBUTES VALUE :: OPTION
end function
integer function AddIpoptStrOption(IPROBLEM,KEYWORD,OPTION)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_AddIpoptStrOption" ::
AddIpoptStrOption
integer :: IPROBLEM
cDEC$ ATTRIBUTES VALUE :: IPROBLEM
character(*) :: KEYWORD
cDEC$ ATTRIBUTES REFERENCE :: KEYWORD
character(*) :: OPTION
cDEC$ ATTRIBUTES REFERENCE :: OPTION
end function
integer function
OpenIpoptOutputFile(IPROBLEM,FILENAME,PRINTLEVEL)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_OpenIpoptOutputFile" ::
OpenIpoptOutputFile
integer :: IPROBLEM
cDEC$ ATTRIBUTES VALUE :: IPROBLEM
character(*) :: FILENAME
cDEC$ ATTRIBUTES REFERENCE :: FILENAME
integer :: PRINTLEVEL
cDEC$ ATTRIBUTES VALUE :: PRINTLEVEL
end function
integer function
IpoptSolve(IPROBLEM,X,G,OBJ_VAL,MULT_G,MULT_X_L,MULT_X_U,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_IpoptSolve" :: IpoptSolve
integer :: IPROBLEM
cDEC$ ATTRIBUTES VALUE :: IPROBLEM
real(8) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
real(8) :: G(*)
cDEC$ ATTRIBUTES REFERENCE :: G
real(8) :: OBJ_VAL
cDEC$ ATTRIBUTES REFERENCE :: OBJ_VAL
real(8) :: MULT_G(*)
cDEC$ ATTRIBUTES REFERENCE :: MULT_G
real(8) :: MULT_X_L(*)
cDEC$ ATTRIBUTES REFERENCE :: MULT_X_L
real(8) :: MULT_X_U(*)
cDEC$ ATTRIBUTES REFERENCE :: MULT_X_U
integer :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
end function
subroutine FreeIpoptProblem(IPROBLEM)
cDEC$ ATTRIBUTES DLLIMPORT, STDCALL, ALIAS : "_FreeIpoptProblem" ::
FreeIpoptProblem
integer :: IPROBLEM
cDEC$ ATTRIBUTES VALUE :: IPROBLEM
end subroutine
logical(1) function EV_F(N,X,NEW_X,OBJ_VALUE,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_F" :: EV_F
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
real(8), intent(out) :: OBJ_VALUE
cDEC$ ATTRIBUTES REFERENCE :: OBJ_VALUE
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
end function
logical(1) function EV_GRAD_F(N,X,NEW_X,GRAD_F,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_GRAD_F" :: EV_GRAD_F
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
real(8), intent(out) :: GRAD_F(*)
cDEC$ ATTRIBUTES REFERENCE :: GRAD_F
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
end function
logical(1) function EV_G(N,X,NEW_X,M,G,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_G" :: EV_G
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
integer, intent(in) :: M
cDEC$ ATTRIBUTES VALUE :: M
real(8), intent(out) :: G(*)
cDEC$ ATTRIBUTES REFERENCE :: G
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
end function
logical(1) function
EV_JAC_G(N,X,NEW_X,M,NELE_JAC,IROW,JCOL,G,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_JAC_G" :: EV_JAC_G
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
integer, intent(in) :: M
cDEC$ ATTRIBUTES VALUE :: M
integer, intent(in) :: NELE_JAC
cDEC$ ATTRIBUTES VALUE :: NELE_JAC
integer, optional, intent(out) :: IROW(*)
cDEC$ ATTRIBUTES REFERENCE :: IROW
integer, optional, intent(out) :: JCOL(*)
cDEC$ ATTRIBUTES REFERENCE :: JCOL
real(8), optional, intent(out) :: G(*)
cDEC$ ATTRIBUTES REFERENCE :: G
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
end function
logical(1) function
EV_HESS(N,X,NEW_X,OBJFACT,M,LAMBDA,NEW_LAMBDA,NELE_HESS,IROW,JCOL,H,PTR_
USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_HESS" :: EV_HESS
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
real(8), intent(in) :: OBJFACT
cDEC$ ATTRIBUTES VALUE :: OBJFACT
integer, intent(in) :: M
cDEC$ ATTRIBUTES VALUE :: M
real(8), intent(in) :: LAMBDA(*)
cDEC$ ATTRIBUTES REFERENCE :: LAMBDA
logical(1), intent(in) :: NEW_LAMBDA
cDEC$ ATTRIBUTES VALUE :: NEW_LAMBDA
integer, intent(in) :: NELE_HESS
cDEC$ ATTRIBUTES VALUE :: NELE_HESS
integer, optional, intent(out) :: IROW(*)
cDEC$ ATTRIBUTES REFERENCE :: IROW
integer, optional, intent(out) :: JCOL(*)
cDEC$ ATTRIBUTES REFERENCE :: JCOL
real(8), optional, intent(out) :: H(*)
cDEC$ ATTRIBUTES REFERENCE :: H
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
end function
end interface
!jdk
type :: userdata
integer :: IDAT(1:2)
real(8) :: DDAT(1:2)
end type userdata
type (userdata) :: user_data
integer :: PTR_USERDATA
C
C First create a handle for the Ipopt problem (and read the options
C file)
C
!jdk
! IPROBLEM = IPCREATE(N, X_L, X_U, M, G_L, G_U, NELE_JAC,
NELE_HESS,
! 1 IDX_STY, EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS)
IPROBLEM = CreateIpoptProblem(N, X_L, X_U, M, G_L, G_U, NELE_JAC,
NELE_HESS,
1 IDX_STY, EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS)
if (IPROBLEM.eq.0) then
write(*,*) 'Error creating an Ipopt Problem handle.'
stop
endif
C
C Open an output file
C
!jdk
! IERR = IPOPENOUTPUTFILE(IPROBLEM, 'IPOPT.OUT', 5)
IERR = OpenIpoptOutputFile(IPROBLEM, 'IPOPT.OUT'//CHAR(0), 5)
!jdk
! if (IERR.ne.0 ) then
if (IERR.eq.0 ) then
write(*,*) 'Error opening the Ipopt output file.'
goto 9000
endif
C
C Note: The following options are only examples, they might not be
C suitable for your optimization problem.
C
C Set a string option
C
!jdk
! IERR = IPADDSTROPTION(IPROBLEM, 'mu_strategy', 'adaptive')
IERR = AddIpoptStrOption(IPROBLEM, 'mu_strategy'//CHAR(0),
'adaptive'//CHAR(0))
!jdk
! if (IERR.ne.0 ) goto 9990
if (IERR.eq.0 ) goto 9990
C
C Set an integer option
C
!jdk
! IERR = IPADDINTOPTION(IPROBLEM, 'max_iter', 3000)
IERR = AddIpoptIntOption(IPROBLEM, 'max_iter'//CHAR(0), 3000)
!jdk
! if (IERR.ne.0 ) goto 9990
if (IERR.eq.0 ) goto 9990
C
C Set a double precision option
C
!jdk
! IERR = IPADDNUMOPTION(IPROBLEM, 'tol', 1.d-7)
IERR = AddIpoptNumOption(IPROBLEM, 'tol'//CHAR(0), 1.d-7)
!jdk
! if (IERR.ne.0 ) goto 9990
if (IERR.eq.0 ) goto 9990
C
C As a simple example, we pass the constants in the constraints to
C the EVAL_C routine via the "private" DAT array.
C
!jdk
! DAT(1) = 0.d0
! DAT(2) = 0.d0
user_data%DDAT(1) = 0.d0
user_data%DDAT(2) = 0.d0
PTR_USERDATA = LOC(user_data)
C
C Call optimization routine
C
!jdk
! IERR = IPSOLVE(IPROBLEM, X, G, F, LAM, Z_L, Z_U, IDAT, DAT)
IERR = IpoptSolve(IPROBLEM, X, G, F, LAM, Z_L, Z_U, PTR_USERDATA)
C
C Output:
C
if( IERR.eq.IP_SOLVE_SUCCEEDED ) then
write(*,*)
write(*,*) 'The solution was found.'
write(*,*)
write(*,*) 'The final value of the objective function is ',f
write(*,*)
write(*,*) 'The optimal values of X are:'
write(*,*)
do i = 1, N
write(*,*) 'X (',i,') = ',X(i)
enddo
write(*,*)
write(*,*) 'The multipliers for the lower bounds are:'
write(*,*)
do i = 1, N
write(*,*) 'Z_L(',i,') = ',Z_L(i)
enddo
write(*,*)
write(*,*) 'The multipliers for the upper bounds are:'
write(*,*)
do i = 1, N
write(*,*) 'Z_U(',i,') = ',Z_U(i)
enddo
write(*,*)
write(*,*) 'The multipliers for the equality constraints are:'
write(*,*)
do i = 1, M
write(*,*) 'LAM(',i,') = ',LAM(i)
enddo
write(*,*)
else
write(*,*)
write(*,*) 'An error occoured.'
write(*,*) 'The error code is ',IERR
write(*,*)
endif
C
9000 continue
C
C Clean up
C
!jdk
! call IPFREE(IPROBLEM)
call FreeIpoptProblem(IPROBLEM)
stop
C
9990 continue
write(*,*) 'Error setting an option'
goto 9000
end
C
C
========================================================================
=====
C
C Computation of objective function
C
C
========================================================================
=====
C
function EV_F(N,X,NEW_X,F,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_F" :: EV_F
!jdk
! subroutine EV_F(N, X, NEW_X, F, IDAT, DAT, IERR)
implicit none
logical(1) :: EV_F
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
real(8), intent(out) :: F
cDEC$ ATTRIBUTES REFERENCE :: F
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
!jdk
! double precision DAT(*)
! integer IDAT(*)
! integer IERR
F = X(1)*X(4)*(X(1)+X(2)+X(3)) + X(3)
!jdk
! IERR = 0
EV_F = .true.
return
end function
C
C
========================================================================
=====
C
C Computation of gradient of objective function
C
C
========================================================================
=====
C
function EV_GRAD_F(N,X,NEW_X,GRAD,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_GRAD_F" :: EV_GRAD_F
!jdk
! subroutine EV_GRAD_F(N, X, NEW_X, GRAD, IDAT, DAT, IERR)
implicit none
logical(1) :: EV_GRAD_F
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
real(8), intent(out) :: GRAD(*)
cDEC$ ATTRIBUTES REFERENCE :: GRAD
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
!jdk
! double precision DAT(*)
! integer IDAT(*)
! integer IERR
GRAD(1) = X(4)*(2d0*X(1)+X(2)+X(3))
GRAD(2) = X(1)*X(4)
GRAD(3) = X(1)*X(4) + 1d0
GRAD(4) = X(1)*(X(1)+X(2)+X(3))
!jdk
! IERR = 0
EV_GRAD_F = .true.
return
end function
C
C
========================================================================
=====
C
C Computation of equality constraints
C
C
========================================================================
=====
C
function EV_G(N,X,NEW_X,M,G,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_G" :: EV_G
!jdk
! subroutine EV_G(N, X, NEW_X, M, G, IDAT, DAT, IERR)
implicit none
logical(1) :: EV_G
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
integer, intent(in) :: M
cDEC$ ATTRIBUTES VALUE :: M
real(8), intent(out) :: G(*)
cDEC$ ATTRIBUTES REFERENCE :: G
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
!jdk
! double precision DAT(*)
! integer IDAT(*)
! integer IERR
type :: userdata
integer :: IDAT(1:2)
real(8) :: DDAT(1:2)
end type userdata
type (userdata) :: user_data
pointer(PTR_USERDATA,user_data)
!jdk
! G(1) = X(1)*X(2)*X(3)*X(4) - DAT(1)
! G(2) = X(1)**2 + X(2)**2 + X(3)**2 + X(4)**2 - DAT(2)
G(1) = X(1)*X(2)*X(3)*X(4) - user_data%DDAT(1)
G(2) = X(1)**2 + X(2)**2 + X(3)**2 + X(4)**2 - user_data%DDAT(2)
!jdk
! IERR = 0
EV_G = .true.
return
end function
C
C
========================================================================
=====
C
C Computation of Jacobian of equality constraints
C
C
========================================================================
=====
C
function EV_JAC_G(N,X,NEW_X,M,NZ,ACON,AVAR,A,PTR_USERDATA)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_JAC_G" :: EV_JAC_G
!jdk
! subroutine
EV_JAC_G(TASK,N,X,NEW_X,M,NZ,ACON,AVAR,A,IDAT,DAT,IERR)
logical(1) :: EV_JAC_G
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
integer, intent(in) :: M
cDEC$ ATTRIBUTES VALUE :: M
integer, intent(in) :: NZ
cDEC$ ATTRIBUTES VALUE :: NZ
integer, optional, intent(out) :: ACON(*)
cDEC$ ATTRIBUTES REFERENCE :: ACON
integer, optional, intent(out) :: AVAR(*)
cDEC$ ATTRIBUTES REFERENCE :: AVAR
real(8), optional, intent(out) :: A(*)
cDEC$ ATTRIBUTES REFERENCE :: A
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
!jdk
! double precision DAT(*)
! integer IDAT(*)
! integer IERR
integer TASK
integer I
C
C structure of Jacobian:
C
integer AVAR1(8), ACON1(8)
data AVAR1 /1, 2, 3, 4, 1, 2, 3, 4/
data ACON1 /1, 1, 1, 1, 2, 2, 2, 2/
save AVAR1, ACON1
!jdk
TASK = 1
if (PRESENT(AVAR) .and. PRESENT(ACON)) then
TASK = 0
end if
C
if( TASK.eq.0 ) then
do I = 1, 8
AVAR(I) = AVAR1(I)
ACON(I) = ACON1(I)
enddo
else
A(1) = X(2)*X(3)*X(4)
A(2) = X(1)*X(3)*X(4)
A(3) = X(1)*X(2)*X(4)
A(4) = X(1)*X(2)*X(3)
A(5) = 2d0*X(1)
A(6) = 2d0*X(2)
A(7) = 2d0*X(3)
A(8) = 2d0*X(4)
endif
!jdk
! IERR = 0
EV_JAC_G = .true.
return
end function
C
C
========================================================================
=====
C
C Computation of Hessian of Lagrangian
C
C
========================================================================
=====
C
function
EV_HESS(N,X,NEW_X,OBJFACT,M,LAM,NEW_LAM,NNZH,IRNH,ICNH,HESS,PTR_USERDATA
)
cDEC$ ATTRIBUTES DLLEXPORT, REFERENCE, ALIAS : "EV_HESS" :: EV_HESS
!jdk
! subroutine EV_HESS(TASK, N, X, NEW_X, OBJFACT, M, LAM, NEW_LAM,
! 1 NNZH, IRNH, ICNH, HESS, IDAT, DAT, IERR)
implicit none
logical(1) :: EV_HESS
integer, intent(in) :: N
cDEC$ ATTRIBUTES VALUE :: N
real(8), intent(in) :: X(*)
cDEC$ ATTRIBUTES REFERENCE :: X
logical(1), intent(in) :: NEW_X
cDEC$ ATTRIBUTES VALUE :: NEW_X
real(8), intent(in) :: OBJFACT
cDEC$ ATTRIBUTES VALUE :: OBJFACT
integer, intent(in) :: M
cDEC$ ATTRIBUTES VALUE :: M
real(8), intent(in) :: LAM(*)
cDEC$ ATTRIBUTES REFERENCE :: LAM
logical(1), intent(in) :: NEW_LAM
cDEC$ ATTRIBUTES VALUE :: NEW_LAM
integer, intent(in) :: NNZH
cDEC$ ATTRIBUTES VALUE :: NNZH
integer, optional, intent(out) :: IRNH(*)
cDEC$ ATTRIBUTES REFERENCE :: IRNH
integer, optional, intent(out) :: ICNH(*)
cDEC$ ATTRIBUTES REFERENCE :: ICNH
real(8), optional, intent(out) :: HESS(*)
cDEC$ ATTRIBUTES REFERENCE :: HESS
integer, intent(in) :: PTR_USERDATA
cDEC$ ATTRIBUTES VALUE :: PTR_USERDATA
!jdk
! double precision DAT(*)
! integer IDAT(*)
! integer IERR
integer TASK
integer i
C
C structure of Hessian:
C
integer IRNH1(10), ICNH1(10)
data IRNH1 /1, 2, 2, 3, 3, 3, 4, 4, 4, 4/
data ICNH1 /1, 1, 2, 1, 2, 3, 1, 2, 3, 4/
save IRNH1, ICNH1
!jdk
TASK = 1
if (PRESENT(IRNH) .and. PRESENT(ICNH)) then
TASK = 0
end if
if( TASK.eq.0 ) then
do i = 1, 10
IRNH(i) = IRNH1(i)
ICNH(i) = ICNH1(i)
enddo
else
do i = 1, 10
HESS(i) = 0d0
enddo
C
C objective function
C
HESS(1) = OBJFACT * 2d0*X(4)
HESS(2) = OBJFACT * X(4)
HESS(4) = OBJFACT * X(4)
HESS(7) = OBJFACT * (2d0*X(1) + X(2) + X(3))
HESS(8) = OBJFACT * X(1)
HESS(9) = OBJFACT * X(1)
C
C first constraint
C
HESS(2) = HESS(2) + LAM(1) * X(3)*X(4)
HESS(4) = HESS(4) + LAM(1) * X(2)*X(4)
HESS(5) = HESS(5) + LAM(1) * X(1)*X(4)
HESS(7) = HESS(7) + LAM(1) * X(2)*X(3)
HESS(8) = HESS(8) + LAM(1) * X(1)*X(3)
HESS(9) = HESS(9) + LAM(1) * X(1)*X(2)
C
C second constraint
C
HESS(1) = HESS(1) + LAM(2) * 2d0
HESS(3) = HESS(3) + LAM(2) * 2d0
HESS(6) = HESS(6) + LAM(2) * 2d0
HESS(10)= HESS(10)+ LAM(2) * 2d0
endif
!jdk
! IERR = 0
EV_HESS = .true.
return
end function
From: ipopt-bounces at list.coin-or.org
[mailto:ipopt-bounces at list.coin-or.org] On Behalf Of Kelly, Jeff (ON0F)
Sent: Wednesday, September 29, 2010 8:36 AM
To: ipopt at list.coin-or.org
Subject: [Ipopt] Calling IPOPT and Running Example HS071_F.F from
IntelFortran v11
I am having trouble calling IPOPT from Intel Fortran (using the
HS071_F.F example) and I am looking to simply download a DLL similar to
IPOPT38.dll (found in Ipopt-3.8.1-win32-dll.zip @
https://www.coin-or.org/download/binary/Ipopt/).
When I do this it does not recognize IPCREATE(), etc. - I can interface
CreateIpoptProblem() using an interface-block and STDCALL directives but
then the EV_() subroutines in HS071_F.F don't work of course.
I have interfaced XPRESS, GUROBI, LINDO and LPSOLVE to Intel Fortran but
I just can't get IPOPT to do the same.
Is there something I am missing and/or is there another DLL binary that
I am missing?
Thanks in advanced - Jeff
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://list.coin-or.org/pipermail/ipopt/attachments/20101004/52e6c5b9/attachment-0001.html
More information about the Ipopt
mailing list