!************************************************************************
!*
!*
!*     * Test problems for large NonSmooth UNConstrained minimization *
!*
!*     by Napsu Karmitsa (2011)
!*
!*
!*     * Problems *
!*      
!*     1.  Generalization of MAXQ (convex).
!*     2.  Generalization of MXHILB (convex).
!*     3.  Chained LQ (convex).
!*     4.  Chained CB3 I (convex).
!*     5.  Chained CB3 II (convex).
!*     6.  Number of active faces (nonconvex).
!*     7.  Nonsmooth generalization of Brown function 2 (nonconvex).
!*     8.  Chained Mifflin 2 (nonconvex). 
!*     9.  Chained crescent I (nonconvex). 
!*     10. Chained crescent II (nonconvex).
!*
!*
!*     * References*
!*
!*     Haarala M., Miettinen K. and Mäkelä M.M.: New Limited Memory
!*     Bundle Method for Large-Scale Nonsmooth Optimization, Optimization
!*     Methods and Software, Vol. 19, No. 6, 2004, 673-692.
!*
!*
!************************************************************************
!*
!*
!*     File tnsunc.f95 includes two modules: MODULE problem_data and 
!*     MODULE large_problems. MODULE problem_data is just for storing 
!*     some global data needed in calculations (e.g. the number of the
!*     problem). MODULE large_problems includes the following subroutines
!*
!*     S   startx          Initiation of variables.
!*     S   func            Computation of the value of the objective 
!*                           function.
!*     S   subgra          Computation of the subgradient of the 
!*                           objective function.
!*     S   fungra          Computation of the value and the subgradient 
!*                           of the objective function.
!*
!*     For more details of these subroutines see below.
!*
!*     In addition to these modules, you need a MODULE r_precision to run 
!*     these problems (you may uncomment MODULE r_precision from below if 
!*     you do not have it elsewhere).
!* 

!MODULE r_precision ! 
!  IMPLICIT NONE
!  INTEGER, PARAMETER, PUBLIC :: prec = SELECTED_REAL_KIND(2*PRECISION(1.0))  ! old DOUBLE PRECISION
!!  INTEGER, PARAMETER, PUBLIC :: prec = SELECTED_REAL_KIND(12) 
!!  INTEGER, PARAMETER, PUBLIC :: prec = SELECTED_REAL_KIND(6) 
!END MODULE r_precision


MODULE problem_data
  USE r_precision, ONLY : prec 
  IMPLICIT NONE
  INTEGER, SAVE :: next, &                   ! Number of the problem
                   hit                       ! Number of the active partial objective
  REAL(KIND=prec), SAVE :: f_sign            ! sign of the active partial objective
  REAL(KIND=prec), DIMENSION(3), SAVE :: f_k ! partial values of the objective
END MODULE problem_data


MODULE large_problems 
  USE r_precision, ONLY : prec 
  USE problem_data, ONLY : next

  IMPLICIT NONE
  PRIVATE
  PUBLIC :: startx,func,subgra,fungra
  
CONTAINS

!************************************************************************
!*      
!*     * SUBROUTINE startx *
!*
!*      
!*     * Purpose *
!*
!*     Initiation of x.
!*
!*      
!*     * Calling sequence *
!*
!*     CALL startx(n,x)
!*
!*
!*     * Parameters *
!*      
!*     II  n          Number of variables.
!*     RO  x(n)       Vector of variables.
!*
!*
!*     * Modules *
!*     
!*     problem_data, ONLY : next
!*     r_precision, ONLY : prec 
!*
      
  SUBROUTINE startx(n,x)

!    USE problem_data, ONLY : next ! no need, if inside MODULE large_problems
!    USE r_precision, ONLY : prec ! no need, if inside MODULE large_problems
    IMPLICIT NONE

!   Scalar Arguments
    INTEGER, INTENT(IN) :: n                         ! Number of variables

!   Array Arguments
    REAL(KIND=prec), DIMENSION(n), INTENT(OUT) :: x  ! Vector of variables

