Skip to content

Commit

Permalink
Amending from PR feedback
Browse files Browse the repository at this point in the history 
An intermediate variable was introduced so that the interface will
still work if RP=4.

The method of providing f0 was modified to make it more user friendly.
rhobeg and rhoend adopted the same approach as f0 so that they
could be either specified by the user or made to appear as if not
present.
  • Loading branch information
@nbelakovski
nbelakovski committed Jan 11, 2024
1 parent a1bf874 commit 995c330
Show file tree
Hide file tree
Showing 9 changed files with 101 additions and 61 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/cmake.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,7 @@ jobs:
matrix:
toolchain:
- {compiler: aflang, cflags: '-Wall', fflags: '-Wpedantic -Weverything -Wall -Wextra -Minform=warn -Mstandard -Mrecursive'}
- {compiler: nvfortran, cflags: '-Wall', fflags: '-C -Wall -Wextra -Minform=warn -Mstandard -Mrecursive -Mbounds -Mchkstk -Mchkptr'}
- {compiler: nvfortran, cflags: '-Wall', fflags: '-C -Wall -Wextra -Minform=warn -Mstandard -Mrecursive -Mbounds -Mchkstk'}
- {compiler: flang, cflags: '-Wall', fflags: '-Wpedantic -Weverything -Wall -Wextra'}

steps:
Expand Down
34 changes: 21 additions & 13 deletions c/bobyqa_c.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,9 +16,11 @@ module bobyqa_c_mod
subroutine bobyqa_c(cobj_ptr, data_ptr, n, x, f, xl, xu, nf, rhobeg, rhoend, &
& ftarget, maxfun, npt, iprint, callback_ptr, info) bind(C)
use, intrinsic :: iso_c_binding, only : C_DOUBLE, C_INT, C_FUNPTR, C_PTR, C_ASSOCIATED, C_F_PROCPOINTER, C_F_POINTER
use, non_intrinsic :: bobyqa_mod, only : bobyqa
use, non_intrinsic :: cintrf_mod, only : COBJ, CCALLBACK
use, non_intrinsic :: consts_mod, only : RP, IK
use, non_intrinsic :: bobyqa_mod, only : bobyqa
use, non_intrinsic :: infnan_mod, only : is_nan
use, non_intrinsic :: memory_mod, only : safealloc
implicit none

