MODULE obj_fun ! Computation of the value and the subgradient of the ! objective function (supplied by the user). USE r_precision, ONLY : prec ! Precision for reals. IMPLICIT NONE PUBLIC :: & myf, & ! Computation of the value of the objective. User spesified function. myg ! Computation of the subgradient of the objective. User spesified function. ! Not needed with DDG-Bundle. CONTAINS !************************************************************************ !* * !* * SUBROUTINE myf * * !* * !* Computation of the value of the objective. User spesified * !* function. Use this with LMBM, LDGM, and DDG-Bundle. If * !* PSLMBM is used this subroutine may be left empty. * !* * !************************************************************************ SUBROUTINE myf(n,x,f,iterm) USE problem_data, ONLY : next ! Data module for large scale nonsmooth ! test problems: Number of the problem. USE large_problems, ONLY : func ! Large-scale nonsmooth test problems: ! Computation of the value for problem next. 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 objective function. INTEGER, INTENT(IN) :: n ! Number of variables. INTEGER, INTENT(OUT) :: iterm ! Cause of termination: ! 0 - Everything is ok. ! -3 - Failure in function calculations ! (assigned by the user). iterm = 0 ! Function evaluation (give your function here). CALL func(n,x,f) ! Only the value of the objective IF (next < 1) iterm = -3 ! Error checking. END SUBROUTINE myf !************************************************************************ !* * !* * SUBROUTINE myg * * !* * !* Computation of the subgradient of the objective function. User * !* spesified function. Use this with LMBM. If LDGB, DDG-Bundle or * !* PSLMBM is used, this subroutine may be left empty. * !* * !************************************************************************ SUBROUTINE myg(n,x,g,iterm) USE problem_data, ONLY : next ! Data module for large scale nonsmooth ! test problems: Number of the problem. USE large_problems, ONLY : subgra ! Large-scale nonsmooth test problems: ! Computation of the subgradient for problem next. 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 ! Subgradient evaluation (give your function here). CALL subgra(n,x,g) ! Only the subgradient IF (next < 1) iterm = -3 ! Error checking. END SUBROUTINE myg END MODULE obj_fun