!   Local Arguments
    INTEGER :: i

!   Intrinsic Functions
    INTRINSIC MOD,REAL


    SELECT CASE (next)  ! Number of the problem

    CASE(1)  ! Generalization of MAXQ (convex)
       DO i=1,n/2
          x(i) = REAL(i, KIND=prec)
       END DO
       DO i=n/2+1,n
          x(i) = -REAL(i, KIND=prec)
       END DO

    CASE(2)  ! Generalization of MXHILB (convex)
       DO i=1,n
          x(i) = 1.0_prec
       END DO

    CASE(3)  ! Chained LQ (convex)
       DO i=1,n
          x(i) = -0.50_prec
       END DO

    CASE(4,5)  ! Chained CB3 I and II (convex)
       DO i=1,n
          x(i) = 2.0_prec
       END DO

    CASE(6)  ! Number of active faces (nonconvex)
       DO i=1,n
          x(i) = 1.0_prec
       END DO
      
    CASE(7)  ! Nonsmooth generalization of Brown function 2 (nonconvex)
       DO i=1,n
          IF (MOD(i,2) == 1) THEN
             x(i) = -1.0_prec
          ELSE
             x(i) = 1.0_prec
          END IF
       END DO
      
    CASE(8)  ! Chained Mifflin 2 (nonconvex)
       DO i=1,n
          x(i) = -1.0_prec
       END DO
      
    CASE(9,10)  ! Chained crescent I and II (nonconvex)
       DO i=1,n
          IF (MOD(i,2) == 1) THEN
             x(i) = -1.50_prec
          ELSE
             x(i) = 2.0_prec
          END IF
       END DO

    CASE DEFAULT  ! Error
       PRINT*,'Error: Not such a problem.'
       next=-1

    END SELECT

  END SUBROUTINE startx
      
!************************************************************************
!*      
!*     * SUBROUTINE func *
!*
!*      
!*     * Purpose *
!*
!*     Computation of the value of the objective function.
!*
!*      
!*     * Calling sequence *
!*
!*     CALL func(n,x,f)
!*
!*
!*     * Parameters *
!*      
!*     II  n          Number of variables.
!*     RI  x(n)       Vector of variables.
!*     RO  f          Value of the objective function.
!*
!*
!*     * Modules *
!*     
!*     problem_data, ONLY : next,hit,f_sign,f_k
!*     r_precision, ONLY : prec 
!*
      
  SUBROUTINE func(n,x,f)

!    USE problem_data, ONLY : next  ! no need, if inside MODULE large_problems
!    USE precision, ONLY : prec  ! no need, if inside MODULE large_problems
    USE problem_data, ONLY : hit,f_sign,f_k
    IMPLICIT NONE

!   Scalar Arguments
    INTEGER, INTENT(IN) :: n                        ! Number of variables
    REAL(KIND=prec), INTENT(OUT) :: f               ! Value of the objective function

!   Array Arguments
    REAL(KIND=prec), DIMENSION(n), INTENT(IN) :: x  ! Vector of variables

!   Local Arguments
    INTEGER :: i,j
    REAL(KIND=prec), PARAMETER :: zero=0.0, one=1.0, two=2.0
    REAL(KIND=prec) :: y,z,v,w

