create a simulated_annealing_type from C
| Type | Intent | Optional | 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) |
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