C     =================================================================
C     File: problem-bmpru-03.f
C     =================================================================

C     March 21, 2012.

C     ******************************************************************
C     ******************************************************************

      subroutine inip(n,x,l,u,m,lambda,rho,equatn,linear,ml,meq,alin,
     +acol,aval,annz,b)

      implicit none

C     SCALAR ARGUMENTS
      integer annz,m,ml,meq,n

C     ARRAY ARGUMENTS
      logical equatn(*),linear(*)
      integer alin(*),acol(*)
      double precision aval(*),b(*),l(*),lambda(*),rho(*),u(*),x(*)

C     Number of variables
      n = 1

C     Lower and upper bounds
      l(1) = - 10.0d0
      u(1) =   10.0d0

C     Initial point
      x(1) = 1.5d0

C     Number of constraints (equalities plus inequalities)
      m = 1

C     Lagrange multipliers approximation.
      lambda(1) = 0.0d0

C     Initial penalty parameters
      rho(1) = 10.0d0

      equatn(1) = .false.
      linear(1) = .false.

C     Number of lower-level linear constraints
      ml   = 0
      meq  = 0
      annz = 0

      end

C     ******************************************************************
C     ******************************************************************

      subroutine evalf(n,x,f,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,n
      double precision f

C     ARRAY ARGUMENTS
      double precision x(n)

      flag = 0

      f = x(1)

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalg(n,x,g,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,n

C     ARRAY ARGUMENTS
      double precision g(n),x(n)

      flag = 0

      g(1) = 1.0d0 

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalh(n,x,hlin,hcol,hval,hnnz,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,n,hnnz

C     ARRAY ARGUMENTS
      integer hcol(*),hlin(*)
      double precision hval(*),x(n)

      flag = 0

      hnnz = 0

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalc(n,x,ind,c,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer ind,flag,n
      double precision c

C     ARRAY ARGUMENTS
      double precision x(n)

      flag = 0

      c = x(1) ** 2 + 1.0d0

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evaljac(n,x,ind,indjac,valjac,jcnnz,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,ind,n,jcnnz

C     ARRAY ARGUMENTS
      integer indjac(n)
      double precision x(n),valjac(n)

      flag = 0

      jcnnz = 1

      indjac(1) = 1
      valjac(1) = 2.0d0 * x(1)

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalhc(n,x,ind,hclin,hccol,hcval,hcnnz,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,ind,n,hcnnz

C     ARRAY ARGUMENTS
      integer hccol(*),hclin(*)
      double precision hcval(*),x(n)

      flag = 0

      hcnnz = 1

      hclin(1) = 1
      hccol(1) = 1
      hcval(1) = 2.0d0

      end

C     ******************************************************************
C     ******************************************************************

      subroutine evalhlp(n,x,m,lambda,p,hp,goth,flag)

      implicit none

C     SCALAR ARGUMENTS
      logical goth
      integer flag,m,n

C     ARRAY ARGUMENTS
      double precision hp(n),lambda(m),p(n),x(n)

      flag = - 1

      end

C     ******************************************************************
C     ******************************************************************

      subroutine endp(n,x,l,u,m,lambda,rho,equatn,linear)

      implicit none

C     SCALAR ARGUMENTS
      integer m,n

C     ARRAY ARGUMENTS
      logical equatn(m),linear(m)
      double precision l(n),lambda(m),rho(m),u(n),x(n)

      end

C     ******************************************************************
C     ******************************************************************

      subroutine addc(n,l,u,f,ml,meq,alin,acol,aval,annz,b,mla,annza,
     +ind)

C     SCALAR ARGUMENTS
      integer annz,annza,meq,ml,mla,n
      double precision f

C     ARRAY ARGUMENTS
      integer alin(annz),acol(annz),ind(ml)
      double precision aval(annz),b(ml),l(n),u(n)

C     LOCAL SCALARS
      integer i,imax
      double precision tmp,tmp2,tmp3,tmpl2,tmpl3,tmpu2,tmpu3

      mla   = ml
      annza = annz

C     x(1) ** 2 <= 1

C     imax linear understimation of x^2 based on Taylor expansion

      imax = 3

      do i = 1,imax
          tmp = l(1) + ( u(1) - l(1) ) * ( i - 1 ) / ( imax - 1 )

C         - tmp ** 2 + 2.0d0 * tmp * x(1) + 1 <= x(1) ** 2 + 1

          ind(mla+1) = 1

          alin(annza+1) = mla + 1
          acol(annza+1) = 1
          aval(annza+1) = - 2.0d0 * tmp

          b(mla+1) = - tmp ** 2 + 1.0d0

          mla   = mla   + 1
          annza = annza + 1
      end do

      end

C     ******************************************************************
C     ******************************************************************

      subroutine setlv(n,linvar)

      implicit none

C     SCALAR ARGUMENTS
      integer n

C     ARRAY ARGUMENTS
      logical linvar(n)

      linvar(1) = .false.

      end

C     ******************************************************************
C     ******************************************************************

      subroutine evalfi(n,y,f,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,n
      double precision f(2)

C     ARRAY ARGUMENTS
      double precision y(2*n)

C     LOCAL ARRAYS
      double precision tmp(2)

C     EXTERNAL FUNCTIONS
      integer P

      flag = 0

      call ivli(y(P(1)),f)

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalhi(n,y,hlin,hcol,hval,hnnz,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,n,hnnz

C     ARRAY ARGUMENTS
      integer hcol(*),hlin(*)
      double precision hval(*),y(2*n)

C     This subroutine computes the intervalar Hessian matrix of the 
C     objective function.

      flag = 0

      hnnz = 0

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalci(n,y,ind,c,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer ind,flag,n
      double precision c(2)

C     ARRAY ARGUMENTS
      double precision y(2*n)

C     This subroutine computes the interval of the ind-th constraint of 
C     your problem. 
 
C     LOCAL ARRAYS
      double precision tmp(2)

C     EXTERNAL FUNCTION
      integer P

      flag = 0

c     c = x(1) ** 2 - 1.0d0
      call power(y(P(2)),2,c)
      call ivl1(1.0d0,tmp)
      call add(c,tmp,c)

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evaljaci(n,y,ind,indjac,valjac,jcnnz,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,ind,n,jcnnz

C     ARRAY ARGUMENTS
      integer indjac(n)
      double precision y(2*n),valjac(2*n)

C     This subroutine must compute the intervalar gradient of the 
C     constraint ind. 

C     EXTERNAL FUNCTION
      integer P

      flag = 0

      jcnnz = 1

      indjac(1) = 1
C     valjac(1) = 2.0d0 * x(1)
      call sclmlt(2.0d0,y(P(1)),valjac(P(1)))

      end

C     ******************************************************************
C     ******************************************************************
 
      subroutine evalhci(n,y,ind,hclin,hccol,hcval,hcnnz,flag)

      implicit none

C     SCALAR ARGUMENTS
      integer flag,ind,n,hcnnz

C     ARRAY ARGUMENTS
      integer hccol(*),hclin(*)
      double precision hcval(*),y(2*n)

C     This subroutine might compute the intervalar Hessian matrix of 
C     the ind-th constraint. 

C     EXTERNAL FUNCTION
      integer P

      flag = 0

      hcnnz = 1

      hclin(1) = 1
      hccol(1) = 1
C     hcval(1) = 2.0d0
      call ivl1(2.0d0,hcval(P(1)))

      end