!   Intrinsic Functions
    INTRINSIC ABS,MAX,SIGN,LOG,EXP,REAL


    SELECT CASE (next)  ! Number of the problem
       
    CASE (1)  ! Generalization of MAXQ (convex)
       f=x(1)*x(1)
       hit=1
       DO i=2,n
          y=x(i)*x(i)
          IF (y > f) THEN
             f=y
             hit=i
          END IF
       END DO

    CASE (2)  ! Generalization of MXHILB (convex)
       f = zero
       hit = 1
       DO j = 1,n
          f = f + x(j)/REAL(j, KIND=prec)
       END DO
       f_sign=SIGN(one,f)
       f = ABS(f)
       DO i = 2,n
          y = zero
          DO j = 1,n
             y = y + x(j)/REAL(i+j-1, KIND=prec)
          END DO
          z = ABS(y)
          IF (z > f) THEN
             f=z
             hit=i
             f_sign=SIGN(one,y)
          END IF
       END DO

    CASE (3)  ! Chained LQ (convex)
       f=zero
       DO i=1,n-1
          y = -x(i)-x(i+1)
          z = -x(i)-x(i+1)+(x(i)*x(i)+x(i+1)*x(i+1)-one)
          IF (y >= z) THEN
             f=f+y
          ELSE
             f=f+z
          END IF
       END DO

    CASE (4)  ! Chained CB3 I (convex)
       f=zero
       DO i=1,n-1
          z = x(i)*x(i)*x(i)*x(i)+x(i+1)*x(i+1)
          v = (two-x(i))*(two-x(i))+ &
               (two-x(i+1))*(two-x(i+1))
          w = two*EXP(-x(i)+x(i+1))
          y = MAX(z,v,w)
          f = f+y
       END DO
      
    CASE (5)  ! Chained CB3 II (convex)
       f=zero
       f_k=zero 

       DO i=1,n-1
          f_k(1)=f_k(1)+x(i)*x(i)*x(i)*x(i)+x(i+1)*x(i+1)
          f_k(2)=f_k(2)+(two-x(i))*(two-x(i))+ &
               (two-x(i+1))*(two-x(i+1))
          f_k(3)=f_k(3)+two*EXP(-x(i)+x(i+1))
       END DO
       f=MAX(f_k(1),f_k(2),f_k(3))

    CASE (6)  ! Number of active faces (nonconvex)
       f_sign = one
       f_k(1) = -x(1)
       f = LOG(ABS(x(1))+one)
       hit = 1
       DO i=2,n
          f_k(1) = f_k(1) - x(i)
          y = LOG(ABS(x(i))+one) 
          IF(f < y) THEN
             hit = i
             f = y
          END IF
       END DO
       y = LOG(ABS(f_k(1))+one) 
       IF(f < y) THEN
          hit=n+1
          f = y
          IF (f_k(1) >= zero) f_sign = -one
       ELSE
          IF (x(hit) < zero) f_sign = -one
       END IF
      
    CASE (7)  ! Nonsmooth generalization of Brown function 2 (nonconvex)
       f=zero
       DO i=1,n-1
          y = ABS(x(i))
          z = ABS(x(i+1))
          v = x(i)*x(i)+one
          w = x(i+1)*x(i+1)+one
          f = f+z**v+y**w
       END DO

    CASE (8) ! Chained mifflin 2 (nonconvex)
       f=zero
       DO i=1,n-1
          y = x(i)*x(i) + x(i+1)*x(i+1) - one
          f = f -x(i) + two*y + 1.75_prec*ABS(y)
       END DO

    CASE (9)  ! Chained crescent I (nonconvex)
       f_k(1)=zero
       f_k(2)=zero
       DO i=1,n-1
          f_k(1) = f_k(1) + x(i)*x(i) + (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) - one
          f_k(2) = f_k(2) - x(i)*x(i) - (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) + one
       END DO
       f = MAX(f_k(1),f_k(2))
       
    CASE (10)  ! Chained crescent II (nonconvex)
       f=zero
       DO i=1,n-1
          y =  x(i)*x(i) + (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) - one
          z =  - x(i)*x(i) - (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) + one
          IF (y >= z) THEN
             f=f+y
          ELSE
             f=f+z
          END IF
       END DO

    CASE DEFAULT  ! Error
       PRINT*,'Error: Not such a problem.'
       next=-1

    END SELECT

  END SUBROUTINE func

