!**************************************************************************** !* * !* Contains the functions for DBDC solver used to calculate the DC * !* components of the objective function and the subgradients of * !* the DC components * !* (last modified 13.08.2018). * !* * !**************************************************************************** !* !* Modules included: !* !* functions ! !* MODULE functions USE r_precision, ONLY : dp => prec ! double precision (i.e. accuracy) USE initdbdc, ONLY : & ! user_n, & ! user_size_b1, & ! user_size_b2, & ! user_m, & ! user_c, & ! user_r_dec, & ! user_r_inc, & ! user_crit_tol, & ! user_eps_1, & ! user_size, & ! user_eps, & ! user_m_clarke ! IMPLICIT NONE !*..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..* !| .**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**. | !| | | | !| | | | !| | THE MODULE CONTAINS FUNCTIONS | | !| | | | !| | | | !| | * Computation of the value of the DC functions f_1 and f_2: | | !| | - f1(y) the value of DC component f_1 at a point y | | !| | - f2(y) the value of DC component f_2 at a point y | | !| | | | !| | | | !| | * Computation of the subgradient of the DC components f_1 and f_2: | | !| | - subgradient_f1(n,y) the subgradient of f_1 at y | | !| | - subgradient_f2(n,y) the subgradient of f_2 at y | | !| | | | !| | | | !| | | | !| .**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**. | !*..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..**..* CONTAINS !******************************************************************************** ! | ! FUNCTION VALUES OF THE DC COMPONENTS f_1 AND f_2 | ! | !******************************************************************************** FUNCTION f1(y) RESULT(f) ! ! Calculates the function value of the DC component f_1 at a point 'y'. ! ! NOTICE: The dimension of 'y' has to be 'user_n' which is defined in initdbdc.mod ! USE clrobjfun, ONLY : myf1 ! Subroutine: Computation of the value of the second DC component f1 IMPLICIT NONE !**************************** NEEDED FROM USER ************************************* REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: y ! a point where the function value of the DC component f_1 is calculated !**************************** OTHER VARIABLES ************************************** REAL(KIND=dp) :: f ! the function value of the DC component f_1 at a point 'y' ! The function value of f1 CALL myf1(y,f) END FUNCTION f1 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FUNCTION f2(y) RESULT(f) ! ! Calculates the function value of DC component f_2 at a point 'y'. ! ! NOTICE: The dimension of 'y' has to be 'user_n' which is defined in initdbdc.mod. ! USE clrobjfun, ONLY : myf2 ! Subroutine: Computation of the value of the second DC component f2 IMPLICIT NONE !**************************** NEEDED FROM USER ************************************* REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: y ! a point where the function value of the DC component f_2 is calculated !**************************** OTHER VARIABLES ************************************** REAL(KIND=dp) :: f ! the function value of the DC component f_2 at a point 'y' ! The function value of f2 CALL myf2(y,f) END FUNCTION f2 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !******************************************************************************** ! | ! SUBGRADIENTS OF THE DC COMPONENTS f_1 AND f_2 | ! | !******************************************************************************** FUNCTION subgradient_f1(n,y) RESULT(grad) ! ! Calculates a subgradient of the DC component f_1 at a point 'y'. ! ! NOTICE: * The dimension of 'y' has to be 'n'. ! * The dimension of 'grad' is also 'n'. ! USE clrobjfun, ONLY : myg1 ! Subroutine: Computation of the subgradient of ! the first component function f1 IMPLICIT NONE !**************************** NEEDED FROM USER ************************************* REAL(KIND=dp), DIMENSION(n), INTENT(IN) :: y ! a point where the subgradient of the DC component f_1 is calculated INTEGER, INTENT(IN) :: n ! the dimension of 'y' and 'grad' !**************************** OTHER VARIABLES ************************************** REAL(KIND=dp), DIMENSION(n) :: grad ! the subgradient of the DC component f_1 at a point 'y' ! Subgradient evaluation of f1. CALL myg1(n,y,grad) END FUNCTION subgradient_f1 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FUNCTION subgradient_f2(n,y) RESULT(grad) ! ! Calculate a subgradient of the DC component f_2 at a point 'y'. ! ! NOTICE: * The dimension of 'y' has to be 'user_n'. ! * The dimension of 'grad' is also 'user_n'. ! USE clrobjfun, ONLY : myg2 ! Subroutine: Computation of the subgradient of ! the second component function f2 IMPLICIT NONE !**************************** NEEDED FROM USER ************************************* REAL(KIND=dp), DIMENSION(n), INTENT(IN) :: y ! a point where the subgradient of the DC component f_2 is calculated INTEGER, INTENT(IN) :: n ! the dimension of 'y' and 'grad' !**************************** OTHER VARIABLES ************************************** REAL(KIND=dp), DIMENSION(n) :: grad ! the subgradient of the DC component f_2 at a point 'y' ! Subgradient evaluation of f2. CALL myg2(n,y,grad) END FUNCTION subgradient_f2 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END MODULE functions