!**************************************************************************
!*                                                                        *
!*     Computation of the value of the clusterwise support vector linear  *
!*     regression problem and the corresponding subgradient.              *
!*     (last modified 14.08.2018).                                        *
!*                                                                        *
!**************************************************************************
!*
!*     Modules included:
!*
!*     clrobjfun         !
!*

MODULE clrobjfun  ! Computation of the value and the subgradient of the
                  ! objective function in the clusterwise support vector linear regression problem.

                  
    USE r_precision, ONLY : prec  ! Precision for reals.
    IMPLICIT NONE

    PUBLIC :: &
        myf,    &   ! Computation of the value of the objective.
        myf1,   &   ! Computation of the first DC component value of the objective.
        myf2,   &   ! Computation of the second DC component value of the objective.
        myg, &      ! Computation of the subgradient of the objective.
        myg1, &     ! Computation of the subgradient of the first DC component of the objective.
        myg2        ! Computation of the subgradient of the second DC component of the objective.

CONTAINS
    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myf *                                               *
    !*                                                                      *
    !*     Computation of the value of the objective.                       *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myf(n,x,f,iterm)

        USE param, ONLY : large    ! Parameters.
        USE initclr, ONLY : ns     ! Switch for auxiliary and real clustering problem.

        USE clrfunctionmod, ONLY : &
            auxfunc, &             ! S Computation of auxiliary clustering problem
            clrfunc, &             ! S Computation of clustering problem
            fvb

        IMPLICIT NONE

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

        ! Scalar Arguments
        REAL(KIND=prec), INTENT(OUT) :: f  ! Value of the function.
        INTEGER, INTENT(IN) :: n                        ! Number of variables.      
        INTEGER, INTENT(OUT) :: iterm      ! Cause of termination:
                                           !   0  - Everything is ok.
                                           !  -3  - Failure in function calculations

        iterm = 0

        ! Function evaluation
        IF (ns == 1) THEN  ! Auxiliary problem
            CALL auxfunc(x,f)
        ELSE IF (ns == 3) THEN
            CALL fvb(x,f)
        ELSE  ! Clustering problem
            CALL clrfunc(x,f)
        END IF

        ! Error checking.
        !    IF (f > large) iterm = -3  !
        !    IF (f < -large) iterm = -3 !
        RETURN
      
    END SUBROUTINE myf
    

    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myf1 *                                              *
    !*                                                                      *
    !*     Computation of the first DC component value of the objective.    *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myf1(x,f)

        USE param, ONLY : large    ! Parameters.
        USE initclr, ONLY : ns     ! Switch for auxiliary and real clustering problem.

        USE clrfunctionmod, ONLY : &
            auxfunc1, &             ! S Computation of auxiliary clustering problem
            clrfunc1, &             ! S Computation of clustering problem
            fvb1

        IMPLICIT NONE

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

        ! Scalar Arguments
        REAL(KIND=prec), INTENT(OUT) :: f  ! Value of the function.

        ! Function evaluation
        IF (ns == 1) THEN  ! Auxiliary problem
            CALL auxfunc1(x,f)
        ELSE IF (ns==3) THEN
            CALL fvb1(x,f)
        ELSE  ! Clustering problem
            CALL clrfunc1(x,f)
        END IF

        RETURN
      
    END SUBROUTINE myf1
    
    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myf2 *                                              *
    !*                                                                      *
    !*     Computation of the second DC component value of the objective.   *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myf2(x,f)

        USE param, ONLY : large    ! Parameters.
        USE initclr, ONLY : ns     ! Switch for auxiliary and real clustering problem.

        USE clrfunctionmod, ONLY : &
            auxfunc2, &                ! S Computation of auxiliary clustering problem
            clrfunc2, &                ! S Computation of clustering problem
            fvb2

        IMPLICIT NONE

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

        ! Scalar Arguments
        REAL(KIND=prec), INTENT(OUT) :: f  ! Value of the function.

        ! Function evaluation
        IF (ns == 1) THEN  ! Auxiliary problem
            CALL auxfunc2(x,f)
        ELSE IF (ns == 3) THEN
            CALL fvb2(x,f)
        ELSE  ! Clustering problem
            CALL clrfunc2(x,f)
        END IF

        RETURN
      
    END SUBROUTINE myf2 

    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myg *                                               *
    !*                                                                      *
    !*     Computation of the subgradient of the objective function.        *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myg(n,x,g,iterm)

        USE initclr, ONLY : ns     ! Switch for auxiliary and real clustering problem.
        USE clrfunctionmod, ONLY : &
            fgrad, &                  ! S Computation of the subgradient 
            gradient

        IMPLICIT NONE

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

        ! Scalar Arguments
        INTEGER, INTENT(IN) :: n                        ! Number of variables.
        INTEGER, INTENT(OUT) :: iterm                   ! Cause of termination:
                                                        !   0  - Everything is ok.
                                                        !  -3  - Failure in subgradient calculations
                                                        !        (assigned by the user).
        iterm = 0

        ! Gradient evaluation.
        IF (ns == 3) THEN
            CALL gradient(x,g)
        ELSE
            CALL fgrad(x,g)

        END IF
        RETURN

    END SUBROUTINE myg
    
    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myg1 *                                              *
    !*                                                                      *
    !*     Computation of the subgradient of the first DC component         *   
    !*     objective function.                                              *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myg1(n,x,g)

        USE initclr, ONLY : ns     ! Switch for auxiliary and real clustering problem.
        USE clrfunctionmod, ONLY : &
            fsubgrad1, &            ! S Computation of the subgradient 
            gradient1

        IMPLICIT NONE

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

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

        ! Gradient evaluation.
        IF (ns == 3) THEN
            CALL gradient1(x,g)
        ELSE
            CALL fsubgrad1(x,g)
        END IF
        RETURN

    END SUBROUTINE myg1 
    
    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myg2 *                                               *
    !*                                                                      *
    !*     Computation of the subgradient of the first DC component objective function.        *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myg2(n,x,g)

        USE initclr, ONLY : ns     ! Switch for auxiliary and real clustering problem.
        USE clrfunctionmod, ONLY : &
            fsubgrad2, &                !   clusterwise linear regression function
            gradient2

        IMPLICIT NONE

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

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


        ! Gradient evaluation.
        IF (ns == 3) THEN
            CALL gradient2(x,g)
        ELSE
            CALL fsubgrad2(x,g)
        END IF
        RETURN

    END SUBROUTINE myg2     

END MODULE clrobjfun