!************************************************************************
!*      
!*     * SUBROUTINE subgra *
!*
!*      
!*     * Purpose *
!*
!*     Computation of the subgradient of the objective function.
!*
!*      
!*     * Calling sequence *
!*
!*     CALL subgra(n,x,g)
!*
!*
!*     * Parameters *
!*      
!*     II  n          Number of variables.
!*     RI  x(n)       Vector of variables.
!*     RO  g(n)       Subgradient of the objective function.
!*
!*
!*     * Modules *
!*     
!*     problem_data, ONLY : next,hit,f_sign,f_k
!*     r_precision, ONLY : prec 
!*
      
  SUBROUTINE subgra(n,x,g)

!    USE problem_data, ONLY : next  ! no need, if inside MODULE large_problems
!    USE precision, ONLY : prec  ! no need, if inside MODULE large_problems
    USE problem_data, ONLY : hit,f_sign,f_k 
    IMPLICIT NONE

!   Scalar Arguments
    INTEGER, INTENT(IN) :: n                          ! Number of variables

!   Array Arguments
    REAL(KIND=prec), DIMENSION(n), INTENT(IN) :: x    ! Vector of variables
    REAL(KIND=prec), DIMENSION(n), INTENT(OUT)  :: g  ! Subgradient of the objective

!   Local Arguments
    INTEGER :: i,j
    REAL(KIND=prec), PARAMETER :: zero=0.0, one=1.0, two=2.0
    REAL(KIND=prec) :: y,z,v,w,u

