    MODULE nlp_sparse_ex01_mod
      ! .. Implicit None Statement ..
      IMPLICIT NONE
      ! .. Default Accessibility ..
      PUBLIC
      ! .. Intrinsic Functions ..
      INTRINSIC KIND
      ! .. Parameters ..
      INTEGER, PARAMETER :: wp = KIND(1.0D0)

    CONTAINS

      SUBROUTINE obj_fun(first_call,final_call,x,continue,finish,obj_f, &
         obj_grad,i_comm,r_comm)
        ! .. Implicit None Statement ..
        IMPLICIT NONE
        ! .. Intrinsic Functions ..
        INTRINSIC PRESENT
        ! .. Scalar Arguments ..
        REAL (wp), INTENT (OUT) :: obj_f
        LOGICAL, INTENT (INOUT) :: continue, finish
        LOGICAL, INTENT (IN) :: final_call, first_call
        ! .. Array Arguments ..
        INTEGER, OPTIONAL, INTENT (IN) :: i_comm(:)
        REAL (wp), OPTIONAL, INTENT (INOUT) :: obj_grad(:)
        REAL (wp), OPTIONAL, INTENT (IN) :: r_comm(:)
        REAL (wp), INTENT (IN) :: x(:)
        ! .. Executable Statements ..

        obj_f = 1.0E-6_wp*x(3)**3 + (2.0E-6_wp/3.0_wp)*x(4)**3

        IF (PRESENT(obj_grad)) THEN
          obj_grad(1:2) = 0.0_wp
          obj_grad(3) = 3.0E-6_wp*x(3)**2
          obj_grad(4) = 2.0E-6_wp*x(4)**2
        END IF
      END SUBROUTINE obj_fun

      SUBROUTINE con_fun(first_call,final_call,x,continue,finish,con_f, &
         con_jac,i_comm,r_comm)
        ! .. Implicit None Statement ..
        IMPLICIT NONE
        ! .. Intrinsic Functions ..
        INTRINSIC COS, PRESENT, SIN
        ! .. Parameters ..
        REAL (wp), PARAMETER :: quarter = 0.25_wp, thousand = 1000.0_wp
        ! .. Scalar Arguments ..
        LOGICAL, INTENT (INOUT) :: continue, finish
        LOGICAL, INTENT (IN) :: final_call, first_call
        ! .. Array Arguments ..
        INTEGER, OPTIONAL, INTENT (IN) :: i_comm(:)
        REAL (wp), INTENT (OUT) :: con_f(:)
        REAL (wp), OPTIONAL, INTENT (INOUT) :: con_jac(:)
        REAL (wp), OPTIONAL, INTENT (IN) :: r_comm(:)
        REAL (wp), INTENT (IN) :: x(:)
        ! .. Executable Statements ..

        con_f(1) = SIN(-x(1)-quarter) + SIN(-x(2)-quarter)
        con_f(2) = SIN(x(1)-quarter) + SIN(x(1)-x(2)-quarter)
        con_f(3) = SIN(x(2)-quarter) + SIN(x(2)-x(1)-quarter)
        con_f = thousand*con_f

        IF (PRESENT(con_jac)) THEN
          con_jac(1) = -COS(-x(1)-quarter)
          con_jac(2) = COS(x(1)-x(2)-quarter) + COS(x(1)-quarter)
          con_jac(3) = -COS(x(2)-x(1)-quarter)
          con_jac(4) = -COS(-x(2)-quarter)
          con_jac(5) = -COS(x(1)-x(2)-quarter)
          con_jac(6) = COS(x(2)-quarter) + COS(x(2)-x(1)-quarter)
          con_jac = thousand*con_jac
        END IF
      END SUBROUTINE con_fun

    END MODULE nlp_sparse_ex01_mod

    PROGRAM nag_nlp_sparse_ex01

      ! Example Program Text for nag_nlp_sparse
      ! NAG fl90, Release 4. NAG Copyright 2000.

      ! .. Use Statements ..
      USE nag_examples_io, ONLY : nag_std_in, nag_std_out
      USE nlp_sparse_ex01_mod, ONLY : con_fun, obj_fun, wp
      USE nag_nlp_sparse, ONLY : nag_nlp_sparse_sol
      ! .. Implicit None Statement ..
      IMPLICIT NONE
      ! .. Parameters ..
      INTEGER, PARAMETER :: idummy = -11111, m = 6, n = 4
      INTEGER, PARAMETER :: nnz = 14, num_nlin_con = 3, num_nlin_jac_var = 2, &
       num_nlin_obj_var = 4, obj_row = 6
      ! .. Local Scalars ..
      INTEGER :: i, icol, jcol
      REAL (wp) :: obj_f
      ! .. Local Arrays ..
      INTEGER :: col_ptr(n+1) = idummy
      INTEGER :: row_index(nnz)
      REAL (wp) :: a(nnz), s(m), s_lower(m), s_upper(m), x(n), x_lower(n), &
       x_upper(n)
      CHARACTER (8) :: names(n+m) = (/ 'Varble 1', 'Varble 2', 'Varble 3', &
       'Varble 4', 'NlnCon 1', 'NlnCon 2', 'NlnCon 3', 'LinCon 1', 'LinCon 2', &
       'Free Row'/)
      ! .. Executable Statements ..
      WRITE (nag_std_out,*) 'Example Program Results for nag_nlp_sparse_ex01'

      READ (nag_std_in,*)          ! Skip heading in data file

      jcol = 1
      col_ptr(jcol) = 1
      DO i = 1, nnz

        ! Element ( row_index(i), icol ) is stored in a( i )

        READ (nag_std_in,*) a(i), row_index(i), icol

        IF (icol<jcol) THEN

          ! Elements not ordered by increasing column index.

          WRITE (nag_std_out,*) 'Element in column', icol, &
           ' found after element in column', jcol, '. Problem abandoned.'
          STOP

        ELSE IF (icol==jcol+1) THEN

          ! Index in a of the start of the icol-th column equals i.

          col_ptr(icol) = i
          jcol = icol

        ELSE IF (icol>jcol+1) THEN

          ! Index in a of the start of the icol-th column equals i,
          ! but columns jcol+1,jcol+2,...,icol-1 are empty. Set the
          ! corresponding elements of col_ptr to i.

          col_ptr(jcol+1:icol) = i
          jcol = icol
        END IF
      END DO

      col_ptr(n+1) = nnz + 1

      IF (n>icol) THEN

        ! Columns n,n-1,...,icol+1 are empty. Set the corresponding
        ! elements of col_ptr accordingly.

        DO i = n, icol + 1, -1
          IF (col_ptr(i)==idummy) col_ptr(i) = col_ptr(i+1)
        END DO

      END IF

      READ (nag_std_in,*) (x_lower(i),i=1,n)
      READ (nag_std_in,*) (x_upper(i),i=1,n)
      READ (nag_std_in,*) (s_lower(i),i=1,m)
      READ (nag_std_in,*) (s_upper(i),i=1,m)
      READ (nag_std_in,*) (x(i),i=1,n)

      ! Solve the problem

      CALL nag_nlp_sparse_sol(x,s,obj_f,obj_fun=obj_fun, &
       num_nlin_con=num_nlin_con,num_nlin_obj_var=num_nlin_obj_var, &
       num_nlin_jac_var=num_nlin_jac_var,obj_row=obj_row,con_fun=con_fun,a=a, &
       row_index=row_index,col_ptr=col_ptr,names=names,x_lower=x_lower, &
       x_upper=x_upper,s_lower=s_lower,s_upper=s_upper)

    END PROGRAM nag_nlp_sparse_ex01
