PROGRAM SQP_test
  IMPLICIT NONE
  INTEGER :: n, nclin, ncnln, nctotl, nrowa, nrowj, nrowr, &
      liwork, lwork, i, ifail, iter, itmax, j, mode, msglvl, &
      nstate
  INTEGER, DIMENSION(:), ALLOCATABLE :: istate, iwork
  LOGICAL :: cold, fealin, ortho
  REAL :: bigbnd, epsaf, epsmch, eta, ftol, objf, rteps
  REAL, DIMENSION(:,:), ALLOCATABLE :: a, cjac, r
  REAL, DIMENSION(:), ALLOCATABLE :: x, bl, bu, c, clamda, &
      featol, objgrd, work, x02aje
  EXTERNAL x02aje, confun, e04vce, e04zce, objfun
  ! Asetetaan tehtävän dimensiot
  n = 2; nclin = 1; ncnln = 1; nctotl = n+nclin+ncnln
  nrowa = nclin; nrowj = ncnln; nrowr = n
  liwork = 3*n+nclin+2*ncnln
  lwork = 2*n*n+n*nclin+2*n*ncnln+20*n+11*nclin+21*ncnln
  ALLOCATE(a(nrowa,n), bl(nctotl), bu(nctotl), c(nrowj), &
      cjac(nrowj,n), clamda(nctotl), featol(nctotl), &
      objgrd(n), r(nrowr,n), work(lwork), x(n), &
      istate(nctotl), iwork(liwork))
  ! Alkuasetukset
  nstate = 1; mode = 1; ifail = 1; msglvl = 1
  bigbnd = 1.d10; itmax = 100; eta = 0.9d0
  x = (/ 2.d0,2.d0 /); a = RESHAPE((/1.d0,-2.d0/), (/1,2/))
  bl = (/ -10.d0,-5.d0,-1.d0,-1.d0 /)
  bu = (/ 10.d0,5.d0,-1.d0,1.d10 /)
  cold = .TRUE.; fealin = .TRUE.; ortho = .TRUE.
  ifail = 1  ! Tarkistetaan gradientit
  CALL e04zce(n, nclin, nrowj, confun, objfun, c, cjac, &
      objf, objgrd, x, work, lwork, ifail)
  IF (ifail == 0) THEN  ! Gradienttivektori on ok...
    epsmch = x02aje() ! Selvitetään laskentatarkkuus
    ftol = 10.0d0*epsmch; rteps = SQRT(epsmch)
    featol(1:nctotl) = rteps
    CALL objfun(mode, n, x, objf, objgrd, nstate)
    epsaf = epsmch*ABS(objf)
    ifail = 1  ! Ratkaistaan tehtävä
    CALL e04vce(itmax, msglvl, n, nclin, ncnln, nctotl, &
        nrowa, nrowj, nrowr, bigbnd, epsaf, eta, ftol, a, &
        bl, bu, featol, confun, objfun, cold, fealin, ortho, &
        x, istate, r, iter, c, cjac, objf, objgrd, clamda, &
        iwork, liwork, work, lwork, ifail)
    IF (ifail /= 0) WRITE(*,*) 'e04vce:n ifail =', ifail
  ELSE
    WRITE(*,*) 'Virhe gradienttivektorissa. ifail =', ifail
  END IF
END PROGRAM SQP_test