ex01.f90

Go to the documentation of this file.

!> @file ex01.f90
!! @ingroup FORT1THREAD_EXAMPLES
!!
!!
!! This is an implementation of the model PORT.GMS (seq 50) in the GAMS
!! model library. The model is repeated here for easy reference:
!!
!!
!! @verbatim
!! $TITLE SIMPLE PORTFOLIO MODEL  (PORT,SEQ=50)
!! * THIS SIMPLE PORTFOLIO SELECTION MODEL EXAMINES
!! * INVESTMENT ALTERNATIVES IN THE BOND MARKET. THE SELECTION
!! * IS CONSTRAIND BY RATING AND MATURITY CONSIDERATIONS.
!! *
!! * REFERENCE: CONTROL DATA CORPORATION, IFPS/OPTIMIM - USERS MANUAL,
!! *            MINNEAPOLIS, 1984.
!!
!! SETS  B     BONDS  / MUNICIP-A, MUNICIP-B, CORPORATE, US-SER-E, US-SER-F /
!! G(B)  GROUPING / CORPORATE, US-SER-E, US-SER-F /
!!
!! TABLE YDAT(B,*)  YIELD DATA
!!
!! RATING  MATURITY  YIELD  TAX-RATE
!! MUNICIP-A      2        9      4.3
!! MUNICIP-B      5        2      4.5
!! CORPORATE      2       15      5.4      .5
!! US-SER-E       1        4      5.0      .5
!! US-SER-F       1        3      4.4      .5
!!
!! VARIABLES  INVESTMENT(B)
!! TINVEST    TOTAL INVESTMENT
!! RETURN
!! POSITIVE VARIABLE INVESTMENT
!!
!! EQUATIONS  GROUPMIN   MINIMUM INVESTMENT IN GROUP G
!! RDEF       RATING DEFINITION
!! MDEF       MATURITY DEFINITION
!! IDEF       TOTAL RETURN DEFINITION
!! TDEF       TOTAL INVESTMENT DEFINITION ;
!! $DOUBLE
!! TINVEST.UP = 10;
!! GROUPMIN.. SUM(G, INVESTMENT(G)) =G=  4;
!! RDEF..  SUM(B, YDAT(B,'RATING  ')*INVESTMENT(B)) =L= 1.4*TINVEST;
!! MDEF..  SUM(B, YDAT(B,'MATURITY')*INVESTMENT(B)) =L= 5.0*TINVEST;
!! TDEF..  TINVEST =E= SUM(B, INVESTMENT(B));
!! IDEF..  RETURN  =E= SUM(B, YDAT(B,'YIELD')/100*(1-YDAT(B,'TAX-RATE'))*INVESTMENT(B));
!! MODEL PORT / ALL / ; SOLVE PORT MAXIMIZING RETURN USING LP;
!! @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 ex01
!
!  Declare the user callback routines as Integer, External:
!
   Use proginfo
   Use conopt
   implicit None
 
   Integer, External :: ex01_readmatrix ! Mandatory Matrix definition routine defined below
   Integer, External :: std_status      ! Standard callback for displaying solution status
   Integer, External :: ex01_solution   ! Specialized 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 :: Ex01_ReadMatrix
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Std_Status
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Ex01_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
 
   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 (excl. slacks). 5 Investment, Tinvest, and Return
!  for a total of 7:
!
   coi_error = max( coi_error, coidef_numvar( cntvect, 7 ) )
!
!  Number of equations: Groupmin, Rdef, Mdef, Idef, and Tdef for a total
!  of 5:
!
   coi_error = max( coi_error, coidef_numcon( cntvect, 5 ) )
!
!  Number of nonzeros in the Jacobian. This is more complicated. See the
!  counting in Ex01_ReadMatrix below:
!
   coi_error = max( coi_error, coidef_numnz( cntvect,27 ) )
!
!  Number of nonlinear nonzeros. The model is linear so the number is
!  zero:
!
   coi_error = max( coi_error, coidef_numnlnz( cntvect, 0 ) )
