initialize_simulated_annealing Subroutine

public subroutine initialize_simulated_annealing(iproblem, n, lb, ub, c, maximize, eps, ns, nt, neps, maxevl, iprint, iseed1, iseed2, step_mode, vms, iunit, use_initial_guess, n_resets, cooling_schedule, cooling_param, optimal_f_specified, optimal_f, optimal_f_tol, distribution_mode, dist_std_dev, dist_scale, dist_shape, fcn, n_inputs_to_send, fcn_parallel_input, fcn_parallel_output, ireport, report) bind(C, name="initialize_simulated_annealing")

create a simulated_annealing_type from C

Arguments

Type IntentOptional Attributes Name
integer(kind=c_intptr_t), intent(out) :: iproblem
integer(kind=c_int), intent(in), value :: n
real(kind=c_double), intent(in), dimension(n) :: lb
real(kind=c_double), intent(in), dimension(n) :: ub
real(kind=c_double), intent(in), dimension(n) :: c
logical(kind=c_bool), intent(in), value :: maximize
real(kind=c_double), intent(in), value :: eps
integer(kind=c_int), intent(in), value :: ns
integer(kind=c_int), intent(in), value :: nt
integer(kind=c_int), intent(in), value :: neps
integer(kind=c_int), intent(in), value :: maxevl
integer(kind=c_int), intent(in), value :: iprint
integer(kind=c_int), intent(in), value :: iseed1
integer(kind=c_int), intent(in), value :: iseed2
integer(kind=c_int), intent(in), value :: step_mode
real(kind=c_double), intent(in), value :: vms
integer(kind=c_int), intent(in), value :: iunit
logical(kind=c_bool), intent(in), value :: use_initial_guess
integer(kind=c_int), intent(in), value :: n_resets
integer(kind=c_int), intent(in), value :: cooling_schedule
real(kind=c_double), intent(in), value :: cooling_param
logical(kind=c_bool), intent(in), value :: optimal_f_specified
real(kind=c_double), intent(in), value :: optimal_f
real(kind=c_double), intent(in), value :: optimal_f_tol
integer(kind=c_int), intent(in), dimension(n) :: distribution_mode
real(kind=c_double), intent(in), dimension(n) :: dist_std_dev
real(kind=c_double), intent(in), dimension(n) :: dist_scale
real(kind=c_double), intent(in), dimension(n) :: dist_shape
type(c_funptr), intent(in), value :: fcn

C function pointer (can be C_NULL_FUNPTR)

type(c_funptr), intent(in), value :: n_inputs_to_send

C function pointer (can be C_NULL_FUNPTR)

type(c_funptr), intent(in), value :: fcn_parallel_input

C function pointer (can be C_NULL_FUNPTR)

type(c_funptr), intent(in), value :: fcn_parallel_output

C function pointer (can be C_NULL_FUNPTR)

integer(kind=c_int), intent(in), value :: ireport

how often to report

type(c_funptr), intent(in), value :: report

C function pointer for reporting (can be C_NULL_FUNPTR)


Calls

proc~~initialize_simulated_annealing~~CallsGraph proc~initialize_simulated_annealing initialize_simulated_annealing proc~initialize_sa simulated_annealing_type%initialize_sa proc~initialize_simulated_annealing->proc~initialize_sa