!   Intrinsic Functions
    INTRINSIC ABS,MAX,SIGN,LOG,EXP,REAL


    SELECT CASE (next)  ! Number of the problem
       
    CASE (1)  ! Generalization of MAXQ (convex)
       g = zero
       g(hit) = two*x(hit)

    CASE (2)  ! Generalization of MXHILB (convex)
       DO i = 1,n
          g(i) = f_sign/REAL(hit+i-1, KIND=prec)
       END DO
      
    CASE (3)  ! Chained LQ (convex)
       g(1) = zero
       DO i=1,n-1
          g(i+1) = zero
          y = -x(i)-x(i+1)
          z = -x(i)-x(i+1)+(x(i)*x(i)+x(i+1)*x(i+1)-one)
          IF (y >= z) THEN
             g(i) = g(i)-one
             g(i+1) = -one
          ELSE
             g(i) = g(i)-one+two*x(i)
             g(i+1) = -one+two*x(i+1)
          ENDIF
       END DO

    CASE (4)  ! Chained CB3 I (convex)
       g(1) = zero
       DO i=1,n-1
          g(i+1) = zero
          z = x(i)*x(i)*x(i)*x(i)+x(i+1)*x(i+1)
          v = (two-x(i))*(two-x(i))+ &
               (two-x(i+1))*(two-x(i+1))
          w = two*EXP(-x(i)+x(i+1))
          y = MAX(z,v,w) 
          IF (y == z) THEN
             g(i) = g(i)+4.0_prec*x(i)*x(i)*x(i)
             g(i+1) = two*x(i+1)
          ELSE IF (y == v) THEN
             g(i) = g(i)+two*x(i)-4.0_prec
             g(i+1) = two*x(i+1)-4.0_prec
          ELSE
             g(i) = g(i) - w
             g(i+1) = w
          END IF
       END DO
      
    CASE (5)  ! Chained CB3 II (convex)
       g(1)=zero 
       y = MAX(f_k(1),f_k(2),f_k(3))
       IF (y == f_k(1)) THEN
          DO i=1,n-1
             g(i) = g(i)+4.0_prec*x(i)*x(i)*x(i)
             g(i+1) = two*x(i+1)
          END DO
       ELSE IF (y == f_k(2)) THEN
          DO i=1,n-1
             g(i) = g(i)+two*x(i)-4.0_prec
             g(i+1) = two*x(i+1)-4.0_prec
          END DO
       ELSE
          DO i=1,n-1
             g(i) = g(i) - two*EXP(-x(i)+x(i+1))
             g(i+1) = two*EXP(-x(i)+x(i+1))
          END DO
       END IF

    CASE (6)  ! Number of active faces (nonconvex)
       IF (hit == n+1) THEN
          DO i=1,n
             g(i) = f_sign/(ABS(f_k(1))+one)
          END DO
       ELSE
          g = zero
          g(hit) = f_sign/(ABS(x(hit))+one)
       END IF
      
    CASE (7)  ! Nonsmooth generalization of Brown function 2 (nonconvex)
       g(1)=zero
       DO i=1,n-1
          y = ABS(x(i))
          z = ABS(x(i+1))
          v = x(i)*x(i)+one
          w = x(i+1)*x(i+1)+one
          u = zero
          IF (z > u) u = LOG(z)
          IF (x(i) < zero) THEN
             g(i) = g(i)-w*y**(w-one)+two*x(i)*u*z**v
          ELSE
             g(i) = g(i)+w*y**(w-one)+two*x(i)*u*z**v
          END IF

          u = zero
          IF (x(i+1) == zero) THEN
             g(i+1) = zero
          ELSE IF (x(i+1) < zero) THEN
             IF (y > u) u = LOG(y)
             g(i+1)=-v*z**(v-one)+two*x(i+1)*u*y**w
          ELSE
             IF (y > u) u = LOG(y)
             g(i+1)=v*z**(v-one)+two*x(i+1)*u*y**w
          END IF
       END DO
      
    CASE (8)  ! Chained mifflin 2 (nonconvex)
       g(1)=zero
       DO i=1,n-1
          y = x(i)*x(i) + x(i+1)*x(i+1) - one
          f_sign = SIGN(3.5_prec,y) + 4.0_prec
          g(i) = g(i) + f_sign*x(i) - one
          g(i+1) = f_sign*x(i+1)
       END DO

    CASE (9)  ! Chained crescent I (nonconvex)
       g(1)=zero
       IF (f_k(1) >= f_k(2)) THEN
          DO i=1,n-1
             g(i)=g(i)+two*x(i)
             g(i+1)=two*(x(i+1)-one) + one
          END DO
       ELSE
          DO i=1,n-1
             g(i)=g(i)-two*x(i)
             g(i+1)=-two*(x(i+1)-one) + one
          END DO
       END IF
         
    CASE (10)  ! Chained crescent II (nonconvex)
       g(1)=zero
       DO i=1,n-1
          y =  x(i)*x(i) + (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) - one
          z =  - x(i)*x(i) - (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) + one
          IF (y >= z) THEN
             g(i)=g(i)+two*x(i)
             g(i+1)=two*(x(i+1)-one) + one
          ELSE
             g(i)=g(i)-two*x(i)
             g(i+1)=-two*(x(i+1)-one) + one
          END IF
       END DO

    CASE DEFAULT  ! Error
       PRINT*,'Error: Not such a problem.'
       next=-1

    END SELECT

  END SUBROUTINE subgra

!************************************************************************
!*      
!*     * SUBROUTINE fungra *
!*
!*      
!*     * Purpose *
!*
!*     Computation of the value and the subgradient of the objective
!*     function.
!*
!*      
!*     * Calling sequence *
!*
!*     CALL fungra(n,x,f,g)
!*
!*
!*     * Parameters *
!*      
!*     II  n          Number of variables.
!*     RI  x(n)       Vector of variables.
!*     RO  f          Value of the objective function.
!*     RO  g(n)       Subgradient of the objective function.
!*
!*
!*     * Modules *
!*     
!*     problem_data, ONLY : next,hit
!*     r_precision, ONLY : prec 
!*
      
  SUBROUTINE fungra(n,x,f,g)

!    USE problem_data, ONLY : next  ! no need, if inside MODULE large_problems
!    USE precision, ONLY : prec  ! no need, if inside MODULE large_problems
!    USE problem_data, ONLY : hit ! no need, we can have local hit "pip"
    IMPLICIT NONE

!   Scalar Arguments
    INTEGER, INTENT(IN) :: n                          ! Number of variables
    REAL(KIND=prec), INTENT(OUT) :: f                 ! Value of the objective