!
!  Optimization direction is Maximize = 1
!
   coi_error = max( coi_error, coidef_optdir( cntvect, 1 ) )
!
!  Objective is variable Return = 7
!
   coi_error = max( coi_error, coidef_objvar( cntvect, 7 ) )
!
!  Define the options file as 'ex01.opt'
!
   coi_error = max( coi_error, coidef_optfile( cntvect, 'ex01.opt'  ) )
!
!  Tell CONOPT about the callback routines:
!
   coi_error = max( coi_error, coidef_readmatrix( cntvect, ex01_readmatrix ) )
   coi_error = max( coi_error, coidef_status( cntvect, std_status     ) )
   coi_error = max( coi_error, coidef_solution( cntvect, ex01_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
!
!  Start CONOPT:
!
   coi_error = coi_solve( cntvect )
 
   write(*,*)
   write(*,*) 'End of example ex01'
 
   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-0.298364d0 ) > 0.000001d0 ) then
      call flog( "Incorrect objective returned", 1 )
   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 ex01
!
! ============================================================================
!  Define information about the model:
!
 
!>  Define information about the model
!!
!! @include{doc} readMatrix_params.dox
Integer Function ex01_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 :: Ex01_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 first 5 variables are Positive, i.e. have a lower bound of
!  zero. They must be defined. The remaining two variables are Free,
!  i.e. have a lower bound of -infinity, which is the default, and we
!  do not define them:
!
   lower(1) = 0.d0
   lower(2) = 0.d0
   lower(3) = 0.d0
   lower(4) = 0.d0
   lower(5) = 0.d0
!
!  Tinvest (number 6) has an upper bound of 10 and all other variables
!  are unbounded, i.e. have an upper bound of +infinity, which is the
!  default, so we do not define them:
!
   upper(6) = 10.d0
!
!  Define information about the Constraints:
!
!  By default, we do not define the status argument Esta.
!
! Groupmin: Type >=  or 1:
!
   type(1) = 1
!
! Rdef and Mdef: Type <= or 2:
!
   type(2) = 2
   type(3) = 2
!
! Tdef and Idef: Type = or 0:
!
   type(4) = 0
   type(5) = 0
!
!  Right hand sides: Only Groupmin (number 1) has a nonzero Right hand
!  side so it is sufficient to define this one. The default is zero:
!
   rhs(1)  = 4.d0
!
!  Define the structure and content of the Jacobian
!
!  To help define the Jacobian pattern and values it can be useful to
!  make a picture of the Jacobian. Since the model is small and linear
!  we can put everything in one small table:
!
!             inv1   inv2   inv3   inv4   inv5  tinvest  return
! groupmin                    1      1      1
! rdef          2      5      2      1      1    -1.4
! mdef          9      2     15      4      3    -5.0
! tdef          1      1      1      1      1    -1
! idef        0.043  0.045  0.027  0.025  0.022           -1
!
!  The model is linear so we do not have the define the nonlinearity
!  flag, Nlflag.
!  The Jacobian has to be sorted column-wise so we will just define
!  the elements column by column according to the table above:
!
!  Column 1, Inv1. Start in position 1.
!
   colsta(1) = 1
   rowno(1)  = 2
   value(1)  = 2.d0
   rowno(2)  = 3
   value(2)  = 9.d0
   rowno(3)  = 4
   value(3)  = 1.d0
   rowno(4)  = 5
   value(4)  = 0.043d0
!
!  Column 2, Inv2. Start in position 5:
!
   colsta(2) = 5
   rowno(5)  = 2
   value(5)  = 5.d0
   rowno(6)  = 3
   value(6)  = 2.d0
   rowno(7)  = 4
   value(7)  = 1.d0
   rowno(8)  = 5
   value(8)  = 0.045d0
!
!  Column 3, Inv3. Start in position 9:
!
   colsta(3)  = 9
   rowno(9)   = 1
   value(9)   = 1.d0
   rowno(10)  = 2
   value(10)  = 2.d0
   rowno(11)  = 3
   value(11)  = 15.d0
   rowno(12)  = 4
   value(12)  = 1.d0
   rowno(13)  = 5
   value(13)  = 0.027d0
