diff --git a/.github/workflows/cmake.yml b/.github/workflows/cmake.yml index 266c2309c8..9a47cb5ae1 100644 --- a/.github/workflows/cmake.yml +++ b/.github/workflows/cmake.yml @@ -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: diff --git a/c/bobyqa_c.f90 b/c/bobyqa_c.f90 index f553475241..1ac71567cc 100644 --- a/c/bobyqa_c.f90 +++ b/c/bobyqa_c.f90 @@ -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 @@ -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(:) +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 @@ -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]) + 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)) diff --git a/c/cobyla_c.f90 b/c/cobyla_c.f90 index 4c89cc1f0f..b03b9a5c11 100644 --- a/c/cobyla_c.f90 +++ b/c/cobyla_c.f90 @@ -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 @@ -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 @@ -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 @@ -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)) diff --git a/c/examples/cobyla/cobyla_example.c b/c/examples/cobyla/cobyla_example.c index 2d08de39fc..a0b6e1a50a 100644 --- a/c/examples/cobyla/cobyla_example.c +++ b/c/examples/cobyla/cobyla_example.c @@ -6,6 +6,7 @@ #include #define M_NLCON 1 +#define PROVIDE_INITIAL_F_AND_NLCONSTR 0 static void fun(const double x[], double *f, double constr[], const void *data) { @@ -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); diff --git a/c/include/prima/prima.h b/c/include/prima/prima.h index e1e5754b67..6d75f016f6 100644 --- a/c/include/prima/prima.h +++ b/c/include/prima/prima.h @@ -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; diff --git a/c/lincoa_c.f90 b/c/lincoa_c.f90 index 3ae69b0508..612357c79e 100644 --- a/c/lincoa_c.f90 +++ b/c/lincoa_c.f90 @@ -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 @@ -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 @@ -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)) diff --git a/c/newuoa_c.f90 b/c/newuoa_c.f90 index 7585b55c30..2930fc1917 100644 --- a/c/newuoa_c.f90 +++ b/c/newuoa_c.f90 @@ -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 @@ -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. @@ -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)) diff --git a/c/prima.c b/c/prima.c index a1eafa9c80..4ba095856c 100644 --- a/c/prima.c +++ b/c/prima.c @@ -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 @@ -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 @@ -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); diff --git a/c/uobyqa_c.f90 b/c/uobyqa_c.f90 index 3983b7dc2c..d0534b90dd 100644 --- a/c/uobyqa_c.f90 +++ b/c/uobyqa_c.f90 @@ -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 @@ -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. @@ -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))