! Compulsory arguments
Expand Down Expand Up @@ -47,12 +49,14 @@ subroutine bobyqa_c(cobj_ptr, data_ptr, n, x, f, xl, xu, nf, rhobeg, rhoend, &
integer(IK) :: npt_loc
integer(IK) :: nf_loc
real(RP) :: f_loc
real(RP) :: rhobeg_loc
real(RP) :: rhoend_loc
real(RP), allocatable :: rhobeg_loc
real(RP), allocatable :: rhoend_loc
real(RP) :: ftarget_loc
real(RP) :: x_loc(n)
real(RP), pointer :: xl_loc(:)
real(RP), pointer :: xu_loc(:)
real(C_DOUBLE), pointer :: xl_loc_intrmdiate(:)

Check failure

Code scanning / check-spelling

Unrecognized Spelling Error

intrmdiate is not a recognized word. (unrecognized-spelling)
real(RP), allocatable :: xl_loc(:)
real(C_DOUBLE), pointer :: xu_loc_intrmdiate(:)

Check failure

Code scanning / check-spelling

Unrecognized Spelling Error

intrmdiate is not a recognized word. (unrecognized-spelling)
real(RP), allocatable :: xu_loc(:)
! The initialization to null is necessary to avoid a bug with the newer Intel compiler ifx.
! See details here: https://fortran-lang.discourse.group/t/strange-issue-with-ifx-compiler-and-assume-recursion/7013
! The bug was observed in all versions of ifx up to 2024.0.1. Once this bug is fixed we should remove the
Expand All @@ -63,17 +67,21 @@ subroutine bobyqa_c(cobj_ptr, data_ptr, n, x, f, xl, xu, nf, rhobeg, rhoend, &
! Read the inputs and convert them to the Fortran side types
x_loc = real(x, kind(x_loc))
if (C_ASSOCIATED(xl)) then
call C_F_POINTER(xl, xl_loc, shape=[n])
else
xl_loc => null()
call C_F_POINTER(xl, xl_loc_intrmdiate, shape=[n])

Check failure

Code scanning / check-spelling

Unrecognized Spelling Error

intrmdiate is not a recognized word. (unrecognized-spelling)
call safealloc(xl_loc, int(n, IK))
xl_loc = real(xl_loc_intrmdiate, kind(xl_loc))

Check failure

Code scanning / check-spelling

Unrecognized Spelling Error

intrmdiate is not a recognized word. (unrecognized-spelling)
end if
if (C_ASSOCIATED(xu)) then
call C_F_POINTER(xu, xu_loc, shape=[n])
else
xu_loc => null()
call C_F_POINTER(xu, xu_loc_intrmdiate, shape=[n])

Check failure

Code scanning / check-spelling

Unrecognized Spelling Error

intrmdiate is not a recognized word. (unrecognized-spelling)
call safealloc(xu_loc, int(n, IK))
xu_loc = real(xu_loc_intrmdiate, kind(xu_loc))
end if
if (.not. is_nan(rhobeg)) then
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
end if
if (.not. is_nan(rhoend)) then
rhoend_loc = real(rhoend, kind(rhoend_loc))
end if
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
rhoend_loc = real(rhoend, kind(rhoend_loc))
ftarget_loc = real(ftarget, kind(ftarget_loc))
maxfun_loc = int(maxfun, kind(maxfun_loc))
npt_loc = int(npt, kind(npt_loc))
Expand Down
53 changes: 30 additions & 23 deletions c/cobyla_c.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,10 @@ subroutine cobyla_c(m_nlcon, cobjcon_ptr, data_ptr, n, x, f, cstrv, nlconstr, m_
& xl, xu, f0, nlconstr0, nf, rhobeg, rhoend, ftarget, maxfun, iprint, callback_ptr, info) bind(C)
use, intrinsic :: iso_c_binding, only : C_DOUBLE, C_INT, C_FUNPTR, C_PTR, C_ASSOCIATED, C_F_PROCPOINTER, C_F_POINTER
use, non_intrinsic :: cintrf_mod, only : COBJCON, CCALLBACK
use, non_intrinsic :: consts_mod, only : RP, IK
use, non_intrinsic :: cobyla_mod, only : cobyla
use, non_intrinsic :: consts_mod, only : RP, IK
use, non_intrinsic :: infnan_mod, only : is_nan
use, non_intrinsic :: memory_mod, only : safealloc
implicit none

! Compulsory arguments
Expand All @@ -38,7 +40,7 @@ subroutine cobyla_c(m_nlcon, cobjcon_ptr, data_ptr, n, x, f, cstrv, nlconstr, m_
real(C_DOUBLE), intent(in) :: beq(m_eq)
type(C_PTR), intent(in), value :: xl
type(C_PTR), intent(in), value :: xu
type(C_PTR), intent(in), value :: f0
real(C_DOUBLE), intent(in), value :: f0
type(C_PTR), intent(in), value :: nlconstr0
integer(C_INT), intent(out) :: nf
real(C_DOUBLE), intent(in), value :: rhobeg
Expand All @@ -62,14 +64,17 @@ subroutine cobyla_c(m_nlcon, cobjcon_ptr, data_ptr, n, x, f, cstrv, nlconstr, m_
real(RP) :: cstrv_loc
real(RP) :: nlconstr_loc(m_nlcon)
real(RP) :: f_loc
real(RP) :: rhobeg_loc
real(RP) :: rhoend_loc
real(RP), allocatable :: rhobeg_loc
real(RP), allocatable :: rhoend_loc
real(RP) :: ftarget_loc
real(RP) :: x_loc(n)
real(RP), pointer :: xl_loc(:)
real(RP), pointer :: xu_loc(:)
real(RP), pointer :: f0_loc
real(RP), pointer :: nlconstr0_loc(:)
real(C_DOUBLE), pointer :: xl_loc_intrmdiate(:)
real(RP), allocatable :: xl_loc(:)
real(C_DOUBLE), pointer :: xu_loc_intrmdiate(:)
real(RP), allocatable :: xu_loc(:)
real(RP), allocatable :: f0_loc
real(C_DOUBLE), pointer :: nlconstr0_loc_intrmdiate(:)
real(RP), allocatable :: nlconstr0_loc(:)
! The initialization to null is necessary to avoid a bug with the newer Intel compiler ifx.
! See details here: https://fortran-lang.discourse.group/t/strange-issue-with-ifx-compiler-and-assume-recursion/7013
! The bug was observed in all versions of ifx up to 2024.0.1. Once this bug is fixed we should remove the
Expand All @@ -86,27 +91,29 @@ subroutine cobyla_c(m_nlcon, cobjcon_ptr, data_ptr, n, x, f, cstrv, nlconstr, m_
Aeq_loc = real(transpose(Aeq), kind(Aeq_loc))
beq_loc = real(beq, kind(beq_loc))
if (C_ASSOCIATED(xl)) then
call C_F_POINTER(xl, xl_loc, shape=[n])
else
xl_loc => null()
call C_F_POINTER(xl, xl_loc_intrmdiate, shape=[n])
call safealloc(xl_loc, int(n, IK))
xl_loc = real(xl_loc_intrmdiate, kind(xl_loc))
end if
if (C_ASSOCIATED(xu)) then
call C_F_POINTER(xu, xu_loc, shape=[n])
else
xu_loc => null()
call C_F_POINTER(xu, xu_loc_intrmdiate, shape=[n])
call safealloc(xu_loc, int(n, IK))
xu_loc = real(xu_loc_intrmdiate, kind(xu_loc))
end if
if (C_ASSOCIATED(f0)) then
call C_F_POINTER(f0, f0_loc)
else
f0_loc => null()
if (.not. is_nan(f0)) then
f0_loc = real(f0, kind(f0_loc))
end if
if (C_ASSOCIATED(nlconstr0)) then
call C_F_POINTER(nlconstr0, nlconstr0_loc, shape=[m_nlcon])
else
nlconstr0_loc => null()
call C_F_POINTER(nlconstr0, nlconstr0_loc_intrmdiate, shape=[m_nlcon])
call safealloc(nlconstr0_loc, int(m_nlcon, IK))
nlconstr0_loc = real(nlconstr0_loc_intrmdiate, kind(nlconstr0_loc))
end if
if (.not. is_nan(rhobeg)) then
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
end if
if (.not. is_nan(rhoend)) then
rhoend_loc = real(rhoend, kind(rhoend_loc))
end if
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
rhoend_loc = real(rhoend, kind(rhoend_loc))
ftarget_loc = real(ftarget, kind(ftarget_loc))
maxfun_loc = int(maxfun, kind(maxfun_loc))
iprint_loc = int(iprint, kind(iprint_loc))
Expand Down
6 changes: 6 additions & 0 deletions c/examples/cobyla/cobyla_example.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
#include <stdint.h>

#define M_NLCON 1
#define PROVIDE_INITIAL_F_AND_NLCONSTR 0

static void fun(const double x[], double *f, double constr[], const void *data)
{
Expand Down Expand Up @@ -40,6 +41,11 @@ int main(int argc, char * argv[])
problem.calcfc = &fun;
problem.x0 = x0;
problem.m_nlcon = M_NLCON;
#if PROVIDE_INITIAL_F_AND_NLCONSTR
double nlconstr0[M_NLCON] = {};
fun(x0, &(problem.f0), nlconstr0, NULL);
problem.nlconstr0 = nlconstr0;
#endif
// set up the options
prima_options_t options;
prima_init_options(&options);
Expand Down
2 changes: 1 addition & 1 deletion c/include/prima/prima.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,7 @@ typedef struct {
int m_nlcon;

// should be set to the objective function value and constraints values of the starting X, cobyla-only
double *f0;
double f0;
double *nlconstr0;

} prima_problem_t;
Expand Down
32 changes: 20 additions & 12 deletions c/lincoa_c.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,9 @@ subroutine lincoa_c(cobj_ptr, data_ptr, n, x, f, cstrv, m_ineq, Aineq, bineq, m_
use, intrinsic :: iso_c_binding, only : C_DOUBLE, C_INT, C_FUNPTR, C_PTR, C_ASSOCIATED, C_F_PROCPOINTER, C_F_POINTER
use, non_intrinsic :: cintrf_mod, only : COBJ, CCALLBACK
use, non_intrinsic :: consts_mod, only : RP, IK
use, non_intrinsic :: infnan_mod, only : is_nan
use, non_intrinsic :: lincoa_mod, only : lincoa
use, non_intrinsic :: memory_mod, only : safealloc
implicit none

! Compulsory arguments
Expand Down Expand Up @@ -59,12 +61,14 @@ subroutine lincoa_c(cobj_ptr, data_ptr, n, x, f, cstrv, m_ineq, Aineq, bineq, m_
real(RP) :: beq_loc(m_eq)
real(RP) :: cstrv_loc
real(RP) :: f_loc
real(RP) :: rhobeg_loc
real(RP) :: rhoend_loc
real(RP), allocatable :: rhobeg_loc
real(RP), allocatable :: rhoend_loc
real(RP) :: ftarget_loc
real(RP) :: x_loc(n)
real(RP), pointer :: xl_loc(:)
real(RP), pointer :: xu_loc(:)
real(C_DOUBLE), pointer :: xl_loc_intrmdiate(:)
real(RP), allocatable :: xl_loc(:)
real(C_DOUBLE), pointer :: xu_loc_intrmdiate(:)
real(RP), allocatable :: xu_loc(:)
! The initialization to null is necessary to avoid a bug with the newer Intel compiler ifx.
! See details here: https://fortran-lang.discourse.group/t/strange-issue-with-ifx-compiler-and-assume-recursion/7013
! The bug was observed in all versions of ifx up to 2024.0.1. Once this bug is fixed we should remove the
Expand All @@ -81,17 +85,21 @@ subroutine lincoa_c(cobj_ptr, data_ptr, n, x, f, cstrv, m_ineq, Aineq, bineq, m_
Aeq_loc = real(transpose(Aeq), kind(Aeq_loc))
beq_loc = real(beq, kind(beq_loc))
if (C_ASSOCIATED(xl)) then
call C_F_POINTER(xl, xl_loc, shape=[n])
else
xl_loc => null()
call C_F_POINTER(xl, xl_loc_intrmdiate, shape=[n])
call safealloc(xl_loc, int(n, IK))
xl_loc = real(xl_loc_intrmdiate, kind(xl_loc))
end if
if (C_ASSOCIATED(xu)) then
call C_F_POINTER(xu, xu_loc, shape=[n])
else
xu_loc => null()
call C_F_POINTER(xu, xu_loc_intrmdiate, shape=[n])
call safealloc(xu_loc, int(n, IK))
xu_loc = real(xu_loc_intrmdiate, kind(xu_loc))
end if
if (.not. is_nan(rhobeg)) then
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
end if
if (.not. is_nan(rhoend)) then
rhoend_loc = real(rhoend, kind(rhoend_loc))
end if
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
rhoend_loc = real(rhoend, kind(rhoend_loc))
ftarget_loc = real(ftarget, kind(ftarget_loc))
maxfun_loc = int(maxfun, kind(maxfun_loc))
npt_loc = int(npt, kind(npt_loc))
Expand Down
13 changes: 9 additions & 4 deletions c/newuoa_c.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ subroutine newuoa_c(cobj_ptr, data_ptr, n, x, f, nf, rhobeg, rhoend, ftarget, ma
use, intrinsic :: iso_c_binding, only : C_DOUBLE, C_INT, C_FUNPTR, C_PTR, C_ASSOCIATED, C_F_PROCPOINTER
use, non_intrinsic :: cintrf_mod, only : COBJ, CCALLBACK
use, non_intrinsic :: consts_mod, only : RP, IK
use, non_intrinsic :: infnan_mod, only : is_nan
use, non_intrinsic :: newuoa_mod, only : newuoa
implicit none

Expand Down Expand Up @@ -43,8 +44,8 @@ subroutine newuoa_c(cobj_ptr, data_ptr, n, x, f, nf, rhobeg, rhoend, ftarget, ma
integer(IK) :: npt_loc
integer(IK) :: nf_loc
real(RP) :: f_loc
real(RP) :: rhobeg_loc
real(RP) :: rhoend_loc
real(RP), allocatable :: rhobeg_loc
real(RP), allocatable :: rhoend_loc
real(RP) :: ftarget_loc
real(RP) :: x_loc(n)
! The initialization to null is necessary to avoid a bug with the newer Intel compiler ifx.
Expand All @@ -56,8 +57,12 @@ subroutine newuoa_c(cobj_ptr, data_ptr, n, x, f, nf, rhobeg, rhoend, ftarget, ma

! Read the inputs and convert them to the Fortran side types
x_loc = real(x, kind(x_loc))
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
rhoend_loc = real(rhoend, kind(rhoend_loc))
if (.not. is_nan(rhobeg)) then
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
end if
if (.not. is_nan(rhoend)) then
rhoend_loc = real(rhoend, kind(rhoend_loc))
end if
ftarget_loc = real(ftarget, kind(ftarget_loc))
maxfun_loc = int(maxfun, kind(maxfun_loc))
npt_loc = int(npt, kind(npt_loc))
Expand Down
7 changes: 4 additions & 3 deletions c/prima.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,8 @@ int prima_init_options(prima_options_t *options)
{
memset(options, 0, sizeof(prima_options_t));
options->maxfun = -1;// interpreted as MAXFUN_DIM_DFT*n
options->rhobeg = 1.0;
options->rhoend = 1e-6;
options->rhobeg = NAN;
options->rhoend = NAN;
options->iprint = PRIMA_MSG_NONE;
options->ftarget = -INFINITY;
options->npt = -1;// interpreted as 2*n+1
Expand All @@ -32,6 +32,7 @@ int prima_init_problem(prima_problem_t *problem, int n)
{
memset(problem, 0, sizeof(prima_problem_t));
problem->n = n;
problem->f0 = NAN;
return 0;
}
else
Expand All @@ -43,7 +44,7 @@ int cobyla_c(const int m_nlcon, const prima_objcon_t calcfc, const void *data, c
const int m_ineq, const double Aineq[], const double bineq[],
const int m_eq, const double Aeq[], const double beq[],
const double xl[], const double xu[],
double *f0, const double nlconstr0[],
const double f0, const double nlconstr0[],
int *nf, const double rhobeg, const double rhoend, const double ftarget, const int maxfun, const int iprint, const prima_callback_t callback, int *info);
int bobyqa_c(prima_obj_t calfun, const void *data, const int n, double x[], double *f, const double xl[], const double xu[],
int *nf, const double rhobeg, const double rhoend, const double ftarget, const int maxfun, const int npt, const int iprint, const prima_callback_t callback, int *info);
Expand Down
13 changes: 9 additions & 4 deletions c/uobyqa_c.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ subroutine uobyqa_c(cobj_ptr, data_ptr, n, x, f, nf, rhobeg, rhoend, ftarget, ma
use, intrinsic :: iso_c_binding, only : C_DOUBLE, C_INT, C_FUNPTR, C_PTR, C_ASSOCIATED, C_F_PROCPOINTER
use, non_intrinsic :: cintrf_mod, only : COBJ, CCALLBACK
use, non_intrinsic :: consts_mod, only : RP, IK
use, non_intrinsic :: infnan_mod, only : is_nan
use, non_intrinsic :: uobyqa_mod, only : uobyqa
implicit none

Expand All @@ -41,8 +42,8 @@ subroutine uobyqa_c(cobj_ptr, data_ptr, n, x, f, nf, rhobeg, rhoend, ftarget, ma
integer(IK) :: maxfun_loc
integer(IK) :: nf_loc
real(RP) :: f_loc
real(RP) :: rhobeg_loc
real(RP) :: rhoend_loc
real(RP), allocatable :: rhobeg_loc
real(RP), allocatable :: rhoend_loc
real(RP) :: ftarget_loc
real(RP) :: x_loc(n)
! The initialization to null is necessary to avoid a bug with the newer Intel compiler ifx.
Expand All @@ -54,8 +55,12 @@ subroutine uobyqa_c(cobj_ptr, data_ptr, n, x, f, nf, rhobeg, rhoend, ftarget, ma

! Read the inputs and convert them to the Fortran side types
x_loc = real(x, kind(x_loc))
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
rhoend_loc = real(rhoend, kind(rhoend_loc))
if (.not. is_nan(rhobeg)) then
rhobeg_loc = real(rhobeg, kind(rhobeg_loc))
end if
if (.not. is_nan(rhoend)) then
rhoend_loc = real(rhoend, kind(rhoend_loc))
end if
ftarget_loc = real(ftarget, kind(ftarget_loc))
maxfun_loc = int(maxfun, kind(maxfun_loc))
iprint_loc = int(iprint, kind(iprint_loc))
Expand Down

0 comments on commit 995c330

Please sign in to comment.