eq2d.f90

Go to the documentation of this file.

!> @file eq2d.f90
!! @ingroup FORT1THREAD_EXAMPLES
!!
!!
!! Tests EQ2 constraints that are made post-triangular by transfer of bounds.
!!
!! @verbatim
!! positive variable x1, x2, x3, x4, x5, x6, x7;
!! variable obj;
!!
!! equation e1, e2, e3, e4, objdef;
!!
!! e1.. x1 + x3 =E= 1;
!! e2.. x1 + x2 =L= 2;
!! e3.. x2 =G= 1.5 + x6 + x7;
!! e4.. x2 =L= 1.5 - x4 - x5;
!! objdef .. obj =E= 7*x1 + 8*x2 + 100*x3;
!! @endverbatim
!!
!!
!! For more information about the individual callbacks, please have a look at the source code.
 
#if defined(_WIN32) && !defined(_WIN64)
#define dec_directives_win32
#endif
 
!> Main program. A simple setup and call of CONOPT
!!
Program eq2d
!
!  Declare the user callback routines as Integer, External:
!
   Use proginfo
   Use conopt
   implicit None
 
   Integer, External :: eq2d_readmatrix ! Mandatory Matrix definition routine defined below
   Integer, External :: std_status      ! Standard callback for displaying solution status
   Integer, External :: std_solution    ! Standard callback for displaying solution values
   Integer, External :: std_message     ! Standard callback for managing messages
   Integer, External :: std_errmsg      ! Standard callback for managing error messages
#ifdef dec_directives_win32
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: eq2d_ReadMatrix
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Std_Status
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Std_Solution
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Std_Message
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Std_ErrMsg
#endif
!
!  Control vector
!
   INTEGER, Dimension(:), Pointer :: cntvect
   INTEGER :: coi_error
 
   real*8, dimension(7) :: xsol1 = (/ 0.5d0, 1.5d0, 0.5d0, 0.0d0, 0.0d0,   0.0d0,   0.0d0 /)
   real*8, dimension(7) :: xdua1 = (/ 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 101.0d0, 101.0d0 /)
   real*8, dimension(4) :: udua1 = (/ 100.0d0, -93.d0, 101.d0, 0.d0 /)
   Integer :: i
   Logical :: error
 
   Call startup
!
!  Create and initialize a Control Vector
!
   coi_error = coi_create( cntvect )
!
!  Tell CONOPT about the size of the model by populating the Control Vector:
!
!  Number of variables. Variable obj i the GAMS model is not included.
!
   coi_error = max( coi_error, coidef_numvar( cntvect, 7 ) )
!
!  Number of equations
!
   coi_error = max( coi_error, coidef_numcon( cntvect, 5 ) )
!
!  Number of nonzeros in the Jacobian.
!
   coi_error = max( coi_error, coidef_numnz( cntvect,13 ) )
!
!  Number of nonlinear nonzeros.
!
   coi_error = max( coi_error, coidef_numnlnz( cntvect, 0 ) )
!
!  Optimization direction is Minimize = -1
!
   coi_error = max( coi_error, coidef_optdir( cntvect, -1 ) )
!
!  Objective is constraint 5
!
   coi_error = max( coi_error, coidef_objcon( cntvect, 5 ) )
!
!  Define the options file as 'eq2d.opt'
!
   coi_error = max( coi_error, coidef_optfile( cntvect, 'eq2d.opt'  ) )
!
!  Tell CONOPT about the callback routines:
!
   coi_error = max( coi_error, coidef_readmatrix( cntvect, eq2d_readmatrix ) )
   coi_error = max( coi_error, coidef_status( cntvect, std_status     ) )
   coi_error = max( coi_error, coidef_solution( cntvect, std_solution   ) )
   coi_error = max( coi_error, coidef_message( cntvect, std_message    ) )
   coi_error = max( coi_error, coidef_errmsg( cntvect, std_errmsg     ) )
 
#if defined(CONOPT_LICENSE_INT_1) && defined(CONOPT_LICENSE_INT_2) && defined(CONOPT_LICENSE_INT_3) && defined(CONOPT_LICENSE_TEXT)
   coi_error = max( coi_error, coidef_license( cntvect, conopt_license_int_1, conopt_license_int_2, conopt_license_int_3, conopt_license_text) )
#endif
 
   If ( coi_error .ne. 0 ) THEN
      write(*,*)
      write(*,*) '**** Fatal Error while loading CONOPT Callback routines.'
      write(*,*)
      call flog( "Skipping Solve due to setup errors", 1 )
   ENDIF
   do_allocate = .true.
!
!  Start CONOPT:
!
   coi_error = coi_solve( cntvect )
 
   write(*,*)
   write(*,*) 'End of example eq2d'
 
   If ( coi_error /= 0 ) then
      call flog( "Errors encountered during solution", 1 )
   elseif ( stacalls == 0 .or. solcalls == 0 ) then
      call flog( "Status or Solution routine was not called", 1 )
   elseif ( sstat /= 1 .or. mstat /= 1 ) then  ! This is an LP model
      call flog( "Solver and Model Status was not as expected (1,1)", 1 )
   elseif ( abs( obj-65.5d0 ) > 0.000001d0 ) then
      call flog( "Incorrect objective returned", 1 )
   Else