!
!  Column 4, Inv4. Start in position 14:
!
   colsta(4)  = 14
   rowno(14)  = 1
   value(14)  = 1.d0
   rowno(15)  = 2
   value(15)  = 1.d0
   rowno(16)  = 3
   value(16)  = 4.d0
   rowno(17)  = 4
   value(17)  = 1.d0
   rowno(18)  = 5
   value(18)  = 0.025d0
!
!  Column 5, Inv5. Start in position 19:
!
   colsta(5)  = 19
   rowno(19)  = 1
   value(19)  = 1.d0
   rowno(20)  = 2
   value(20)  = 1.d0
   rowno(21)  = 3
   value(21)  = 3.d0
   rowno(22)  = 4
   value(22)  = 1.d0
   rowno(23)  = 5
   value(23)  = 0.022d0
!
!  Column 6, Tinvest, Start in position 24:
!
   colsta(6)  = 24
   rowno(24)  = 2
   value(24)  = -1.4d0
   rowno(25)  = 3
   value(25)  = -5.0d0
   rowno(26)  = 4
   value(26)  = -1.d0
!
!  Column 7, Return, Start in position 27:
!
   colsta(7)  = 27
   rowno(27)  = 5
   value(27)  = -1.d0
!
!  End of columns, the next free position is 28 = number of elements+1:
!  The number of elements, 27, was the one reported in Ipsz(3) in
!  Coipsz.
!
   colsta(8) = 28
 
   ex01_readmatrix = 0
 
end Function ex01_readmatrix
!
! ======================================================================
!  This was the end of the model definition. The next three routines are
!  standard routines used to report the solution back and write the
!  messages.
! ======================================================================
Integer Function ex01_solution( XVAL, XMAR, XBAS, XSTA, YVAL, YMAR, YBAS, YSTA, N, M, USRMEM )
#ifdef dec_directives_win32
!DEC$ ATTRIBUTES STDCALL, REFERENCE, NOMIXED_STR_LEN_ARG :: Ex01_Solution
#endif
 
   Use proginfo
   IMPLICIT NONE
   INTEGER, Intent(IN)                  :: n, m
   INTEGER, Intent(IN),    Dimension(N) :: xbas, xsta
   INTEGER, Intent(IN),    Dimension(M) :: ybas, ysta
   real*8,  Intent(IN),    Dimension(N) :: xval, xmar
   real*8,  Intent(IN),    Dimension(M) :: yval, ymar
   real*8,  Intent(IN OUT)              :: usrmem(*)
 
   INTEGER i
   CHARACTER*5, Parameter, Dimension(4) :: stat  = (/ 'Lower','Upper','Basic','Super' /)
 
   Character*9, Parameter, Dimension(7) :: vname = (/ 'MUNICIP-A', 'MUNICIP-B', 'CORPORATE', 'US-SER-E ', 'US-SER-F ', &
                                                      'Tinvest  ', 'Return   ' /)
   Character*9, Parameter, Dimension(5) :: cname = (/ 'GroupMin ', 'RDef     ', 'Mdef     ', 'Tdef     ', 'Idef     ' /)
 
   WRITE(*,"(/' Variable       Solution value    Reduced cost    B-stat'/)")
   DO i = 1, n
      WRITE(*,"(1P,1X,A9,E20.6,E16.6,4X,A5 )") vname(i), xval(i), xmar(i), stat(1+xbas(i))
   ENDDO
 
   WRITE(*,"(/' Constraint     Activity level    Marginal cost   B-stat'/)")
   DO i = 1, m
      WRITE(*,"(1P,1X,A9,E20.6,E16.6,4X,A5 )") cname(i), yval(i), ymar(i), stat(1+ybas(i))
   ENDDO
 
   solcalls = solcalls + 1
   ex01_solution = 0
 
END Function ex01_solution