!   Array Arguments
    REAL(KIND=prec), DIMENSION(n), INTENT(IN) :: x    ! Vector of variables
    REAL(KIND=prec), DIMENSION(n), INTENT(OUT)  :: g  ! Subgradient

!   Local Arguments
    INTEGER :: i,j,pip
    REAL(KIND=prec), PARAMETER :: zero=0.0, one=1.0, two=2.0
    REAL(KIND=prec) :: y,z,v,w,u

!   Intrinsic Functions
    INTRINSIC ABS,MAX,SIGN,LOG,EXP,REAL

    SELECT CASE (next)
       
    CASE (1)  ! Generalization of MAXQ (convex)
       f = x(1)*x(1)
       g(1) = zero
       pip = 1
       DO i=2,n
          y = x(i)*x(i)
          IF (y > f) THEN
             f = y
             pip = i
          END IF
          g(i) = zero
       END DO
       g(pip) = two*x(pip)

    CASE (2)  ! Generalization of MXHILB (convex)
       f = zero
       pip = 1
       DO j=1,n
          f = f + x(j)/REAL(j, KIND=prec)
       END DO
       g(1) = SIGN(one,f)
       f = ABS(f)
       DO i=2,n
          y = zero
          DO j=1,n
             y = y + x(j)/REAL(i+j-1, KIND=prec)
          END DO
          g(i) = SIGN(one,y)
          y = ABS(y)
          IF (y > f) THEN
             f = y
             pip = i
          END IF
       END DO
       z = g(pip)
       DO j=1,n
          g(j) = z/REAL(pip+j-1, KIND=prec)
       END DO
      
    CASE (3)  ! Chained LQ (convex)
       f = zero
       g(1) = zero
       DO i=1,n-1
          g(i+1) = zero
          y = -x(i)-x(i+1)
          z = -x(i)-x(i+1)+(x(i)*x(i)+x(i+1)*x(i+1)-one)
          IF (y >= z) THEN
             f = f+y
             g(i) = g(i)-one
             g(i+1) = -one
          ELSE
             f = f+z
             g(i) = g(i)-one+two*x(i)
             g(i+1) = -one+two*x(i+1)
          ENDIF
       END DO

    CASE (4)  ! Chained CB3 I (convex)
       f = zero
       g(1) = zero
       DO i=1,n-1
          g(i+1) = zero
          z = x(i)*x(i)*x(i)*x(i)+x(i+1)*x(i+1)
          v = (two-x(i))*(two-x(i))+(two-x(i+1))*(two-x(i+1))
          w = two*EXP(-x(i)+x(i+1))
          y = MAX(z,v,w)
          IF (y == z) THEN
             g(i) = g(i)+4.0_prec*x(i)*x(i)*x(i)
             g(i+1) = two*x(i+1)
          ELSE IF (y == v) THEN
             g(i) = g(i)+two*x(i)-4.0_prec
             g(i+1) = two*x(i+1)-4.0_prec
          ELSE
             g(i) = g(i) - w
             g(i+1) = w
          END IF
          f = f+y
       END DO
      
    CASE (5)  ! Chained CB3 II (convex)
       f = zero
       g(1) = zero
       y = zero
       z = zero
       v = zero

       DO i=1,n-1
          g(i+1) = zero
          y = y+x(i)*x(i)*x(i)*x(i)+x(i+1)*x(i+1)
          z = z+(two-x(i))*(two-x(i))+(two-x(i+1))*(two-x(i+1))
          v = v+two*EXP(-x(i)+x(i+1))
       END DO
       f=MAX(y,z,v)
       IF (f == y) THEN
          DO i=1,n-1
             g(i) = g(i)+4.0_prec*x(i)*x(i)*x(i)
             g(i+1) = two*x(i+1)
          END DO
       ELSE IF (f == z) THEN
          DO i=1,n-1
             g(i) = g(i)+two*x(i)-4.0_prec
             g(i+1) = two*x(i+1)-4.0_prec
          END DO
       ELSE
          DO i=1,n-1
             g(i) = g(i) - two*EXP(-x(i)+x(i+1))
             g(i+1) = two*EXP(-x(i)+x(i+1))
          END DO
       END IF

    CASE (6)  ! Number of active faces (nonconvex)
       w = one
       y = -x(1)
       f = LOG(ABS(x(1))+one)
       pip = 1
       DO i=2,n
          y = y - x(i)
          z = LOG(ABS(x(i))+one) 
          IF(f < z) THEN
             pip = i
             f = z
          END IF
       END DO
       z = LOG(ABS(y)+one) 
       IF(f < z) THEN
          f = z
          IF (y >= zero) w = -one
          DO i=1,n
             g(i) = w/(ABS(y)+one)
          END DO
       ELSE
          IF (x(pip) < zero) w = -one
          g = zero
          g(pip) = w/(ABS(x(pip))+one)
       END IF

    CASE (7)  ! Nonsmooth generalization of Brown function 2 (nonconvex)
       f = zero
       g(1) = zero
       DO i=1,n-1
          y =ABS(x(i))
          z =ABS(x(i+1))
          v =x(i)*x(i)+one
          w =x(i+1)*x(i+1)+one
          f = f+z**v+y**w

          u = zero
          IF (z > u) u = LOG(z)
          IF (x(i) < zero) THEN
             g(i) = g(i)-w*y**(w-one)+two*x(i)*u*z**v
          ELSE
             g(i) = g(i)+w*y**(w-one)+two*x(i)*u*z**v
          END IF

          u = zero
          IF (x(i+1) == zero) THEN
             g(i+1)=zero
          ELSE IF (x(i+1) < zero) THEN
             IF (y > u) u = LOG(y)
             g(i+1)=-v*z**(v-one)+two*x(i+1)*u*y**w
          ELSE
             IF (y > u) u = LOG(y)
             g(i+1)=v*z**(v-one)+two*x(i+1)*u*y**w
          END IF
       END DO
      
    CASE (8)  ! Chained mifflin 2 (nonconvex)
       f = zero
       g(1) = zero
       DO i=1,n-1
          y = x(i)*x(i) + x(i+1)*x(i+1) - one
          f = f -x(i) + two*y + 1.75_prec*ABS(y)
          y = SIGN(3.5_prec,y) + 4.0_prec
          g(i) = g(i) + y*x(i) - one
          g(i+1) = y*x(i+1)
       END DO

    CASE (9)  ! Chained crescent I (nonconvex)
       y = zero
       z = zero
       DO i=1,n-1
          y = y + x(i)*x(i) + (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) - one
          z = z - x(i)*x(i) - (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) + one
       END DO
       f = MAX(y,z)
       
       g(1) = zero
       IF (y >= z) THEN
          DO i=1,n-1
             g(i) = g(i)+two*x(i)
             g(i+1) = two*(x(i+1)-one) + one
          END DO
       ELSE
          DO i=1,n-1
             g(i) = g(i)-two*x(i)
             g(i+1) = -two*(x(i+1)-one) + one
          END DO
       END IF
         
    CASE (10)  ! Chained crescent II (nonconvex)
       f = zero
       g(1) = zero
      
       DO i=1,n-1
          y = x(i)*x(i) + (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) - one
          z = - x(i)*x(i) - (x(i+1)-one)*(x(i+1)-one) &
               + x(i+1) + one
          IF (y >= z) THEN
             f = f+y
             g(i) = g(i)+two*x(i)
             g(i+1) = two*(x(i+1)-one) + one
          ELSE
             f = f+z
             g(i) = g(i)-two*x(i)
             g(i+1) = -two*(x(i+1)-one) + one
          END IF
       END DO

    CASE DEFAULT
       PRINT*,'Error: Not such a problem.'
       next=-1

    END SELECT

  END SUBROUTINE fungra

END MODULE large_problems