Source Code

    subroutine initialize_simulated_annealing(iproblem, n, lb, ub, c, &
                                              maximize, eps, ns, nt, neps, maxevl, &
                                              iprint, iseed1, iseed2, step_mode, vms, iunit, &
                                              use_initial_guess, n_resets, &
                                              cooling_schedule, cooling_param, &
                                              optimal_f_specified, optimal_f, optimal_f_tol, &
                                              distribution_mode, dist_std_dev, &
                                              dist_scale, dist_shape, &
                                              fcn, n_inputs_to_send, fcn_parallel_input, fcn_parallel_output, &
                                              ireport, report) &
      bind(C, name="initialize_simulated_annealing")

        integer(c_intptr_t), intent(out) :: iproblem
        integer(c_int), intent(in), value :: n
        real(c_double), dimension(n), intent(in) :: lb
        real(c_double), dimension(n), intent(in) :: ub
        real(c_double), dimension(n), intent(in) :: c
        logical(c_bool), intent(in), value :: maximize
        real(c_double), intent(in), value :: eps
        integer(c_int), intent(in), value :: ns
        integer(c_int), intent(in), value :: nt
        integer(c_int), intent(in), value :: neps
        integer(c_int), intent(in), value :: maxevl
        integer(c_int), intent(in), value :: iprint
        integer(c_int), intent(in), value :: iseed1
        integer(c_int), intent(in), value :: iseed2
        integer(c_int), intent(in), value :: step_mode
        real(c_double), intent(in), value :: vms
        integer(c_int), intent(in), value :: iunit
        logical(c_bool), intent(in), value :: use_initial_guess
        integer(c_int), intent(in), value :: n_resets
        integer(c_int), intent(in), value :: cooling_schedule
        real(c_double), intent(in), value :: cooling_param
        logical(c_bool), intent(in), value :: optimal_f_specified
        real(c_double), intent(in), value :: optimal_f
        real(c_double), intent(in), value :: optimal_f_tol
        integer(c_int), dimension(n), intent(in) :: distribution_mode
        real(c_double), dimension(n), intent(in) :: dist_std_dev
        real(c_double), dimension(n), intent(in) :: dist_scale
        real(c_double), dimension(n), intent(in) :: dist_shape
        type(c_funptr), intent(in), value :: fcn  !! C function pointer (can be C_NULL_FUNPTR)
        type(c_funptr), intent(in), value :: n_inputs_to_send  !! C function pointer (can be C_NULL_FUNPTR)
        type(c_funptr), intent(in), value :: fcn_parallel_input  !! C function pointer (can be C_NULL_FUNPTR)
        type(c_funptr), intent(in), value :: fcn_parallel_output  !! C function pointer (can be C_NULL_FUNPTR)
        integer(c_int), intent(in), value :: ireport  !! how often to report
        type(c_funptr), intent(in), value :: report  !! C function pointer for reporting (can be C_NULL_FUNPTR)

        type(c_sa_wrapper_type), pointer :: wrapper
        type(c_ptr) :: cp
        logical :: use_serial_mode, use_parallel_mode, use_report

        ! Allocate the wrapper
        allocate (wrapper)

        ! Store the wrapper pointer for use in callbacks
        cp = c_loc(wrapper)
        wrapper%iproblem = transfer(cp, 0_c_intptr_t)

        ! Convert C function pointers to Fortran procedure pointers
        use_serial_mode = .false.
        use_parallel_mode = .false.

        if (c_associated(fcn)) then
            call c_f_procpointer(fcn, wrapper%c_fcn_ptr)
            use_serial_mode = .true.
        end if

        if (c_associated(n_inputs_to_send) .and. &
            c_associated(fcn_parallel_input) .and. &
            c_associated(fcn_parallel_output)) then
            call c_f_procpointer(n_inputs_to_send, wrapper%c_n_inputs_ptr)
            call c_f_procpointer(fcn_parallel_input, wrapper%c_fcn_parallel_input_ptr)
            call c_f_procpointer(fcn_parallel_output, wrapper%c_fcn_parallel_output_ptr)
            use_parallel_mode = .true.
        end if

        use_report = .false.
        if (c_associated(report)) then
            call c_f_procpointer(report, wrapper%c_report_ptr)
            use_report = .true.
        end if

        ! Initialize the class with appropriate function pointers
        if (use_serial_mode) then
            if (use_report) then
                call init(fcn=fcn_wrapper, report=report_wrapper)
            else
                call init(fcn=fcn_wrapper)
            end if
        else if (use_parallel_mode) then
            if (use_report) then
                call init(n_inputs_to_send=n_inputs_wrapper, &
                          fcn_parallel_input=fcn_parallel_input_wrapper, &
                          fcn_parallel_output=fcn_parallel_output_wrapper, &
                          report=report_wrapper)
            else
                call init(n_inputs_to_send=n_inputs_wrapper, &
                          fcn_parallel_input=fcn_parallel_input_wrapper, &
                          fcn_parallel_output=fcn_parallel_output_wrapper)
            end if
        else
            error stop 'Error: either fcn (serial mode) or all of n_inputs_to_send, '//&
                       'fcn_parallel_input and fcn_parallel_output (parallel mode) must be provided.'
        end if

        ! Return converted pointer to C (pointer to the wrapper)
        iproblem = wrapper%iproblem

        contains
            subroutine init(fcn, n_inputs_to_send, fcn_parallel_input, fcn_parallel_output, report)
                !! this is just a wrapper to initialize, to eliminate
                !! some duplicated code depending on which callbacks are provided.
                procedure(sa_func),optional                       :: fcn
                procedure(sa_func_parallel_inputs),optional       :: n_inputs_to_send
                procedure(sa_func_parallel_inputs_func),optional  :: fcn_parallel_input
                procedure(sa_func_parallel_output_func),optional  :: fcn_parallel_output
                procedure(sa_report_func),optional                :: report
                call wrapper%initialize(n=n, lb=lb, ub=ub, c=c, &
                                        maximize=logical(maximize), &
                                        eps=eps, ns=ns, nt=nt, neps=neps, maxevl=maxevl, &
                                        iprint=iprint, iseed1=iseed1, iseed2=iseed2, &
                                        step_mode=step_mode, vms=vms, iunit=iunit, &
                                        use_initial_guess=logical(use_initial_guess), &
                                        n_resets=n_resets, &
                                        cooling_schedule=cooling_schedule, &
                                        cooling_param=cooling_param, &
                                        optimal_f_specified=logical(optimal_f_specified), &
                                        optimal_f=optimal_f, &
                                        optimal_f_tol=optimal_f_tol, &
                                        distribution_mode=distribution_mode, &
                                        dist_std_dev=dist_std_dev, &
                                        dist_scale=dist_scale, &
                                        dist_shape=dist_shape, &
                                        fcn=fcn,&
                                        n_inputs_to_send=n_inputs_to_send, &
                                        fcn_parallel_input=fcn_parallel_input, &
                                        fcn_parallel_output=fcn_parallel_output, &
                                        ireport=ireport, &
                                        report=report)
            end subroutine init

    end subroutine initialize_simulated_annealing