!
!  Check the primal and dual solution itself
!
      error = .false.
      do i = 1, 7
         if ( abs(xprim(i)-xsol1(i)) > 1.d-7 ) error = .true.
         if ( abs(xdual(i)-xdua1(i)) > 1.d-7 ) error = .true.
      enddo
      do i = 1, 4
         if ( abs(udual(i)-udua1(i)) > 1.d-7 ) error = .true.
      enddo
      if ( error ) call flog( "Eq2d: Numerical solution was not as expected.", 1 )
      Call checkdual( 'Eq2d', minimize )
   endif
 
   if ( coi_free(cntvect) /= 0 ) call flog( "Error while freeing control vector",1)
 
   call flog( "Successful Solve", 0 )
!
!  Free solution memory
!
   call finalize
 
End Program eq2d
!
! ============================================================================
!  Define information about the model:
!
 
!>  Define information about the model
!!
!! @include{doc} readMatrix_params.dox
Integer Function eq2d_readmatrix( lower, curr, upper, vsta, type, rhs, esta,      &
                            colsta, rowno, value, nlflag, n, m, nz, usrmem )
#ifdef dec_directives_win32
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: eq2d_ReadMatrix
#endif
   implicit none
   integer, intent (in)                      :: n      ! number of variables
   integer, intent (in)                      :: m      ! number of constraints
   integer, intent (in)                      :: nz     ! number of nonzeros
   real*8,  intent (in out), dimension(n)    :: lower  ! vector of lower bounds
   real*8,  intent (in out), dimension(n)    :: curr   ! vector of initial values
   real*8,  intent (in out), dimension(n)    :: upper  ! vector of upper bounds
   integer, intent (in out), dimension(n)    :: vsta   ! vector of initial variable status
                                                       ! (not defined here)
   integer, intent (out),    dimension(m)    :: type   ! vector of equation types
   integer, intent (in out), dimension(m)    :: esta   ! vector of initial equation status
                                                       ! (not defined here)
   real*8,  intent (in out), dimension(m)    :: rhs    ! vector of right hand sides
   integer, intent (in out), dimension(n+1)  :: colsta ! vector with start of column indices
   integer, intent (out),    dimension(nz)   :: rowno  ! vector of row numbers
   integer, intent (in out), dimension(nz)   :: nlflag ! vector of nonlinearity flags
   real*8,  intent (in out), dimension(nz)   :: value  ! vector of matrix values
   real*8   usrmem(*)                                  ! optional user memory
!
!  Define information about the Variables:
!
!  Curr is not defined. We will use the default starting values of
!  zero.
!
!  By default, we do not define the status argument Vsta.
!
!  The variables are Positive, i.e. have a lower bound of zero.
!
   lower(1) = 0.d0
   lower(2) = 0.d0
   lower(3) = 0.d0
   lower(4) = 0.d0
   lower(5) = 0.d0
   lower(6) = 0.d0
   lower(7) = 0.d0
!
!  Define information about the Constraints:
!
   rhs(1)  = 1.0d0
   type(1) = 0      ! =E=
   rhs(2)  = 2.0d0
   type(2) = 2      ! =L=
   rhs(3)  = 1.5d0
   type(3) = 1      ! =G=
   rhs(4)  = 1.5d0
   type(4) = 2      ! =L=
   type(5) = 3      ! =N=
!
!  The Jacobian has to be sorted column-wise so we will just define
!  the elements column by column according to the table above:
!
!     x1  x2  x3  x4  x5  x6  x7
! e1   1       1
! e2   1   1
! e3       1              -1  -1
! e4       1       1   1
! e5   7   8 100
!
   colsta(1) = 1
   rowno(1)  = 1
   value(1)  = 1.d0
   rowno(2)  = 2
   value(2)  = 1.d0
   rowno(3)  = 5
   value(3)  = 7.d0
!
   colsta(2) = 4
   rowno(4)  = 2
   value(4)  = 1.0d0
   rowno(5)  = 3
   value(5)  = 1.0d0
   rowno(6)  = 4
   value(6)  = 1.0d0
   rowno(7)  = 5
   value(7)  = 8.0d0
!
   colsta(3) = 8
   rowno(8)  = 1
   value(8)  = 1.d0
   rowno(9)  = 5
   value(9)  = 100.0d0
!
   colsta(4) = 10
   rowno(10) = 4
   value(10) = 1.0d0
!
   colsta(5) = 11
   rowno(11) = 4
   value(11) = 1.d0
!
   colsta(6) = 12
   rowno(12) = 3
   value(12) = -1.0d0
!
   colsta(7) = 13
   rowno(13) = 3
   value(13) = -1.d0
!
!  End of columns, the next free position is = number of elements+1:
!
   colsta(8) = 14
 
   eq2d_readmatrix = 0
 
end Function eq2d_readmatrix