diff --git a/bin/runcutest b/bin/runcutest index 2650e67..eca2878 100755 --- a/bin/runcutest +++ b/bin/runcutest @@ -55,6 +55,9 @@ Initialize_Settings() { # PRECISION = single (single precision), = double (double precision) PRECISION="double" + # PSUFFIX = _s (single precision), = (double precision) + PSUFFIX="" + # KEEP = 0 (discard f load module after use), = 1 (keep it) let KEEP=0 @@ -152,6 +155,8 @@ Parse_Arguments() { shift ;; -sp|--single) PRECISION="single" + PSUFFIX="_s" + sd_opts=( ${sd_opts[@]} "-sp" ) ;; -h|--help) Display_Usage exit 0 @@ -220,11 +225,11 @@ Decode_Problem() { # Temporary working dir is passed as argument #2 cd $2 ${RM} ${EXEC}/run_${PACKAGE} - ${RM} ELFUN.f GROUP.f RANGE.f EXTER.f - ${RM} ELFUN.o GROUP.o RANGE.o EXTER.o + ${RM} ${FUNSF} ${FUNSO} if [[ ${SIFDECODE+set} == 'set' ]]; then - echo "sifdecoder -A ${ARCH} -st ${START} ${sd_opts[@]} $1" - ${SIFDECODE}/bin/sifdecoder -A ${ARCH} ${sd_opts[@]} $1 + command="${SIFDECODE}/bin/sifdecoder -A ${ARCH} ${sd_opts[@]} $1" + (( show_commands )) && echo $command + $command cd - 2>&1 >/dev/null [[ $? != 0 ]] && exit $? else @@ -277,7 +282,7 @@ Clean_Up() { # Tidy up the current directory, deleting all junk. if (( KEEP == 0 )); then ${RM} ${EXEC}/run_${PACKAGE} - ${RM} ELFUN.o GROUP.o RANGE.o EXTER.o + ${RM} ${FUNSO} fi } @@ -345,6 +350,11 @@ if (( show_config )); then echo "Working in $WorkingDir" fi +# Record problem-specfic functions and object files + +FUNSF="ELFUN${PSUFFIX}.f GROUP${PSUFFIX}.f RANGE${PSUFFIX}.f EXTER${PSUFFIX}.f" +FUNSO="ELFUN${PSUFFIX}.o GROUP${PSUFFIX}.o RANGE${PSUFFIX}.o EXTER${PSUFFIX}.o" + # Decode problem if required (( problem_set )) && Decode_Problem ${PROBLEM} $WorkingDir @@ -389,7 +399,8 @@ if [[ ! -e ${LIBDIR}/libcutest.a ]]; then [[ -w $LIBDIR ]] && let writable=1 || let writable=0 if (( writable )); then cd ${LIBDIR} - ${MAKE} -s -f ${CUTEST}/makefiles/${ARCH} cutest_silent + ${MAKE} -s -f ${CUTEST}/makefiles/${ARCH} \ + PRECIS=$(PRECISION) cutest_silent cd ${WorkingDir} else error "${LIBDIR}/libcutest.a does not exist and @@ -402,7 +413,7 @@ fi [[ -w ${CUTEST}/objects ]] && let writable=1 || let writable=0 if (( writable )); then cd ${CUTEST}/src/${PKG} - ${MAKE} -s -f ${CUTEST}/makefiles/${ARCH} tools ${PKG} + ${MAKE} -s -f ${CUTEST}/makefiles/${ARCH} PRECIS=${PRECISION} tools ${PKG} else warning "You do not have write permissions to ${CUTEST}/objects Attempting to continue..." @@ -427,10 +438,12 @@ if [[ ${SPECS} != "" ]]; then fi fi +FUNSO="ELFUN${PSUFFIX}.o GROUP${PSUFFIX}.o RANGE${PSUFFIX}.o" + # Ensure that the current test problem has been compiled. (( OUTPUT )) && printf '\nCompiling current test problem if necessary ...\n' -(( RECOMPILE )) && ${RM} ELFUN.o GROUP.o RANGE.o EXTER.o -for i in ELFUN GROUP RANGE +(( RECOMPILE )) && ${RM} ${FUNSO} +for i in ELFUN${PSUFFIX} GROUP${PSUFFIX} RANGE${PSUFFIX} do if [[ ! -e ${i}.o ]]; then ${CP} ${i}.f ${i}.f90 @@ -442,16 +455,16 @@ do fi done -EXTER="" -[[ -e EXTER.f && ! -s EXTER.f ]] && ${RM} EXTER.f -if [[ -e EXTER.f ]]; then - ${CP} EXTER.f EXTER.f90 - command="${FORTRAN} ${PROBFLAGS} EXTER.f90" +[[ -e EXTER${PSUFFIX}.f && ! -s EXTER${PSUFFIX}.f ]] && ${RM} EXTER${PSUFFIX}.f +if [[ -e EXTER${PSUFFIX}.f ]]; then + ${CP} EXTER${PSUFFIX}.f EXTER${PSUFFIX}.f90 + command="${FORTRAN} ${PROBFLAGS} EXTER${PSUFFIX}.f90" (( show_commands )) && echo $command $command [[ $? != 0 ]] && exit $? - ${RM} EXTER.f90 - [[ -e EXTER.o && -z EXTER.o ]] && ${RM} EXTER.o || EXTER="EXTER.o" + ${RM} EXTER${PSUFFIX}.f90 + [[ -e EXTER${PSUFFIX}.o && -z EXTER${PSUFFIX}.o ]] \ + && ${RM} EXTER${PSUFFIX}.o || FUNSO="${FUNSO} EXTER${PSUFFIX}.o" fi # The package-dependent object files are either fully in full-specified @@ -460,7 +473,8 @@ PACKOBJS=( ${PACKOBJS} ) nobjs=${#PACKOBJS[@]} for (( i = 0; i < nobjs ; i++ )) do - [[ ! -e ${PACKOBJS[$i]} ]] && PACKOBJS[$i]=${CUTEST}/objects/${ARCH}/${PRECISION}/${PACKOBJS[$i]} + [[ ! -e ${PACKOBJS[$i]} ]] && \ + PACKOBJS[$i]=${CUTEST}/objects/${ARCH}/${PRECISION}/${PACKOBJS[$i]} done cd ${WorkingDir} @@ -477,7 +491,9 @@ if [[ ${PKG} == "matlab" ]]; then fi (( OUTPUT )) && printf '\nBuilding MEX file ...\n' outputName=mcutest - command="${MEXFORTRAN} -cxx -I${CUTEST}/include -output ${outputName} ${CUTEST}/objects/${ARCH}/${PRECISION}/mcutest.o ELFUN.o GROUP.o RANGE.o ${EXTER} -L${LIBDIR} -lcutest ${ALT_LIB_PATH[@]} ${BLAS} ${LAPACK} ${PACKLIBS} -lgfortran -g" + command="${MEXFORTRAN} -cxx -I${CUTEST}/include -output ${outputName} \ +${CUTEST}/objects/${ARCH}/${PRECISION}/mcutest.o ${FUNSO} -L${LIBDIR} \ +-lcutest ${ALT_LIB_PATH[@]} ${BLAS} ${LAPACK} ${PACKLIBS} -lgfortran -g" (( show_commands )) && echo "$command" $command Run_Post @@ -490,8 +506,10 @@ elif [[ ${PKG} == "octave" ]]; then exit 11 fi (( OUTPUT )) && printf '\nBuilding MEX file ...\n' - outputName=mcutest - command="${MEXFORTRAN} --mex -I${CUTEST}/include --output ${outputName} ${CUTEST}/objects/${ARCH}/${PRECISION}/mcutest.o ELFUN.o GROUP.o RANGE.o ${EXTER} -L${LIBDIR} -lcutest ${ALT_LIB_PATH[@]} ${BLAS} ${LAPACK} ${PACKLIBS} -g" + outputName=ocutest + command="${MEXFORTRAN} --mex -I${CUTEST}/include --output ${outputName} \ +${CUTEST}/objects/${ARCH}/${PRECISION}/ocutest.o ${FUNSO} \ +-L${LIBDIR} -lcutest ${ALT_LIB_PATH[@]} ${BLAS} ${LAPACK} ${PACKLIBS} -g" (( show_commands )) && echo "$command" $command Run_Post @@ -500,7 +518,10 @@ elif [[ ${PKG} == "octave" ]]; then elif [[ ${PKG} == "nomad" ]]; then # Link all the PACK and tools files together. (( OUTPUT )) && printf '\nLinking all the object files together ...\n' - command="${FORTRAN} ${FFLAGS} -o ${DRIVER} ELFUN.o GROUP.o RANGE.o ${EXTER} ${CUTEST}/objects/${ARCH}/${PRECISION}/${DRIVER}.o ${PACKOBJS[@]} ${ALT_LIB_PATH[@]} -L${LIBDIR} ${PACKLIBS} ${SPECIALLIBS} -lcutest ${XTRALIBS[*]} ${BLAS} ${LAPACK}" + command="${FORTRAN} ${FFLAGS} -o ${DRIVER} ${FUNSO} \ +${CUTEST}/objects/${ARCH}/${PRECISION}/${DRIVER}.o ${PACKOBJS[@]} \ +${ALT_LIB_PATH[@]} -L${LIBDIR} ${PACKLIBS} ${SPECIALLIBS} \ +-lcutest ${XTRALIBS[*]} ${BLAS} ${LAPACK}" (( show_commands )) && echo "$command" $command command="$CP $CUTEST/src/nomad/run_nomad ./" @@ -510,7 +531,10 @@ elif [[ ${PKG} == "nomad" ]]; then else # Link all the PACK and tools files together. (( OUTPUT )) && printf '\nLinking all the object files together ...\n' - command="${FORTRAN} ${FFLAGS} -o run_${PACKAGE} ELFUN.o GROUP.o RANGE.o ${EXTER} ${CUTEST}/objects/${ARCH}/${PRECISION}/${DRIVER}.o ${PACKOBJS[@]} ${ALT_LIB_PATH[@]} -L${LIBDIR} ${PACKLIBS} ${SPECIALLIBS} -lcutest ${XTRALIBS[*]} ${BLAS} ${LAPACK}" + command="${FORTRAN} ${FFLAGS} -o run_${PACKAGE} ${FUNSO} \ +${CUTEST}/objects/${ARCH}/${PRECISION}/${DRIVER}.o ${PACKOBJS[@]} \ +${ALT_LIB_PATH[@]} -L${LIBDIR} ${PACKLIBS} ${SPECIALLIBS} \ +-lcutest ${XTRALIBS[*]} ${BLAS} ${LAPACK}" (( show_commands )) && echo "$command" $command fi diff --git a/doc/pdf/sif.pdf b/doc/pdf/sif.pdf index 6717d06..a72ac3a 100644 Binary files a/doc/pdf/sif.pdf and b/doc/pdf/sif.pdf differ diff --git a/include/cg_user.h b/include/cg_user.h index 259433c..f0acd85 100644 --- a/include/cg_user.h +++ b/include/cg_user.h @@ -20,6 +20,14 @@ #define NULL 0 #endif +/* added by nick gould to allow single (float) precision */ + +#ifdef CUTEST_SINGLE +typedef float rp_; +#else +typedef double rp_; +#endif + /*============================================================================ cg_parameter is a structure containing parameters used in cg_descent cg_default assigns default values to these parameters */ @@ -56,25 +64,25 @@ typedef struct cg_parameter_struct /* user controlled parameters */ /* when relative distance from current gradient to subspace <= eta0, enter subspace if subspace dimension = mem */ - double eta0 ; + rp_ eta0 ; /* when relative distance from current gradient to subspace >= eta1, leave subspace */ - double eta1 ; + rp_ eta1 ; /* when relative distance from current direction to subspace <= eta2, always enter subspace (invariant space) */ - double eta2 ; + rp_ eta2 ; /* T => use approximate Wolfe line search F => use ordinary Wolfe line search, switch to approximate Wolfe when |f_k+1-f_k| < AWolfeFac*C_k, C_k = average size of cost */ int AWolfe ; - double AWolfeFac ; + rp_ AWolfeFac ; /* factor in [0, 1] used to compute average cost magnitude C_k as follows: Q_k = 1 + (Qdecay)Q_k-1, Q_0 = 0, C_k = C_k-1 + (|f_k| - C_k-1)/Q_k */ - double Qdecay ; + rp_ Qdecay ; /* terminate after nslow iterations without strict improvement in either function value or gradient */ @@ -84,41 +92,41 @@ typedef struct cg_parameter_struct /* user controlled parameters */ T => ||proj_grad||_infty <= max(grad_tol,initial ||grad||_infty*StopFact) F => ||proj_grad||_infty <= grad_tol*(1 + |f_k|) */ int StopRule ; - double StopFac ; + rp_ StopFac ; /* T => estimated error in function value is eps*Ck, F => estimated error in function value is eps */ int PertRule ; - double eps ; + rp_ eps ; /* factor by which eps grows when line search fails during contraction */ - double egrow ; + rp_ egrow ; /* T => attempt quadratic interpolation in line search when |f_k+1 - f_k|/f_k <= QuadCutoff F => no quadratic interpolation step */ int QuadStep ; - double QuadCutOff ; + rp_ QuadCutOff ; /* maximum factor by which a quad step can reduce the step size */ - double QuadSafe ; + rp_ QuadSafe ; /* T => when possible, use a cubic step in the line search */ int UseCubic ; /* use cubic step when |f_k+1 - f_k|/|f_k| > CubicCutOff */ - double CubicCutOff ; + rp_ CubicCutOff ; /* |f| < SmallCost*starting cost => skip QuadStep and set PertRule = FALSE*/ - double SmallCost ; + rp_ SmallCost ; /* T => check that f_k+1 - f_k <= debugtol*C_k F => no checking of function values */ int debug ; - double debugtol ; + rp_ debugtol ; /* if step is nonzero, it is the initial step of the initial line search */ - double step ; + rp_ step ; /* abort cg after maxit iterations */ INT maxit ; @@ -127,15 +135,15 @@ typedef struct cg_parameter_struct /* user controlled parameters */ int ntries ; /* maximum factor secant step increases stepsize in expansion phase */ - double ExpandSafe ; + rp_ ExpandSafe ; /* factor by which secant step is amplified during expansion phase where minimizer is bracketed */ - double SecantAmp ; + rp_ SecantAmp ; /* factor by which rho grows during expansion phase where minimizer is bracketed */ - double RhoGrow ; + rp_ RhoGrow ; /* maximum number of times that eps is updated */ int neps ; @@ -147,49 +155,49 @@ typedef struct cg_parameter_struct /* user controlled parameters */ int nline ; /* conjugate gradient method restarts after (n*restart_fac) iterations */ - double restart_fac ; + rp_ restart_fac ; /* stop when -alpha*dphi0 (estimated change in function value) <= feps*|f|*/ - double feps ; + rp_ feps ; /* after encountering nan, growth factor when searching for a bracketing interval */ - double nan_rho ; + rp_ nan_rho ; /* after encountering nan, decay factor for stepsize */ - double nan_decay ; + rp_ nan_decay ; /*============================================================================ technical parameters which the user probably should not touch ----------------------------------------------------------------------------*/ - double delta ; /* Wolfe line search parameter */ - double sigma ; /* Wolfe line search parameter */ - double gamma ; /* decay factor for bracket interval width */ - double rho ; /* growth factor when searching for initial + rp_ delta ; /* Wolfe line search parameter */ + rp_ sigma ; /* Wolfe line search parameter */ + rp_ gamma ; /* decay factor for bracket interval width */ + rp_ rho ; /* growth factor when searching for initial bracketing interval */ - double psi0 ; /* factor used in starting guess for iteration 1 */ - double psi_lo ; /* in performing a QuadStep, we evaluate at point + rp_ psi0 ; /* factor used in starting guess for iteration 1 */ + rp_ psi_lo ; /* in performing a QuadStep, we evaluate at point betweeen [psi_lo, psi_hi]*psi2*previous step */ - double psi_hi ; - double psi1 ; /* for approximate quadratic, use gradient at + rp_ psi_hi ; + rp_ psi1 ; /* for approximate quadratic, use gradient at psi1*psi2*previous step for initial stepsize */ - double psi2 ; /* when starting a new cg iteration, our initial + rp_ psi2 ; /* when starting a new cg iteration, our initial guess for the line search stepsize is psi2*previous step */ int AdaptiveBeta ; /* T => choose beta adaptively, F => use theta */ - double BetaLower ; /* lower bound factor for beta */ - double theta ; /* parameter describing the cg_descent family */ - double qeps ; /* parameter in cost error for quadratic restart + rp_ BetaLower ; /* lower bound factor for beta */ + rp_ theta ; /* parameter describing the cg_descent family */ + rp_ qeps ; /* parameter in cost error for quadratic restart criterion */ - double qrule ; /* parameter used to decide if cost is quadratic */ + rp_ qrule ; /* parameter used to decide if cost is quadratic */ int qrestart ; /* number of iterations the function should be nearly quadratic before a restart */ } cg_parameter ; typedef struct cg_stats_struct /* statistics returned to user */ { - double f ; /*function value at solution */ - double gnorm ; /* max abs component of gradient */ + rp_ f ; /*function value at solution */ + rp_ gnorm ; /* max abs component of gradient */ INT iter ; /* number of iterations */ INT IterSub ; /* number of subspace iterations */ INT NumSub ; /* total number subspaces */ @@ -214,17 +222,17 @@ int cg_descent /* return: 9 (debugger is on and the function value increases) 10 (out of memory) */ ( - double *x, /* input: starting guess, output: the solution */ + rp_ *x, /* input: starting guess, output: the solution */ INT n, /* problem dimension */ cg_stats *Stats, /* structure with statistics (see cg_descent.h) */ cg_parameter *UParm, /* user parameters, NULL = use default parameters */ - double grad_tol, /* StopRule = 1: |g|_infty <= max (grad_tol, + rp_ grad_tol, /* StopRule = 1: |g|_infty <= max (grad_tol, StopFac*initial |g|_infty) [default] StopRule = 0: |g|_infty <= grad_tol(1+|f|) */ - double (*value) (double *, INT), /* f = value (x, n) */ - void (*grad) (double *, double *, INT), /* grad (g, x, n) */ - double (*valgrad) (double *, double *, INT), /* f = valgrad (g,x,n)*/ - double *Work /* either size 4n work array or NULL */ + rp_ (*value) (rp_ *, INT), /* f = value (x, n) */ + void (*grad) (rp_ *, rp_ *, INT), /* grad (g, x, n) */ + rp_ (*valgrad) (rp_ *, rp_ *, INT), /* f = valgrad (g,x,n)*/ + rp_ *Work /* either size 4n work array or NULL */ ) ; void cg_default /* set default parameter values */ diff --git a/include/cutest.h b/include/cutest.h index adc1f83..0f5d2e3 100644 --- a/include/cutest.h +++ b/include/cutest.h @@ -12,6 +12,9 @@ * Nick Gould, CUTEst evolution, January 4 2013. * Boolean logicals provided, August 21 2013 * fortran intent(in) variables defined as const, Dec 2 2015 + * + * this version 2023-11-16 + * * ====================================================================== */ @@ -54,8 +57,26 @@ typedef int integer; typedef float real; typedef double doublereal; -typedef _Bool logical; -/* typedef bool logical; */ +/* typedef _Bool logical; */ +typedef bool logical; + +#ifdef CUTEST_SINGLE +typedef float rp_; +typedef float rpc_; +#else +typedef double rp_; +typedef double rpc_; +#endif + +#ifdef CUTEST_LONG +typedef long long ip_; +typedef long long ipc_; +#else +typedef int ip_; +typedef int ipc_; +#endif + + #define FALSE_ (0) /* Fortran FALSE */ #define TRUE_ (1) /* Fortran TRUE */ /* #define max(a,b) ((a)>(b)?(a):(b)) */ @@ -95,6 +116,7 @@ typedef struct VarTypes { #define CUTEST_ureport FUNDERSCORE(cutest_ureport) #define CUTEST_cdimen FUNDERSCORE(cutest_cdimen) +#define CUTEST_cnoobj FUNDERSCORE(cutest_cint_cnoobj) #define CUTEST_cdimsg FUNDERSCORE(cutest_cdimsg) #define CUTEST_cdimsj FUNDERSCORE(cutest_cdimsj) #define CUTEST_cdimsh FUNDERSCORE(cutest_cdimsh) @@ -170,6 +192,93 @@ typedef struct VarTypes { #define CUTEST_uterminate FUNDERSCORE(cutest_uterminate) #define CUTEST_cterminate FUNDERSCORE(cutest_cterminate) +#define CUTEST_usetup_s FUNDERSCORE(cutest_usetup_s) +#define CUTEST_csetup_s FUNDERSCORE(cutest_cint_csetup_s) + +#define CUTEST_udimen_s FUNDERSCORE(cutest_udimen_s) +#define CUTEST_udimsh_s FUNDERSCORE(cutest_udimsh_s) +#define CUTEST_udimse_s FUNDERSCORE(cutest_udimse_s) +#define CUTEST_uvartype_s FUNDERSCORE(cutest_uvartype_s) +#define CUTEST_unames_s FUNDERSCORE(cutest_unames_s) +#define CUTEST_ureport_s FUNDERSCORE(cutest_ureport_s) + +#define CUTEST_cdimen_s FUNDERSCORE(cutest_cdimen_s) +#define CUTEST_cnoobj_s FUNDERSCORE(cutest_cint_cnoobj_s) +#define CUTEST_cdimsg_s FUNDERSCORE(cutest_cdimsg_s) +#define CUTEST_cdimsj_s FUNDERSCORE(cutest_cdimsj_s) +#define CUTEST_cdimsh_s FUNDERSCORE(cutest_cdimsh_s) +#define CUTEST_cdimohp_s FUNDERSCORE(cutest_cdimohp_s) +#define CUTEST_cdimchp_s FUNDERSCORE(cutest_cdimchp_s) +#define CUTEST_cdimse_s FUNDERSCORE(cutest_cdimse_s) +#define CUTEST_cstats_s FUNDERSCORE(cutest_cstats_s) +#define CUTEST_cvartype_s FUNDERSCORE(cutest_cvartype_s) +#define CUTEST_cnames_s FUNDERSCORE(cutest_cnames_s) +#define CUTEST_creport_s FUNDERSCORE(cutest_creport_s) + +#define CUTEST_connames_s FUNDERSCORE(cutest_connames_s) +#define CUTEST_pname_s FUNDERSCORE(cutest_pname_s) +#define CUTEST_probname_s FUNDERSCORE(cutest_probname_s) +#define CUTEST_varnames_s FUNDERSCORE(cutest_varnames_s) + +#define CUTEST_ufn_s FUNDERSCORE(cutest_ufn_s) +#define CUTEST_ugr_s FUNDERSCORE(cutest_ugr_s) +#define CUTEST_uofg_s FUNDERSCORE(cutest_cint_uofg_s) +#define CUTEST_ubandh_s FUNDERSCORE(cutest_ubandh_s) +#define CUTEST_udh_s FUNDERSCORE(cutest_udh_s) +#define CUTEST_ushp_s FUNDERSCORE(cutest_ushp_s) +#define CUTEST_ush_s FUNDERSCORE(cutest_ush_s) +#define CUTEST_ueh_s FUNDERSCORE(cutest_cint_ueh_s) +#define CUTEST_ugrdh_s FUNDERSCORE(cutest_ugrdh_s) +#define CUTEST_ugrsh_s FUNDERSCORE(cutest_ugrsh_s) +#define CUTEST_ugreh_s FUNDERSCORE(cutest_cint_ugreh_s) +#define CUTEST_uhprod_s FUNDERSCORE(cutest_cint_uhprod_s) +#define CUTEST_ushprod_s FUNDERSCORE(cutest_cint_ushprod_s) + +#define CUTEST_cfn_s FUNDERSCORE(cutest_cfn_s) +#define CUTEST_const_s FUNDERSCORE(cutest_const_s) +#define CUTEST_cofg_s FUNDERSCORE(cutest_cint_cofg_s) +#define CUTEST_cofsg_s FUNDERSCORE(cutest_cint_cofsg_s) +#define CUTEST_ccfg_s FUNDERSCORE(cutest_cint_ccfg_s) +#define CUTEST_clfg_s FUNDERSCORE(cutest_cint_clfg_s) +#define CUTEST_cgr_s FUNDERSCORE(cutest_cint_cgr_s) +#define CUTEST_csgr_s FUNDERSCORE(cutest_cint_csgr_s) +#define CUTEST_csgrp_s FUNDERSCORE(cutest_cint_csgrp_s) +#define CUTEST_csjp_s FUNDERSCORE(cutest_cint_csjp_s) +#define CUTEST_ccfsg_s FUNDERSCORE(cutest_cint_ccfsg_s) +#define CUTEST_ccifg_s FUNDERSCORE(cutest_cint_ccifg_s) +#define CUTEST_ccifsg_s FUNDERSCORE(cutest_cint_ccifsg_s) +#define CUTEST_cgrdh_s FUNDERSCORE(cutest_cint_cgrdh_s) +#define CUTEST_cdh_s FUNDERSCORE(cutest_cdh_s) +#define CUTEST_cdhc_s FUNDERSCORE(cutest_cdhc_s) +#define CUTEST_cshp_s FUNDERSCORE(cutest_cshp_s) +#define CUTEST_csh_s FUNDERSCORE(cutest_csh_s) +#define CUTEST_cshc_s FUNDERSCORE(cutest_cshc_s) +#define CUTEST_cshj_s FUNDERSCORE(cutest_cshj_s) +#define CUTEST_ceh_s FUNDERSCORE(cutest_cint_ceh_s) +#define CUTEST_cifn_s FUNDERSCORE(cutest_cifn_s) +#define CUTEST_cigr_s FUNDERSCORE(cutest_cigr_s) +#define CUTEST_cisgr_s FUNDERSCORE(cutest_cisgr_s) +#define CUTEST_cisgrp_s FUNDERSCORE(cutest_cisgrp_s) +#define CUTEST_cidh_s FUNDERSCORE(cutest_cidh_s) +#define CUTEST_cish_s FUNDERSCORE(cutest_cish_s) +#define CUTEST_csgrsh_s FUNDERSCORE(cutest_cint_csgrsh_s) +#define CUTEST_csgrshp_s FUNDERSCORE(cutest_cint_csgrshp_s) +#define CUTEST_csgreh_s FUNDERSCORE(cutest_cint_csgreh_s) +#define CUTEST_chprod_s FUNDERSCORE(cutest_cint_chprod_s) +#define CUTEST_cshprod_s FUNDERSCORE(cutest_cint_chsprod_s) +#define CUTEST_chcprod_s FUNDERSCORE(cutest_cint_chcprod_s) +#define CUTEST_cshcprod_s FUNDERSCORE(cutest_cint_cshcprod_s) +#define CUTEST_chjprod_s FUNDERSCORE(cutest_cint_chjprod_s) +#define CUTEST_cjprod_s FUNDERSCORE(cutest_cint_cjprod_s) +#define CUTEST_csjprod_s FUNDERSCORE(cutest_cint_csjprod_s) +#define CUTEST_cchprods_s FUNDERSCORE(cutest_cint_cchprods_s) +#define CUTEST_cchprodsp_s FUNDERSCORE(cutest_cint_cchprodsp_s) +#define CUTEST_cohprods_s FUNDERSCORE(cutest_cint_cohprods_s) +#define CUTEST_cohprodsp_s FUNDERSCORE(cutest_cint_cohprodsp_s) + +#define CUTEST_uterminate_s FUNDERSCORE(cutest_uterminate_s) +#define CUTEST_cterminate_s FUNDERSCORE(cutest_cterminate_s) + #define FORTRAN_open FUNDERSCORE(fortran_open) #define FORTRAN_close FUNDERSCORE(fortran_close) @@ -204,6 +313,7 @@ void CUTEST_ureport ( integer *status, doublereal *calls, doublereal *time ); /* Constrained dimensioning and report routines */ void CUTEST_cdimen ( integer *status, const integer *funit, integer *n, integer *m ); +void CUTEST_cnoobj ( integer *status, const integer *funit, logical *noobj ); void CUTEST_cdimsg ( integer *status, integer *nnzg ); void CUTEST_cdimsj ( integer *status, integer *nnzj ); void CUTEST_cdimsh ( integer *status, integer *nnzh ); @@ -418,6 +528,249 @@ void CUTEST_cohprodsp( integer *status, integer *nnzohp, void CUTEST_uterminate( integer *status ); void CUTEST_cterminate( integer *status ); +/* Same for single precision versions */ + +/* Setup routines */ +void CUTEST_usetup_s ( integer *status, const integer *funit, + const integer *iout, const integer *io_buffer, + integer *n, real *x, real *bl, + real *bu ); +void CUTEST_csetup_s ( integer *status, const integer *funit, + const integer *iout, + const integer *io_buffer, integer *n, integer *m, + real *x, real *bl, real *bu, + real *v, real *cl, real *cu, + logical *equatn, logical *linear, const integer *e_order, + const integer *l_order, const integer *v_order ); + +/* Unconstrained dimensioning and report routines */ +void CUTEST_udimen_s ( integer *status, const integer *funit, integer *n ); +void CUTEST_udimsh_s ( integer *status, integer *nnzh ); +void CUTEST_udimse_s ( integer *status, integer *ne, integer *nzh, + integer *nzirnh ); +void CUTEST_uvartype_s( integer *status, const integer *n, integer *ivarty ); +void CUTEST_unames_s ( integer *status, const integer *n, char *pname, + char *vnames ); +void CUTEST_ureport_s ( integer *status, real *calls, real *time ); + +/* Constrained dimensioning and report routines */ +void CUTEST_cdimen_s ( integer *status, const integer *funit, integer *n, + integer *m ); +void CUTEST_cnoobj_s ( integer *status, const integer *funit, logical *noobj ); +void CUTEST_cdimsg_s ( integer *status, integer *nnzg ); +void CUTEST_cdimsj_s ( integer *status, integer *nnzj ); +void CUTEST_cdimsh_s ( integer *status, integer *nnzh ); +void CUTEST_cdimcop_s ( integer *status, integer *nnzohp ); +void CUTEST_cdimchp_s ( integer *status, integer *nnzchp ); +void CUTEST_cdimse_s ( integer *status, integer *ne, integer *nzh, + integer *nzirnh ); +void CUTEST_cstats_s ( integer *status, integer *nonlinear_variables_objective, + integer *nonlinear_variables_constraints, + integer *equality_constraints, + integer *linear_constraints ); +void CUTEST_cvartype_s( integer *status, const integer *n, integer *ivarty ); +void CUTEST_cnames_s ( integer *status, const integer *n, const integer *m, + char *pname, char *vnames, char *gnames ); +void CUTEST_creport_s ( integer *status, real *calls, real *time ); + +void CUTEST_connames_s( integer *status, const integer *m, char *gname ); +void CUTEST_pname_s ( integer *status, const integer *funit, char *pname ); +void CUTEST_probname_s( integer *status, char *pname ); +void CUTEST_varnames_s( integer *status, const integer *n, char *vname ); + +/* Unconstrained optimization routines */ +void CUTEST_ufn_s ( integer *status, const integer *n, const real *x, + real *f ); +void CUTEST_ugr_s ( integer *status, const integer *n, const real *x, + real *g ); +void CUTEST_uofg_s ( integer *status, const integer *n, const real *x, + real *f, real *g, const logical *grad ); +void CUTEST_udh_s ( integer *status, const integer *n, const real *x, + const integer *lh1, real *h ); +void CUTEST_ushp_s ( integer *status, const integer *n, integer *nnzh, + const integer *lh, integer *irnh, integer *icnh ); +void CUTEST_ush_s ( integer *status, const integer *n, const real *x, + integer *nnzh, const integer *lh, real *h, + integer *irnh, integer *icnh ); +void CUTEST_ueh_s ( integer *status, const integer *n, const real *x, + integer *ne, const integer *le, integer *iprnhi, + integer *iprhi, const integer *lirnhi, integer *irnhi, + const integer *lhi, real *hi, + const logical *byrows ); +void CUTEST_ugrdh_s ( integer *status, const integer *n, const real *x, + real *g, const integer *lh1, real *h); +void CUTEST_ugrsh_s ( integer *status, const integer *n, const real *x, + real *g, integer *nnzh, integer *lh, real *h, + integer *irnh, integer *icnh ); +void CUTEST_ugreh_s ( integer *status, const integer *n, const real *x, + real *g, integer *ne, const integer *le, + integer *iprnhi, integer *iprhi, const integer *lirnhi, + integer *irnhi, const integer *lhi, real *hi, + const logical *byrows ); +void CUTEST_uhprod_s ( integer *status, const integer *n, const logical *goth, + const real *x, const real *p, real *r ); +void CUTEST_ushprod_s ( integer *status, const integer *n, const logical *goth, + const real *x, const integer *nnzp, + const integer *indp, const real *p, + integer *nnzr, integer *indr, real *r ); +void CUTEST_ubandh_s ( integer *status, const integer *n, const real *x, + const integer *nsemib, real *bandh, + const integer *lbandh, integer *maxsbw ); + +/* Constrained optimization routines */ +void CUTEST_cfn_s ( integer *status, const integer *n, const integer *m, + const real *x, real *f, real *c ); +void CUTEST_cconst_s ( integer *status, const integer *m, real *c ); +void CUTEST_cofg_s ( integer *status, const integer *n, const real *x, + real *f, real *g, const logical *grad ); +void CUTEST_cofsg_s ( integer *status, const integer *n, const real *x, + real *f, integer *nnzg, const integer *lg, + real *sg, integer *ivsg, const logical *grad ); +void CUTEST_ccfg_s ( integer *status, const integer *n, const integer *m, + const real *x, real *c, const logical *jtrans, + const integer *lcjac1, const integer *lcjac2, + real *cjac, const logical *grad ); +void CUTEST_clfg_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, real *f, + real *g, const logical *grad ); +void CUTEST_cgr_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const logical *grlagf, real *g, + const logical *jtrans, const integer *lcjac1, + const integer *lcjac2, real *cjac ); +void CUTEST_csgr_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const logical *grlagf, integer *nnzj, + const integer *lcjac, real *cjac, + integer *indvar, integer *indfun ); +void CUTEST_csgrp_s ( integer *status, const integer *n, integer *nnzj, + const integer *lj, integer *jvar, integer *jcon ); +void CUTEST_csjp_s ( integer *status, integer *nnzj, const integer *lj, + integer *jvar, integer *jcon ); +void CUTEST_ccfsg_s ( integer *status, const integer *n, const integer *m, + const real *x, real *c, integer *nnzj, + const integer *lcjac, real *cjac, integer *indvar, + integer *indfun, const logical *grad ); +void CUTEST_ccifg_s ( integer *status, const integer *n, const integer *icon, + const real *x, real *ci, real *gci, + const logical *grad ); +void CUTEST_ccifsg_s ( integer *status, const integer *n, const integer *con, + const real *x, real *ci, integer *nnzsgc, + const integer *lsgci, real *sgci, integer *ivsgci, + const logical *grad ); +void CUTEST_cgrdh_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const logical *grlagf, real *g, + const logical *jtrans, const integer *lcjac1, + const integer *lcjac2, real *cjac, + const integer *lh1, real *h ); +void CUTEST_cdh_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const integer *lh1, real *h ); +void CUTEST_cdhc_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const integer *lh1, real *h ); +void CUTEST_cshp_s ( integer *status, const integer *n, integer *nnzh, + const integer *lh, integer *irnh, integer *icnh ); +void CUTEST_csh_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, integer *nnzh, + const integer *lh, real *h, integer *irnh, + integer *icnh ); +void CUTEST_cshc_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, integer *nnzh, + const integer *lh, real *h, + integer *irnh, integer *icnh ); +void CUTEST_cshj_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y0, + const real *y, integer *nnzh, + const integer *lh, real *h, + integer *irnh, integer *icnh ); +void CUTEST_ceh_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + integer *ne, const integer *le, integer *iprnhi, + integer *iprhi, const integer *lirnhi, integer *irnhi, + const integer *lhi, real *hi, + const logical *byrows ); +void CUTEST_cifn_s ( integer *status, const integer *n, const integer *iprob, + const real *x, real *f ); +void CUTEST_cigr_s ( integer *status, const integer *n, const integer *iprob, + const real *x, real *g ); +void CUTEST_cisgr_s ( integer *status, const integer *n, const integer *iprob, + const real *x, integer *nnzg, const integer *lg, + real *sg, integer *ivsg ); +void CUTEST_cisgrp_s ( integer *status, const integer *n, const integer *iprob, + integer *nnzg, const integer *lg, integer *ivsg ); +void CUTEST_cidh_s ( integer *status, const integer *n, const real *x, + const integer *iprob, const integer *lh1, real *h ); +void CUTEST_cish_s ( integer *status, const integer *n, const real *x, + const integer *iprob, integer *nnzh, const integer *lh, + real *h, integer *irnh, integer *icnh ); +void CUTEST_csgrsh_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const logical *grlagf, integer *nnzj, + const integer *lcjac, real *cjac, integer *indvar, + integer *indfun, integer *nnzh, const integer *lh, + real *h, integer *irnh, integer *icnh ); +void CUTEST_csgrshp_s ( integer *status, const integer *n, integer *nnzj, + const integer *lcjac, integer *indvar, + integer *indfun, integer *nnzh, const integer *lh, + integer *irnh, integer *icnh ); +void CUTEST_csgreh_s ( integer *status, const integer *n, const integer *m, + const real *x, const real *y, + const logical *grlagf, integer *nnzj, + const integer *lcjac, real *cjac, + integer *indvar, integer *indfun, + integer *ne, const integer *le, integer *iprnhi, + integer *iprhi, const integer *lirnhi, + integer *irnhi, const integer *lhi, real *hi, + const logical *byrows ); +void CUTEST_chprod_s ( integer *status, const integer *n, const integer *m, + const logical *goth, const real *x, + const real *y, real *p, real *q ); +void CUTEST_cshprod_s ( integer *status, const integer *n, const integer *m, + const logical *goth, const real *x, + const real *y, const integer *nnzp, + const integer *indp, const real *p, + integer *nnzr, integer *indr, real *r ); +void CUTEST_chcprod_s ( integer *status, const integer *n, const integer *m, + const logical *goth, const real *x, + const real *y, real *p, real *q ); +void CUTEST_cshcprod_s( integer *status, const integer *n, const integer *m, + const logical *goth, const real *x, + const real *y, integer *nnzp, integer *indp, + real *p, integer *nnzr, integer *indr, + real *r ); +void CUTEST_chjprod_s ( integer *status, const integer *n, const integer *m, + const logical *goth, const real *x, + const real *y0, + const real *y, real *p, real *q ); +void CUTEST_cjprod_s ( integer *status, const integer *n, const integer *m, + const logical *gotj, const logical *jtrans, + const real *x, const real *p, + const integer *lp, real *r, const integer *lr ); +void CUTEST_csjprod_s ( integer *status, const integer *n, const integer *m, + const logical *gotj, const logical *jtrans, + const real *x, const integer *nnzp, + const integer *indp, const real *p, + const integer *lp, integer *nnzr, + integer *indr, real *r, const integer *lr ); +void CUTEST_cchprods_s( integer *status, const integer *n, const integer *m, + const logical *goth, const real *x, + const real *p, const integer *lchp, + real *chpval, integer *chpind, integer *chpptr ); +void CUTEST_cchprodsp_s( integer *status, const integer *m, + const integer *lchp, integer *chpind, integer *chpptr ); +void CUTEST_cohprods_s( integer *status, const integer *n, + const logical *goth, const real *x, + const real *p, integer *nnzohp, const integer *lohp, + real *ohpval, integer *ohpind ); +void CUTEST_cohprodsp_s( integer *status, integer *nnzohp, + const integer *lohp, integer *chpind ); + +/* Termination routines */ +void CUTEST_uterminate_s( integer *status ); +void CUTEST_cterminate_s( integer *status ); + /* FORTRAN auxiliary subroutines to retrieve stream unit numbers */ void FORTRAN_open( const integer *funit, const char *fname, integer *ierr ); void FORTRAN_close( const integer *funit, integer *ierr ); diff --git a/include/cutest_routines_double.h b/include/cutest_routines_double.h index 1934f58..e6c81fd 100644 --- a/include/cutest_routines_double.h +++ b/include/cutest_routines_double.h @@ -8,13 +8,11 @@ */ #define ELFUN_r ELFUN +#define ELFUN_flexible_r ELFUN_flexible #define GROUP_r GROUP #define RANGE_r RANGE #define CUTEST_allocate_array_integer_r CUTEST_allocate_array_integer #define CUTEST_allocate_array_real_r CUTEST_allocate_array_real -#define CUTEST_assemble_element_hessian_r CUTEST_assemble_element_hessian -#define CUTEST_assemble_hessian_pattern_r CUTEST_assemble_hessian_pattern -#define CUTEST_assemble_hessian_r CUTEST_assemble_hessian #define CUTEST_ccfg_r CUTEST_ccfg #define CUTEST_ccfg_threaded_r CUTEST_ccfg_threaded #define CUTEST_ccfg_threadsafe_r CUTEST_ccfg_threadsafe @@ -129,6 +127,7 @@ #define CUTEST_clfg_threadsafe_r CUTEST_clfg_threadsafe #define CUTEST_cnames_r CUTEST_cnames #define CUTEST_cnames_threadsafe_r CUTEST_cnames_threadsafe +#define CUTEST_cnoobj_r CUTEST_cnoobj #define CUTEST_cofg_r CUTEST_cofg #define CUTEST_cofg_threaded_r CUTEST_cofg_threaded #define CUTEST_cofg_threadsafe_r CUTEST_cofg_threadsafe @@ -191,11 +190,7 @@ #define CUTEST_cvartype_threadsafe_r CUTEST_cvartype_threadsafe #define CUTEST_extend_array_integer_r CUTEST_extend_array_integer #define CUTEST_extend_array_real_r CUTEST_extend_array_real -#define CUTEST_form_gradients_r CUTEST_form_gradients -#define CUTEST_hessian_times_sp_vector_r CUTEST_hessian_times_sp_vector -#define CUTEST_hessian_times_vector_r CUTEST_hessian_times_vector #define CUTEST_initialize_thread_r CUTEST_initialize_thread -#define CUTEST_initialize_workspace_r CUTEST_initialize_workspace #define CUTEST_LQP_create_r CUTEST_LQP_create #define CUTEST_newthread_threadsafe_r CUTEST_newthread_threadsafe #define CUTEST_pname_r CUTEST_pname @@ -204,8 +199,6 @@ #define CUTEST_probname_r CUTEST_probname #define CUTEST_probname_threadsafe_r CUTEST_probname_threadsafe #define CUTEST_reorder_by_rows_r CUTEST_reorder_by_rows -#define CUTEST_size_element_hessian_r CUTEST_size_element_hessian -#define CUTEST_size_sparse_hessian_r CUTEST_size_sparse_hessian #define CUTEST_sparse_hessian_by_rows_r CUTEST_sparse_hessian_by_rows #define CUTEST_symmh_r CUTEST_symmh #define CUTEST_terminate_data_r CUTEST_terminate_data diff --git a/include/cutest_routines_single.h b/include/cutest_routines_single.h index a2901b5..9ce0630 100644 --- a/include/cutest_routines_single.h +++ b/include/cutest_routines_single.h @@ -8,13 +8,11 @@ */ #define ELFUN_r ELFUN_s +#define ELFUN_flexible_r ELFUN_flexible_s #define GROUP_r GROUP_s #define RANGE_r RANGE_s #define CUTEST_allocate_array_integer_r CUTEST_allocate_array_integer_s #define CUTEST_allocate_array_real_r CUTEST_allocate_array_real_s -#define CUTEST_assemble_element_hessian_r CUTEST_assemble_element_hessian_s -#define CUTEST_assemble_hessian_pattern_r CUTEST_assemble_hessian_pattern_s -#define CUTEST_assemble_hessian_r CUTEST_assemble_hessian_s #define CUTEST_ccfg_r CUTEST_ccfg_s #define CUTEST_ccfg_threaded_r CUTEST_ccfg_threaded_s #define CUTEST_ccfg_threadsafe_r CUTEST_ccfg_threadsafe_s @@ -129,6 +127,7 @@ #define CUTEST_clfg_threadsafe_r CUTEST_clfg_threadsafe_s #define CUTEST_cnames_r CUTEST_cnames_s #define CUTEST_cnames_threadsafe_r CUTEST_cnames_threadsafe_s +#define CUTEST_cnoobj_r CUTEST_cnoobj_s #define CUTEST_cofg_r CUTEST_cofg_s #define CUTEST_cofg_threaded_r CUTEST_cofg_threaded_s #define CUTEST_cofg_threadsafe_r CUTEST_cofg_threadsafe_s @@ -191,11 +190,7 @@ #define CUTEST_cvartype_threadsafe_r CUTEST_cvartype_threadsafe_s #define CUTEST_extend_array_integer_r CUTEST_extend_array_integer_s #define CUTEST_extend_array_real_r CUTEST_extend_array_real_s -#define CUTEST_form_gradients_r CUTEST_form_gradients_s -#define CUTEST_hessian_times_sp_vector_r CUTEST_hessian_times_sp_vector_s -#define CUTEST_hessian_times_vector_r CUTEST_hessian_times_vector_s #define CUTEST_initialize_thread_r CUTEST_initialize_thread_s -#define CUTEST_initialize_workspace_r CUTEST_initialize_workspace_s #define CUTEST_LQP_create_r CUTEST_LQP_create_s #define CUTEST_newthread_threadsafe_r CUTEST_newthread_threadsafe_s #define CUTEST_pname_r CUTEST_pname_s @@ -204,8 +199,6 @@ #define CUTEST_probname_r CUTEST_probname_s #define CUTEST_probname_threadsafe_r CUTEST_probname_threadsafe_s #define CUTEST_reorder_by_rows_r CUTEST_reorder_by_rows_s -#define CUTEST_size_element_hessian_r CUTEST_size_element_hessian_s -#define CUTEST_size_sparse_hessian_r CUTEST_size_sparse_hessian_s #define CUTEST_sparse_hessian_by_rows_r CUTEST_sparse_hessian_by_rows_s #define CUTEST_symmh_r CUTEST_symmh_s #define CUTEST_terminate_data_r CUTEST_terminate_data_s diff --git a/include/osqp/auxil.h b/include/osqp/auxil.h index 5575157..3c7a5d7 100644 --- a/include/osqp/auxil.h +++ b/include/osqp/auxil.h @@ -1,17 +1,17 @@ #ifndef AUXIL_H -# define AUXIL_H +#define AUXIL_H -# ifdef __cplusplus +#ifdef __cplusplus extern "C" { -# endif // ifdef __cplusplus +#endif /* ifdef __cplusplus */ -# include "types.h" +#include "types.h" /*********************************************************** * Auxiliary functions needed to compute ADMM iterations * * ***********************************************************/ -# if EMBEDDED != 1 +#if EMBEDDED != 1 /** * Compute rho estimate from residuals @@ -42,7 +42,7 @@ void set_rho_vec(OSQPWorkspace *work); */ c_int update_rho_vec(OSQPWorkspace *work); -# endif // EMBEDDED +#endif /* EMBEDDED */ /** * Swap c_float vector pointers @@ -149,7 +149,7 @@ c_int check_termination(OSQPWorkspace *work, c_int approximate); -# ifndef EMBEDDED +#ifndef EMBEDDED /** * Validate problem data @@ -166,11 +166,11 @@ c_int validate_data(const OSQPData *data); */ c_int validate_settings(const OSQPSettings *settings); -# endif // #ifndef EMBEDDED +#endif /* #ifndef EMBEDDED */ -# ifdef __cplusplus +#ifdef __cplusplus } -# endif // ifdef __cplusplus +#endif /* ifdef __cplusplus */ -#endif // ifndef AUXIL_H +#endif /* ifndef AUXIL_H */ diff --git a/include/osqp/glob_opts.h b/include/osqp/glob_opts.h index 201e29b..33d4a62 100644 --- a/include/osqp/glob_opts.h +++ b/include/osqp/glob_opts.h @@ -1,49 +1,49 @@ #ifndef GLOB_OPTS_H -# define GLOB_OPTS_H +#define GLOB_OPTS_H -# ifdef __cplusplus +#ifdef __cplusplus extern "C" { -# endif /* ifdef __cplusplus */ +#endif +/* ifdef __cplusplus */ /* Define OSQP compiler flags */ -// Operative system +/* Operative system */ #define IS_LINUX /* #undef IS_MAC */ /* #undef IS_WINDOWS */ -// EMBEDDED +/* EMBEDDED */ /* #undef EMBEDDED */ -// PRINTING +/* PRINTING */ #define PRINTING -// PROFILING +/* PROFILING */ #define PROFILING -// CTRLC +/* CTRLC */ #define CTRLC -// DFLOAT +/* DFLOAT */ /* #undef DFLOAT */ -// DLONG +/* DLONG */ #define DLONG -// ENABLE_MKL_PARDISO +/* ENABLE_MKL_PARDISO */ #define ENABLE_MKL_PARDISO - /* DATA CUSTOMIZATIONS (depending on memory manager)----------------------- */ -// We do not need memory allocation functions if EMBEDDED is enabled -# ifndef EMBEDDED +/* We do not need memory allocation functions if EMBEDDED is enabled */ +#ifndef EMBEDDED /* define custom printfs and memory allocation (e.g. matlab or python) */ -# ifdef MATLAB - # include "mex.h" +#ifdef MATLAB +#include "mex.h" static void* c_calloc(size_t num, size_t size) { void *m = mxCalloc(num, size); @@ -65,16 +65,16 @@ static void* c_realloc(void *ptr, size_t size) { return m; } - # define c_free mxFree -# elif defined PYTHON +#define c_free mxFree +#elif defined PYTHON -// Define memory allocation for python. Note that in Python 2 memory manager -// Calloc is not implemented - # include - # define c_malloc PyMem_Malloc - # if PY_MAJOR_VERSION >= 3 - # define c_calloc PyMem_Calloc - # else /* if PY_MAJOR_VERSION >= 3 */ +/* Define memory allocation for python. Note that in Python 2 memory manager */ +/* Calloc is not implemented */ +#include +#define c_malloc PyMem_Malloc +#if PY_MAJOR_VERSION >= 3 +#define c_calloc PyMem_Calloc +#else /* if PY_MAJOR_VERSION >= 3 */ static void* c_calloc(size_t num, size_t size) { void *m = PyMem_Malloc(num * size); @@ -82,136 +82,136 @@ static void* c_calloc(size_t num, size_t size) { return m; } - # endif /* if PY_MAJOR_VERSION >= 3 */ +#endif /* if PY_MAJOR_VERSION >= 3 */ -// #define c_calloc(n,s) ({ -// void * p_calloc = c_malloc((n)*(s)); -// memset(p_calloc, 0, (n)*(s)); -// p_calloc; -// }) - # define c_free PyMem_Free - # define c_realloc PyMem_Realloc -# else /* ifdef MATLAB */ - # define c_malloc malloc - # define c_calloc calloc - # define c_free free - # define c_realloc realloc -# endif /* ifdef MATLAB */ +/* #define c_calloc(n,s) ({ */ +/* void * p_calloc = c_malloc((n)*(s)); */ +/* memset(p_calloc, 0, (n)*(s)); */ +/* p_calloc; */ +/* }) */ +#define c_free PyMem_Free +#define c_realloc PyMem_Realloc +#else /* ifdef MATLAB */ +#define c_malloc malloc +#define c_calloc calloc +#define c_free free +#define c_realloc realloc +#endif /* ifdef MATLAB */ -# include +#include -# endif // end EMBEDDED +#endif /* end EMBEDDED */ /* Use customized number representation ----------------------------------- */ -# ifdef DLONG // long integers +#ifdef DLONG /* long integers */ typedef long long c_int; /* for indices */ -# else // standard integers +#else /* standard integers */ typedef int c_int; /* for indices */ -# endif /* ifdef DLONG */ +#endif /* ifdef DLONG */ -# ifndef DFLOAT // Doubles +#ifndef DFLOAT /* Doubles */ typedef double c_float; /* for numerical values */ -# else // Floats +#else /* Floats */ typedef float c_float; /* for numerical values */ -# endif /* ifndef DFLOAT */ +#endif /* ifndef DFLOAT */ /* Use customized constants ----------------------------------------------- */ -# ifndef OSQP_NULL -# define OSQP_NULL 0 -# endif /* ifndef OSQP_NULL */ +#ifndef OSQP_NULL +#define OSQP_NULL 0 +#endif /* ifndef OSQP_NULL */ -# ifndef OSQP_NAN -# define OSQP_NAN ((c_float)0x7ff8000000000000) // Not a Number -# endif /* ifndef OSQP_NAN */ +#ifndef OSQP_NAN +#define OSQP_NAN ((c_float)0x7ff8000000000000) /* Not a Number */ +#endif /* ifndef OSQP_NAN */ -# ifndef OSQP_INFTY -# define OSQP_INFTY ((c_float)1e20) // Infinity -# endif /* ifndef OSQP_INFTY */ +#ifndef OSQP_INFTY +#define OSQP_INFTY ((c_float)1e20) /* Infinity */ +#endif /* ifndef OSQP_INFTY */ /* Use customized operations */ -# ifndef c_absval -# define c_absval(x) (((x) < 0) ? -(x) : (x)) -# endif /* ifndef c_absval */ +#ifndef c_absval +#define c_absval(x) (((x) < 0) ? -(x) : (x)) +#endif /* ifndef c_absval */ -# ifndef c_max -# define c_max(a, b) (((a) > (b)) ? (a) : (b)) -# endif /* ifndef c_max */ +#ifndef c_max +#define c_max(a, b) (((a) > (b)) ? (a) : (b)) +#endif /* ifndef c_max */ -# ifndef c_min -# define c_min(a, b) (((a) < (b)) ? (a) : (b)) -# endif /* ifndef c_min */ +#ifndef c_min +#define c_min(a, b) (((a) < (b)) ? (a) : (b)) +#endif /* ifndef c_min */ -// Round x to the nearest multiple of N -# ifndef c_roundmultiple -# define c_roundmultiple(x, N) ((x) + .5 * (N)-c_fmod((x) + .5 * (N), (N))) -# endif /* ifndef c_roundmultiple */ +/* Round x to the nearest multiple of N */ +#ifndef c_roundmultiple +#define c_roundmultiple(x, N) ((x) + .5 * (N)-c_fmod((x) + .5 * (N), (N))) +#endif /* ifndef c_roundmultiple */ /* Use customized functions ----------------------------------------------- */ -# if EMBEDDED != 1 - -# include -# ifndef DFLOAT // Doubles -# define c_sqrt sqrt -# define c_fmod fmod -# else // Floats -# define c_sqrt sqrtf -# define c_fmod fmodf -# endif /* ifndef DFLOAT */ - -# endif // end EMBEDDED - - -# ifdef PRINTING -# include -# include - -# ifdef MATLAB -# define c_print mexPrintf - -// The following trick slows down the performance a lot. Since many solvers -// actually -// call mexPrintf and immediately force print buffer flush -// otherwise messages don't appear until solver termination -// ugly because matlab does not provide a vprintf mex interface -// #include -// static int c_print(char *msg, ...) -// { -// va_list argList; -// va_start(argList, msg); -// //message buffer -// int bufferSize = 256; -// char buffer[bufferSize]; -// vsnprintf(buffer,bufferSize-1, msg, argList); -// va_end(argList); -// int out = mexPrintf(buffer); //print to matlab display -// mexEvalString("drawnow;"); // flush matlab print buffer -// return out; -// } -# elif defined PYTHON -# include -# define c_print PySys_WriteStdout -# else /* ifdef MATLAB */ -# define c_print printf -# endif /* ifdef MATLAB */ - -// Print error macro -// #define c_eprint(desc...) (c_print("ERROR in %s: ", __FUNCTION__); c_print -// (stderr, desc); c_print("\n");) -# define c_eprint(...) c_print("ERROR in %s: ", __FUNCTION__); c_print( \ +#if EMBEDDED != 1 + +#include +#ifndef DFLOAT /* Doubles */ +#define c_sqrt sqrt +#define c_fmod fmod +#else /* Floats */ +#define c_sqrt sqrtf +#define c_fmod fmodf +#endif /* ifndef DFLOAT */ + +#endif /* end EMBEDDED */ + + +#ifdef PRINTING +#include +#include + +#ifdef MATLAB +#define c_print mexPrintf + +/* The following trick slows down the performance a lot. Since many solvers */ +/* actually */ +/* call mexPrintf and immediately force print buffer flush */ +/* otherwise messages don't appear until solver termination */ +/* ugly because matlab does not provide a vprintf mex interface */ +/* #include */ +/* static int c_print(char *msg, ...) */ +/* { */ +/* va_list argList; */ +/* va_start(argList, msg); */ +/* //message buffer */ +/* int bufferSize = 256; */ +/* char buffer[bufferSize]; */ +/* vsnprintf(buffer,bufferSize-1, msg, argList); */ +/* va_end(argList); */ +/* int out = mexPrintf(buffer); //print to matlab display */ +/* mexEvalString("drawnow;"); // flush matlab print buffer */ +/* return out; */ +/* } */ +#elif defined PYTHON +#include +#define c_print PySys_WriteStdout +#else /* ifdef MATLAB */ +#define c_print printf +#endif /* ifdef MATLAB */ + +/* Print error macro */ +/* #define c_eprint(desc...) (c_print("ERROR in %s: ", __FUNCTION__); c_print */ +/* (stderr, desc); c_print("\n");) */ +#define c_eprint(...) c_print("ERROR in %s: ", __FUNCTION__); c_print( \ __VA_ARGS__); c_print("\n"); -# endif /* ifdef PRINTING */ +#endif /* ifdef PRINTING */ -# ifdef __cplusplus +#ifdef __cplusplus } -# endif /* ifdef __cplusplus */ +#endif /* ifdef __cplusplus */ #endif /* ifndef GLOB_OPTS_H */ diff --git a/include/osqp/osqp.h b/include/osqp/osqp.h index 4e6c862..7bba0bd 100644 --- a/include/osqp/osqp.h +++ b/include/osqp/osqp.h @@ -1,19 +1,22 @@ #ifndef OSQP_H -# define OSQP_H +#define OSQP_H -# ifdef __cplusplus +#ifdef __cplusplus extern "C" { -# endif // ifdef __cplusplus +#endif +/* ifdef __cplusplus */ /* Includes */ -# include "types.h" -# include "util.h" // Needed for osqp_set_default_settings functions +#include "types.h" +#include "util.h" +/* Needed for osqp_set_default_settings functions */ -// Library to deal with sparse matrices enabled only if embedded not defined -# ifndef EMBEDDED -# include "cs.h" -# endif // ifndef EMBEDDED +/* Library to deal with sparse matrices enabled only if embedded not defined */ +#ifndef EMBEDDED +#include "cs.h" +#endif +/* ifndef EMBEDDED */ /******************** * Main Solver API * @@ -32,7 +35,7 @@ extern "C" { void osqp_set_default_settings(OSQPSettings *settings); -# ifndef EMBEDDED +#ifndef EMBEDDED /** * Initialize OSQP solver allocating memory. @@ -57,7 +60,7 @@ void osqp_set_default_settings(OSQPSettings *settings); OSQPWorkspace* osqp_setup(const OSQPData *data, OSQPSettings *settings); -# endif // #ifndef EMBEDDED +#endif /* #ifndef EMBEDDED */ /** * Solve quadratic program @@ -78,7 +81,7 @@ OSQPWorkspace* osqp_setup(const OSQPData *data, c_int osqp_solve(OSQPWorkspace *work); -# ifndef EMBEDDED +#ifndef EMBEDDED /** * Cleanup workspace by deallocating memory @@ -89,7 +92,7 @@ c_int osqp_solve(OSQPWorkspace *work); */ c_int osqp_cleanup(OSQPWorkspace *work); -# endif // ifndef EMBEDDED +#endif /* ifndef EMBEDDED */ /** @} */ @@ -179,7 +182,7 @@ c_int osqp_warm_start_y(OSQPWorkspace *work, c_float *y); -# if EMBEDDED != 1 +#if EMBEDDED != 1 /** * Update elements of matrix P (upper-diagonal) @@ -264,7 +267,7 @@ c_int osqp_update_P_A(OSQPWorkspace *work, c_int osqp_update_rho(OSQPWorkspace *work, c_float rho_new); -# endif // if EMBEDDED != 1 +#endif /* if EMBEDDED != 1 */ /** @} */ @@ -364,7 +367,7 @@ c_int osqp_update_check_termination(OSQPWorkspace *work, c_int check_termination_new); -# ifndef EMBEDDED +#ifndef EMBEDDED /** * Update regularization parameter in polish @@ -406,9 +409,9 @@ c_int osqp_update_verbose(OSQPWorkspace *work, c_int verbose_new); -# endif // #ifndef EMBEDDED +#endif /* #ifndef EMBEDDED */ -# ifdef PROFILING +#ifdef PROFILING /** * Update time_limit setting @@ -418,13 +421,13 @@ c_int osqp_update_verbose(OSQPWorkspace *work, */ c_int osqp_update_time_limit(OSQPWorkspace *work, c_float time_limit_new); -# endif // ifdef PROFILING +#endif /* ifdef PROFILING */ /** @} */ -# ifdef __cplusplus +#ifdef __cplusplus } -# endif // ifdef __cplusplus +#endif /* ifdef __cplusplus */ -#endif // ifndef OSQP_H +#endif /* ifndef OSQP_H */ diff --git a/include/osqp/types.h b/include/osqp/types.h index c899770..ede17ec 100644 --- a/include/osqp/types.h +++ b/include/osqp/types.h @@ -3,7 +3,7 @@ # ifdef __cplusplus extern "C" { -# endif // ifdef __cplusplus +# endif /* ifdef __cplusplus */ # include "glob_opts.h" # include "constants.h" @@ -18,7 +18,7 @@ extern "C" { */ typedef struct { c_int nzmax; ///< maximum number of entries. - c_int m; ///< number of rows + c_int m; //< number of rows c_int n; ///< number of columns c_int *p; ///< column pointers (size n+1) (col indices (size nzmax) // start from 0 when using triplet format (direct KKT matrix diff --git a/include/osqp/util.h b/include/osqp/util.h index 1820753..60cc601 100644 --- a/include/osqp/util.h +++ b/include/osqp/util.h @@ -1,12 +1,12 @@ #ifndef UTIL_H -# define UTIL_H +#define UTIL_H -# ifdef __cplusplus +#ifdef __cplusplus extern "C" { -# endif // ifdef __cplusplus +#endif /* ifdef __cplusplus */ -# include "types.h" -# include "constants.h" +#include "types.h" +#include "constants.h" /****************** * Versioning * @@ -23,7 +23,7 @@ const char* osqp_version(void); * Utility Functions * **********************/ -# ifndef EMBEDDED +#ifndef EMBEDDED /** * Copy settings creating a new settings structure (uses MALLOC) @@ -32,7 +32,7 @@ const char* osqp_version(void); */ OSQPSettings* copy_settings(OSQPSettings *settings); -# endif // #ifndef EMBEDDED +#endif /* #ifndef EMBEDDED */ /** * Custom string copy to avoid string.h library @@ -43,7 +43,7 @@ void c_strcpy(char dest[], const char source[]); -# ifdef PRINTING +#ifdef PRINTING /** * Print Header before running the algorithm @@ -77,7 +77,7 @@ void print_footer(OSQPInfo *info, c_int polish); -# endif // ifdef PRINTING +#endif /* ifdef PRINTING */ /********************************* @@ -86,12 +86,12 @@ void print_footer(OSQPInfo *info, /*! \cond PRIVATE */ -# ifdef PROFILING +#ifdef PROFILING -// Windows -# ifdef IS_WINDOWS +/* Windows */ +#ifdef IS_WINDOWS -# include +#include struct OSQP_TIMER { LARGE_INTEGER tic; @@ -99,10 +99,10 @@ struct OSQP_TIMER { LARGE_INTEGER freq; }; -// Mac -# elif defined IS_MAC +/* Mac */ +#elif defined IS_MAC -# include +#include /* Use MAC OSX mach_time for timing */ struct OSQP_TIMER { @@ -111,12 +111,12 @@ struct OSQP_TIMER { mach_timebase_info_data_t tinfo; }; -// Linux -# else // ifdef IS_WINDOWS +/* Linux */ +#else /* ifdef IS_WINDOWS */ /* Use POSIX clocl_gettime() for timing on non-Windows machines */ -# include -# include +#include +#include struct OSQP_TIMER { @@ -124,7 +124,7 @@ struct OSQP_TIMER { struct timespec toc; }; -# endif // ifdef IS_WINDOWS +#endif /* ifdef IS_WINDOWS */ /*! \endcond */ @@ -145,7 +145,7 @@ void tic(OSQPTimer *t); */ c_float toc(OSQPTimer *t); -# endif /* END #ifdef PROFILING */ +#endif /* END #ifdef PROFILING */ /* ================================= DEBUG FUNCTIONS ======================= */ @@ -153,7 +153,7 @@ c_float toc(OSQPTimer *t); /*! \cond PRIVATE */ -# ifndef EMBEDDED +#ifndef EMBEDDED /* Compare CSC matrices */ c_int is_eq_csc(csc *A, @@ -163,11 +163,11 @@ c_int is_eq_csc(csc *A, /* Convert sparse CSC to dense */ c_float* csc_to_dns(csc *M); -# endif // #ifndef EMBEDDED +#endif /* #ifndef EMBEDDED */ -# ifdef PRINTING -# include +#ifdef PRINTING +#include /* Print a csc sparse matrix */ @@ -198,18 +198,18 @@ void dump_vec(c_float *v, c_int len, const char *file_name); -// Print int array +/* Print int array */ void print_vec_int(c_int *x, c_int n, const char *name); -# endif // ifdef PRINTING +#endif /* ifdef PRINTING */ /*! \endcond */ -# ifdef __cplusplus +#ifdef __cplusplus } -# endif // ifdef __cplusplus +#endif /* ifdef __cplusplus */ -#endif // ifndef UTIL_H +#endif /* ifndef UTIL_H */ diff --git a/man/man3/cutest_ccfg.3 b/man/man3/cutest_ccfg.3 index fe35ec4..8525797 100644 --- a/man/man3/cutest_ccfg.3 +++ b/man/man3/cutest_ccfg.3 @@ -7,6 +7,12 @@ possibly gradients. .SH SYNOPSIS .HP 1i CALL CUTEST_ccfg( status, n, m, X, C, jtrans, lj1, lj2, J_val, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccfg_s( ... ) .SH DESCRIPTION The CUTEST_ccfg subroutine evaluates the values of the constraint functions of the problem decoded from a SIF file by the script \fIsifdecoder\fP at the diff --git a/man/man3/cutest_ccfg_threaded.3 b/man/man3/cutest_ccfg_threaded.3 index 818d270..15160f8 100644 --- a/man/man3/cutest_ccfg_threaded.3 +++ b/man/man3/cutest_ccfg_threaded.3 @@ -8,6 +8,12 @@ possibly their gradients. .HP 1i CALL CUTEST_ccfg_threaded( status, n, m, X, C, jtrans, lj1, lj2, J_val, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccfg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ccfg_threaded subroutine evaluates the values of the constraint functions of diff --git a/man/man3/cutest_ccfsg.3 b/man/man3/cutest_ccfsg.3 index fb6a3f6..7ca73f1 100644 --- a/man/man3/cutest_ccfsg.3 +++ b/man/man3/cutest_ccfsg.3 @@ -7,6 +7,12 @@ possibly their gradients in sparse format. .HP 1i CALL CUTEST_ccfsg( status, n, m, X, C, nnzj, lj, J_val, J_var, J_fun, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccfsg_s( ... ) .SH DESCRIPTION The CUTEST_ccfsg subroutine evaluates the values of the constraint functions of the problem decoded from a SIF file by the script \fIsifdecoder\fP diff --git a/man/man3/cutest_ccfsg_threaded.3 b/man/man3/cutest_ccfsg_threaded.3 index 6b51217..711bb11 100644 --- a/man/man3/cutest_ccfsg_threaded.3 +++ b/man/man3/cutest_ccfsg_threaded.3 @@ -7,6 +7,12 @@ and possibly their gradients in sparse format. .HP 1i CALL CUTEST_ccfsg_threaded( status, n, m, X, C, nnzj, lj, J_val, J_var, J_fun, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccfsg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ccfsg_threaded subroutine evaluates the values of the constraint functions of diff --git a/man/man3/cutest_cchprods.3 b/man/man3/cutest_cchprods.3 index db6f33a..cd0661e 100644 --- a/man/man3/cutest_cchprods.3 +++ b/man/man3/cutest_cchprods.3 @@ -7,6 +7,12 @@ with each of the Hessian matrices of the constraint functions. .HP 1i CALL CUTEST_cchprods( status, n, m, goth, X, Y, VECTOR, lchp, CHP_val, CHP_ind, CHP_ptr ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cchprods_s( ... ) .SH DESCRIPTION The CUTEST_cchprods subroutine forms the product of a vector with each of the Hessian matrices of the constraint functions diff --git a/man/man3/cutest_cchprods_threaded.3 b/man/man3/cutest_cchprods_threaded.3 index 0bf729c..5566451 100644 --- a/man/man3/cutest_cchprods_threaded.3 +++ b/man/man3/cutest_cchprods_threaded.3 @@ -7,6 +7,12 @@ of a vector with each of the Hessian matrices of the constraint functions. .HP 1i CALL CUTEST_cchprods_threaded( status, n, m, goth, X, Y, VECTOR, lchp, CHP_val, CHP_ind, CHP_ptr, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cchprods_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cchprods_threaded subroutine forms the product of a vector with each of the Hessian matrix of the constraint functions diff --git a/man/man3/cutest_cchprodsp.3 b/man/man3/cutest_cchprodsp.3 index 9a43f1e..8372e16 100644 --- a/man/man3/cutest_cchprodsp.3 +++ b/man/man3/cutest_cchprodsp.3 @@ -7,6 +7,12 @@ with each of the Hessian matrices of the constraint functions. .SH SYNOPSIS .HP 1i CALL CUTEST_cchprodsp( status, n, m, lchp, CHP_ind, CHP_ptr ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cchprodsp_s( ... ) .SH DESCRIPTION The CUTEST_cchprodsp subroutine obtins the sparsity structure used when forming the product of a vector with each of diff --git a/man/man3/cutest_ccifg.3 b/man/man3/cutest_ccifg.3 index bc3d01f..85f4440 100644 --- a/man/man3/cutest_ccifg.3 +++ b/man/man3/cutest_ccifg.3 @@ -6,6 +6,12 @@ possibly its gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_ccifg( status, n, icon, X, ci, GCI_val, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccifg_s( ... ) .SH DESCRIPTION The CUTEST_ccifg subroutine evaluates the value of a particular constraint function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ccifg_threaded.3 b/man/man3/cutest_ccifg_threaded.3 index d1e5098..aa17aec 100644 --- a/man/man3/cutest_ccifg_threaded.3 +++ b/man/man3/cutest_ccifg_threaded.3 @@ -6,6 +6,12 @@ value and possibly its gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_ccifg_threaded( status, n, icon, X, ci, GCI_val, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccifg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ccifg_threaded subroutine evaluates the value of a particular constraint function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ccifsg.3 b/man/man3/cutest_ccifsg.3 index 416c3ec..557566e 100644 --- a/man/man3/cutest_ccifsg.3 +++ b/man/man3/cutest_ccifsg.3 @@ -7,6 +7,12 @@ possibly gradient in sparse format. .HP 1i CALL CUTEST_ccifsg( status, n, icon, X, ci, nnzgci, lgci, GCI_val, GCI_var, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccifsg_s( ... ) .SH DESCRIPTION The CUTEST_ccifsg subroutine evaluates the value of a particular constraint function of the problem decoded from a SIF file by the script \fIsifdecoder\fP at the point X, and diff --git a/man/man3/cutest_ccifsg_threaded.3 b/man/man3/cutest_ccifsg_threaded.3 index 1538e68..e6ca770 100644 --- a/man/man3/cutest_ccifsg_threaded.3 +++ b/man/man3/cutest_ccifsg_threaded.3 @@ -7,6 +7,12 @@ value and possibly gradient in sparse format. .HP 1i CALL CUTEST_ccifsg_threaded( status, n, icon, X, ci, nnzgci, lgci, GCI_val, GCI_var, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ccifsg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ccifsg_threaded subroutine evaluates the value of a particular constraint function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_cdh.3 b/man/man3/cutest_cdh.3 index cc5da06..7ce4f98 100644 --- a/man/man3/cutest_cdh.3 +++ b/man/man3/cutest_cdh.3 @@ -5,6 +5,12 @@ CUTEST_cdh \- CUTEst tool to evaluate the Hessian of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_cdh( status, n, m, X, Y, lh1, H_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdh_s( ... ) .SH DESCRIPTION The CUTEST_cdh subroutine evaluates the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_cdh_threaded.3 b/man/man3/cutest_cdh_threaded.3 index 52ebef9..1ebcad6 100644 --- a/man/man3/cutest_cdh_threaded.3 +++ b/man/man3/cutest_cdh_threaded.3 @@ -5,6 +5,12 @@ CUTEST_cdh_threaded \- CUTEst tool to evaluate the Hessian of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_cdh_threaded( status, n, m, X, Y, lh1, H_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cdh_threaded subroutine evaluates the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_cdhc.3 b/man/man3/cutest_cdhc.3 index 8d21d09..3466d96 100644 --- a/man/man3/cutest_cdhc.3 +++ b/man/man3/cutest_cdhc.3 @@ -6,6 +6,12 @@ the Hessian of the constraint part of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_cdhc( status, n, m, X, Y, lh1, H_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdhc_s( ... ) .SH DESCRIPTION The CUTEST_cdhc subroutine evaluates the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_cdhc_threaded.3 b/man/man3/cutest_cdhc_threaded.3 index 57e77ca..eba34a5 100644 --- a/man/man3/cutest_cdhc_threaded.3 +++ b/man/man3/cutest_cdhc_threaded.3 @@ -6,6 +6,12 @@ the Hessian of the constraint part of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_cdhc_threaded( status, n, m, X, Y, lh1, H_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdhc_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cdhc_threaded subroutine evaluates the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_cdimchp.3 b/man/man3/cutest_cdimchp.3 index f16869a..0dfb5cc 100644 --- a/man/man3/cutest_cdimchp.3 +++ b/man/man3/cutest_cdimchp.3 @@ -8,6 +8,12 @@ SIF file by the script \fIsifdecoder\fP. .SH SYNOPSIS .HP 1i CALL CUTEST_cdimchp( status, nnzchp ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimchp_s( ... ) .SH DESCRIPTION The CUTEST_cdimchp subroutine determines the number of nonzero elements required to store the products of the Hessian matrices of the constraint diff --git a/man/man3/cutest_cdimen.3 b/man/man3/cutest_cdimen.3 index 3bc8593..a621f56 100644 --- a/man/man3/cutest_cdimen.3 +++ b/man/man3/cutest_cdimen.3 @@ -7,6 +7,12 @@ involved. .SH SYNOPSIS .HP 1i CALL CUTEST_cdimen( status, input, n, m ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimen_s( ... ) .SH DESCRIPTION The CUTEST_cdimen subroutine discovers how many variables and constraints are involved in the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_cdimohp.3 b/man/man3/cutest_cdimohp.3 index e53fdea..cc121e4 100644 --- a/man/man3/cutest_cdimohp.3 +++ b/man/man3/cutest_cdimohp.3 @@ -8,6 +8,12 @@ SIF file by the script \fIsifdecoder\fP. .SH SYNOPSIS .HP 1i CALL CUTEST_cdimohp( status, nnzohp ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimohp_s( ... ) .SH DESCRIPTION The CUTEST_cdimohp subroutine determines the number of nonzero elements required to store the product of the Hessian matrix of the objective diff --git a/man/man3/cutest_cdimse.3 b/man/man3/cutest_cdimse.3 index 157b26c..4868619 100644 --- a/man/man3/cutest_cdimse.3 +++ b/man/man3/cutest_cdimse.3 @@ -5,6 +5,12 @@ CUTEST_cdimse \- CUTEst tool to determine the number of nonzeros required to store the Hessian of the Lagrangian. .SH SYNOPSIS CALL CUTEST_cdimse( status, ne, he_val_ne, he_row_ne ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimse_s( ... ) .SH DESCRIPTION The CUTEST_cdimse subroutine determines the number of nonzero elements required to store the Hessian matrix of the Lagrangian function for diff --git a/man/man3/cutest_cdimsg.3 b/man/man3/cutest_cdimsg.3 index 976810e..b17e75f 100644 --- a/man/man3/cutest_cdimsg.3 +++ b/man/man3/cutest_cdimsg.3 @@ -7,6 +7,12 @@ decoded from a SIF file by the script \fIsifdecoder\fP. .SH SYNOPSIS .HP 1i CALL CUTEST_cdimsg( status, nnzg ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimsg_s( ... ) .SH DESCRIPTION The CUTEST_cdimsg subroutine determines the number of nonzero elements required to store the gradient of the objective function for diff --git a/man/man3/cutest_cdimsh.3 b/man/man3/cutest_cdimsh.3 index 2b0ab60..a653e4a 100644 --- a/man/man3/cutest_cdimsh.3 +++ b/man/man3/cutest_cdimsh.3 @@ -7,6 +7,12 @@ SIF file by the script \fIsifdecoder\fP. .SH SYNOPSIS .HP 1i CALL CUTEST_cdimsh( status, nnzh ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimsh_s( ... ) .SH DESCRIPTION The CUTEST_cdimsh subroutine determines the number of nonzero elements required to store the Hessian matrix of the Lagrangian function for diff --git a/man/man3/cutest_cdimsj.3 b/man/man3/cutest_cdimsj.3 index 1103815..fccdd92 100644 --- a/man/man3/cutest_cdimsj.3 +++ b/man/man3/cutest_cdimsj.3 @@ -8,6 +8,12 @@ sparse format. .SH SYNOPSIS .HP 1i CALL CUTEST_cdimsj( status, nnzj ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cdimsj_s( ... ) .SH DESCRIPTION The CUTEST_cdimsj subroutine determines the number of nonzero elements required to store the matrix of gradients of the objective function diff --git a/man/man3/cutest_ceh.3 b/man/man3/cutest_ceh.3 index ae008aa..528c837 100644 --- a/man/man3/cutest_ceh.3 +++ b/man/man3/cutest_ceh.3 @@ -8,6 +8,12 @@ finite element format. CALL CUTEST_ceh( status, n, m, X, Y, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ceh_s( ... ) .SH DESCRIPTION The CUTEST_ceh subroutine evaluates the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_ceh_threaded.3 b/man/man3/cutest_ceh_threaded.3 index 2af0f2d..bd4cbd0 100644 --- a/man/man3/cutest_ceh_threaded.3 +++ b/man/man3/cutest_ceh_threaded.3 @@ -8,6 +8,12 @@ matrix in finite element format. CALL CUTEST_ceh_threaded( status, n, m, X, Y, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ceh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ceh_threaded subroutine evaluates the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_cfn.3 b/man/man3/cutest_cfn.3 index 7eb121f..2266ca6 100644 --- a/man/man3/cutest_cfn.3 +++ b/man/man3/cutest_cfn.3 @@ -5,6 +5,12 @@ CUTEST_cfn \- CUTEst tool to evaluate function and constraints values. .SH SYNOPSIS .HP 1i CALL CUTEST_cfn( status, n, m, X, f, C ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cfn_s( ... ) .SH DESCRIPTION The CUTEST_cfn subroutine evaluates the value of the objective function and general constraint functions of the problem decoded from a SIF file by diff --git a/man/man3/cutest_cfn_threaded.3 b/man/man3/cutest_cfn_threaded.3 index f67cffe..237c7cb 100644 --- a/man/man3/cutest_cfn_threaded.3 +++ b/man/man3/cutest_cfn_threaded.3 @@ -5,6 +5,12 @@ CUTEST_cfn_threaded \- CUTEst tool to evaluate function and constraints values. .SH SYNOPSIS .HP 1i CALL CUTEST_cfn_threaded( status, n, m, X, f, C, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cfn_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cfn_threaded subroutine evaluates the value of the objective function and diff --git a/man/man3/cutest_cgr.3 b/man/man3/cutest_cgr.3 index 5ad2837..3effe5e 100644 --- a/man/man3/cutest_cgr.3 +++ b/man/man3/cutest_cgr.3 @@ -7,6 +7,12 @@ objective/Lagrangian function. .HP 1i CALL CUTEST_cgr( status, n, m, X, Y, grlagf, G, jtrans, lj1, lj2, J_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cgr_s( ... ) .SH DESCRIPTION The CUTEST_cgr subroutine evaluates the gradients of the general constraints and of either the objective function diff --git a/man/man3/cutest_cgr_threaded.3 b/man/man3/cutest_cgr_threaded.3 index 622f7a8..52d60b7 100644 --- a/man/man3/cutest_cgr_threaded.3 +++ b/man/man3/cutest_cgr_threaded.3 @@ -7,6 +7,12 @@ gradient of objective/Lagrangian function. .HP 1i CALL CUTEST_cgr_threaded( status, n, m, X, Y, grlagf, G, jtrans, lj1, lj2, J_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cgr_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cgr_threaded subroutine evaluates the gradients of the general constraints and of either the objective function diff --git a/man/man3/cutest_cgrdh.3 b/man/man3/cutest_cgrdh.3 index d83e387..1c35f2e 100644 --- a/man/man3/cutest_cgrdh.3 +++ b/man/man3/cutest_cgrdh.3 @@ -7,6 +7,12 @@ Lagrangian function and gradient of objective/Lagrangian function. .HP 1i CALL CUTEST_cgrdh( status, n, m, X, Y, grlagf, G, jtrans, lj1, lj2, J_val, lh1, H_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cgrdh_s( ... ) .SH DESCRIPTION The CUTEST_cgrdh subroutine evaluates the gradients of the general constraints and of either the objective function diff --git a/man/man3/cutest_cgrdh_threaded.3 b/man/man3/cutest_cgrdh_threaded.3 index 8a0965e..dfcabb0 100644 --- a/man/man3/cutest_cgrdh_threaded.3 +++ b/man/man3/cutest_cgrdh_threaded.3 @@ -7,6 +7,12 @@ Hessian of Lagrangian function and gradient of objective/Lagrangian function. .HP 1i CALL CUTEST_cgrdh_threaded( status, n, m, X, Y, grlagf, G, jtrans, lj1, lj2, J_val, lh1, H_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cgrdh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cgrdh_threaded subroutine evaluates the gradients of the general constraints and of either the objective function diff --git a/man/man3/cutest_chcprod.3 b/man/man3/cutest_chcprod.3 index 7350719..eaa02b6 100644 --- a/man/man3/cutest_chcprod.3 +++ b/man/man3/cutest_chcprod.3 @@ -6,6 +6,12 @@ the Hessian matrix of the constraint part of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_chcprod( status, n, m, goth, X, Y, VECTOR, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_chcprod_s( ... ) .SH DESCRIPTION The CUTEST_chcprod subroutine forms the product of a vector with the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_chcprod_threaded.3 b/man/man3/cutest_chcprod_threaded.3 index c097334..1f5ec94 100644 --- a/man/man3/cutest_chcprod_threaded.3 +++ b/man/man3/cutest_chcprod_threaded.3 @@ -6,6 +6,12 @@ a vector with the Hessian matrix of constraint part of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_chcprod_threaded( status, n, m, goth, X, Y, VECTOR, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_chcprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_chcprod_threaded subroutine forms the product of a vector with the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_chjprod.3 b/man/man3/cutest_chjprod.3 index 4999abf..b8958b3 100644 --- a/man/man3/cutest_chjprod.3 +++ b/man/man3/cutest_chjprod.3 @@ -6,6 +6,12 @@ the Hessian matrix of the John function. .SH SYNOPSIS .HP 1i CALL CUTEST_chjprod( status, n, m, goth, X, y0, Y, VECTOR, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_chjprod_s( ... ) .SH DESCRIPTION The CUTEST_chjprod subroutine forms the product of a vector with the Hessian matrix of the John function diff --git a/man/man3/cutest_chjprod_threaded.3 b/man/man3/cutest_chjprod_threaded.3 index 46b00bc..46409a8 100644 --- a/man/man3/cutest_chjprod_threaded.3 +++ b/man/man3/cutest_chjprod_threaded.3 @@ -6,6 +6,12 @@ vector with the Hessian matrix of the John function. .SH SYNOPSIS .HP 1i CALL CUTEST_chjprod_threaded( status, n, m, goth, X, y0, Y, VECTOR, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_chjprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_chjprod_threaded subroutine forms the product of a vector with the Hessian matrix of the John function diff --git a/man/man3/cutest_chprod.3 b/man/man3/cutest_chprod.3 index d47ba0d..887e880 100644 --- a/man/man3/cutest_chprod.3 +++ b/man/man3/cutest_chprod.3 @@ -6,6 +6,12 @@ the Hessian matrix of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_chprod( status, n, m, goth, X, Y, VECTOR, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_chprod_s( ... ) .SH DESCRIPTION The CUTEST_chprod subroutine forms the product of a vector with the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_chprod_threaded.3 b/man/man3/cutest_chprod_threaded.3 index f3583ed..11f9ae2 100644 --- a/man/man3/cutest_chprod_threaded.3 +++ b/man/man3/cutest_chprod_threaded.3 @@ -6,6 +6,12 @@ vector with the Hessian matrix of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_chprod_threaded( status, n, m, goth, X, Y, VECTOR, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_chprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_chprod_threaded subroutine forms the product of a vector with the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_cidh.3 b/man/man3/cutest_cidh.3 index fa7c2c1..9b31475 100644 --- a/man/man3/cutest_cidh.3 +++ b/man/man3/cutest_cidh.3 @@ -5,6 +5,12 @@ CUTEST_cidh \- CUTEst tool to evaluate the Hessian of a problem function. .SH SYNOPSIS .HP 1i CALL CUTEST_cidh( status, n, X, iprob, lh1, H_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cidh_s( ... ) .SH DESCRIPTION The CUTEST_cidh subroutine evaluates the Hessian matrix of either the objective function or a constraint function for the problem decoded diff --git a/man/man3/cutest_cidh_threaded.3 b/man/man3/cutest_cidh_threaded.3 index 48702b1..abdcdf4 100644 --- a/man/man3/cutest_cidh_threaded.3 +++ b/man/man3/cutest_cidh_threaded.3 @@ -6,6 +6,12 @@ function. .SH SYNOPSIS .HP 1i CALL CUTEST_cidh_threaded( status, n, X, iprob, lh1, H_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cidh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cidh_threaded subroutine evaluates the Hessian matrix of either the objective function or a constraint function for the problem decoded diff --git a/man/man3/cutest_cifn.3 b/man/man3/cutest_cifn.3 index 9973f2b..f5a7355 100644 --- a/man/man3/cutest_cifn.3 +++ b/man/man3/cutest_cifn.3 @@ -5,6 +5,12 @@ CUTEST_cifn \- CUTEst tool to evaluate a problem function value. .SH SYNOPSIS .HP 1i CALL CUTEST_cifn( status, n, iprob, X, fn ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cifn_s( ... ) .SH DESCRIPTION The CUTEST_cifn subroutine evaluates the value of either the objective function or a constraint function diff --git a/man/man3/cutest_cifn_threaded.3 b/man/man3/cutest_cifn_threaded.3 index b451881..9f8572b 100644 --- a/man/man3/cutest_cifn_threaded.3 +++ b/man/man3/cutest_cifn_threaded.3 @@ -5,6 +5,12 @@ CUTEST_cifn_threaded \- CUTEst tool to evaluate a problem function value. .SH SYNOPSIS .HP 1i CALL CUTEST_cifn_threaded( status, n, iprob, X, fn, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cifn_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cifn_threaded subroutine evaluates the value of either the objective function or a constraint function diff --git a/man/man3/cutest_cigr.3 b/man/man3/cutest_cigr.3 index c8bdc98..899b41b 100644 --- a/man/man3/cutest_cigr.3 +++ b/man/man3/cutest_cigr.3 @@ -5,6 +5,12 @@ CUTEST_cigr \- CUTEst tool to evaluate the gradient of a problem function. .SH SYNOPSIS .HP 1i CALL CUTEST_cigr( status, n, iprob, X, G_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cigr_s( ... ) .SH DESCRIPTION The CUTEST_cigr subroutine evaluates the gradient of either the objective function or a constraint function diff --git a/man/man3/cutest_cigr_threaded.3 b/man/man3/cutest_cigr_threaded.3 index 88e0dad..8a29555 100644 --- a/man/man3/cutest_cigr_threaded.3 +++ b/man/man3/cutest_cigr_threaded.3 @@ -5,6 +5,12 @@ CUTEST_cigr_threaded \- CUTEst tool to evaluate the gradient of a problem functi .SH SYNOPSIS .HP 1i CALL CUTEST_cigr_threaded( status, n, iprob, X, G_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cigr_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cigr_threaded subroutine evaluates the gradient of either the objective function or a constraint function diff --git a/man/man3/cutest_cisgr.3 b/man/man3/cutest_cisgr.3 index 3817320..f081d98 100644 --- a/man/man3/cutest_cisgr.3 +++ b/man/man3/cutest_cisgr.3 @@ -6,6 +6,12 @@ problem function in sparse format .SH SYNOPSIS .HP 1i CALL CUTEST_cisgr( status, n, iprob, X, nnzg, lg, G_val, G_var ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cisgr_s( ... ) .SH DESCRIPTION The CUTEST_cisgr subroutine evaluates the gradient of either the objective function or a constraint function diff --git a/man/man3/cutest_cisgr_threaded.3 b/man/man3/cutest_cisgr_threaded.3 index 8ef9068..7c324ab 100644 --- a/man/man3/cutest_cisgr_threaded.3 +++ b/man/man3/cutest_cisgr_threaded.3 @@ -6,6 +6,12 @@ problem function in sparse format .SH SYNOPSIS .HP 1i CALL CUTEST_cisgr_threaded( status, n, iprob, X, nnzg, lg, G_val, G_var, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cisgr_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cisgr_threaded subroutine evaluates the gradient of either the objective function or a constraint function diff --git a/man/man3/cutest_cisgrp.3 b/man/man3/cutest_cisgrp.3 index 05d9272..3ee7732 100644 --- a/man/man3/cutest_cisgrp.3 +++ b/man/man3/cutest_cisgrp.3 @@ -6,6 +6,12 @@ the gradient of a problem function. .SH SYNOPSIS .HP 1i CALL CUTEST_cisgrp( status, n, iprob, nnzg, lg, G_var ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cisgrp_s( ... ) .SH DESCRIPTION The CUTEST_cisgrp subroutine evaluates the sparsity pattern of the gradient of either the objective function or a constraint function diff --git a/man/man3/cutest_cish.3 b/man/man3/cutest_cish.3 index 66f6421..350662d 100644 --- a/man/man3/cutest_cish.3 +++ b/man/man3/cutest_cish.3 @@ -7,6 +7,12 @@ function, in sparse format. .HP 1i CALL CUTEST_cish( status, n, X, iprob, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cish_s( ... ) .SH DESCRIPTION The CUTEST_cish subroutine evaluates the Hessian of a particular constraint function or the objective function for the problem decoded diff --git a/man/man3/cutest_cish_threaded.3 b/man/man3/cutest_cish_threaded.3 index 79f24c1..06a5d3e 100644 --- a/man/man3/cutest_cish_threaded.3 +++ b/man/man3/cutest_cish_threaded.3 @@ -7,6 +7,12 @@ problem function, in sparse format. .HP 1i CALL CUTEST_cish_threaded( status, n, X, iprob, nnzh, lh, H_val, H_row, H_col, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cish_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cish_threaded subroutine evaluates the Hessian of a particular constraint function or the objective function for the problem decoded diff --git a/man/man3/cutest_cjprod.3 b/man/man3/cutest_cjprod.3 index 2afdb30..ba22534 100644 --- a/man/man3/cutest_cjprod.3 +++ b/man/man3/cutest_cjprod.3 @@ -8,6 +8,12 @@ the Jacobian of the constraints, or its transpose. .HP 1i CALL CUTEST_cjprod( status, n, m, gotj, jtrans, X, VECTOR, lvector, RESULT, lresult ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cjprod_s( ... ) .SH DESCRIPTION The CUTEST_cjprod subroutine forms the product of a vector with the Jacobian matrix, or with its transpose, of the constraint functions diff --git a/man/man3/cutest_cjprod_threaded.3 b/man/man3/cutest_cjprod_threaded.3 index 4df04bc..4188295 100644 --- a/man/man3/cutest_cjprod_threaded.3 +++ b/man/man3/cutest_cjprod_threaded.3 @@ -8,6 +8,12 @@ a vector with the Jacobian of the constraints, or its transpose. .HP 1i CALL CUTEST_cjprod_threaded( status, n, m, gotj, jtrans, X, VECTOR, lvector, RESULT, lresult, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cjprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cjprod_threaded subroutine forms the product of a vector with the Jacobian matrix, or with its transpose, of the constraint functions diff --git a/man/man3/cutest_clfg.3 b/man/man3/cutest_clfg.3 index 98fd42f..f61c71d 100644 --- a/man/man3/cutest_clfg.3 +++ b/man/man3/cutest_clfg.3 @@ -6,6 +6,12 @@ possibly gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_clfg( status, n, m, X, Y, f, G, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_clfg_s( ... ) .SH DESCRIPTION The CUTEST_clfg subroutine evaluates the value of the Lagrangian function .EQ diff --git a/man/man3/cutest_clfg_threaded.3 b/man/man3/cutest_clfg_threaded.3 index 2d5303f..67e4f43 100644 --- a/man/man3/cutest_clfg_threaded.3 +++ b/man/man3/cutest_clfg_threaded.3 @@ -6,6 +6,12 @@ nd possibly gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_clfg_threaded( status, n, m, X, Y, f, G, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_clfg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_clfg_threaded subroutine evaluates the value of the Lagrangian function diff --git a/man/man3/cutest_cnames.3 b/man/man3/cutest_cnames.3 index e44a409..81a3f0d 100644 --- a/man/man3/cutest_cnames.3 +++ b/man/man3/cutest_cnames.3 @@ -5,6 +5,12 @@ CUTEST_cnames \- CUTEst tool to obtain the names of the problem and its variable .SH SYNOPSIS .HP 1i CALL CUTEST_cnames( status, n, m, pname, VNAMES, CNAMES ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cnames_s( ... ) .SH DESCRIPTION The CUTEST_cnames subroutine obtains the names of the problem, its variables and general constraints. diff --git a/man/man3/cutest_cofg.3 b/man/man3/cutest_cofg.3 index a98c8a7..b4a9a0f 100644 --- a/man/man3/cutest_cofg.3 +++ b/man/man3/cutest_cofg.3 @@ -5,6 +5,12 @@ CUTEST_cofg \- CUTEst tool to evaluate function value and possibly gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_cofg( status, n, X, f, G, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cofg_s( ... ) .SH DESCRIPTION The CUTEST_cofg subroutine evaluates the value of the objective function of the problem decoded from a SIF file by the script \fIsifdecoder\fP diff --git a/man/man3/cutest_cofg_threaded.3 b/man/man3/cutest_cofg_threaded.3 index c6ede0e..96bf033 100644 --- a/man/man3/cutest_cofg_threaded.3 +++ b/man/man3/cutest_cofg_threaded.3 @@ -6,6 +6,12 @@ gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_cofg_threaded( status, n, X, f, G, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cofg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cofg_threaded subroutine evaluates the value of the objective function of diff --git a/man/man3/cutest_cofsg.3 b/man/man3/cutest_cofsg.3 index da3abfb..9245273 100644 --- a/man/man3/cutest_cofsg.3 +++ b/man/man3/cutest_cofsg.3 @@ -5,6 +5,12 @@ CUTEST_cofsg \- CUTEst tool to evaluate function value and possibly gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_cofsg( status, n, X, f, nnzg, lg, G_val, G_var, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cofsg_s( ... ) .SH DESCRIPTION The CUTEST_cofsg subroutine evaluates the value of the objective function of the problem decoded from a SIF file by the script \fIsifdecoder\fP diff --git a/man/man3/cutest_cofsg_threaded.3 b/man/man3/cutest_cofsg_threaded.3 index b022673..c0e5da0 100644 --- a/man/man3/cutest_cofsg_threaded.3 +++ b/man/man3/cutest_cofsg_threaded.3 @@ -6,6 +6,12 @@ gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_cofsg_threaded( status, n, X, f, nnzg, lg, G_val, G_var, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cofsg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cofsg_threaded subroutine evaluates the value of the objective function of diff --git a/man/man3/cutest_cohprods.3 b/man/man3/cutest_cohprods.3 index 46beee4..eee1549 100644 --- a/man/man3/cutest_cohprods.3 +++ b/man/man3/cutest_cohprods.3 @@ -6,6 +6,12 @@ with the Hessian matrix of the objective function. .SH SYNOPSIS .HP 1i CALL CUTEST_cohprods( status, n, goth, X, VECTOR, nnzohp, lohp, RESULT, IND ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cohprods_s( ... ) .SH DESCRIPTION The CUTEST_cohprods subroutine forms the product of a vector with the Hessian matrix of the objective function diff --git a/man/man3/cutest_cohprods_threaded.3 b/man/man3/cutest_cohprods_threaded.3 index f39575f..9efd89c 100644 --- a/man/man3/cutest_cohprods_threaded.3 +++ b/man/man3/cutest_cohprods_threaded.3 @@ -7,6 +7,12 @@ of a vector with the Hessian matrix of the objective function. .HP 1i CALL CUTEST_cohprods_threaded( status, goth, X, VECTOR, nnzohp, lohp, RESULT, IND, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cohprods_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cohprods_threaded subroutine forms the product of a vector with the Hessian matrix of the objective function diff --git a/man/man3/cutest_cohprodsp.3 b/man/man3/cutest_cohprodsp.3 index 5099024..e279be1 100644 --- a/man/man3/cutest_cohprodsp.3 +++ b/man/man3/cutest_cohprodsp.3 @@ -7,6 +7,12 @@ objective function. .SH SYNOPSIS .HP 1i CALL CUTEST_cohprodsp( status, nnzohp, lohp, IND ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cohprodsp_s( ... ) .SH DESCRIPTION The CUTEST_cohprodsp subroutine obtins the sparsity structure used when forming the product of a vector with the Hessian matrix of the objective diff --git a/man/man3/cutest_connames.3 b/man/man3/cutest_connames.3 index c2d32fd..42c5097 100644 --- a/man/man3/cutest_connames.3 +++ b/man/man3/cutest_connames.3 @@ -5,6 +5,12 @@ CUTEST_connames \- CUTEst tool to obtain the names of the problem constraints. .SH SYNOPSIS .HP 1i CALL CUTEST_connames( status, m, CNAMES ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_connames_s( ... ) .SH DESCRIPTION The CUTEST_connames subroutine obtains the names of the general constraints of the problem. diff --git a/man/man3/cutest_creport.3 b/man/man3/cutest_creport.3 index e3f4b58..dbff926 100644 --- a/man/man3/cutest_creport.3 +++ b/man/man3/cutest_creport.3 @@ -6,6 +6,12 @@ evaluation and CPU time used. .SH SYNOPSIS .HP 1i CALL CUTEST_creport( status, CALLS, TIME ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_creport_s( ... ) .SH DESCRIPTION The CUTEST_creport subroutine obtains statistics concerning function evaluation and CPU time used for constrained optimization in a standardized format. diff --git a/man/man3/cutest_creport_threaded.3 b/man/man3/cutest_creport_threaded.3 index 30851ce..24d526e 100644 --- a/man/man3/cutest_creport_threaded.3 +++ b/man/man3/cutest_creport_threaded.3 @@ -6,6 +6,12 @@ evaluation and CPU time used. .SH SYNOPSIS .HP 1i CALL CUTEST_creport_threaded( status, CALLS, TIME, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_creport_threaded_s( ... ) .SH DESCRIPTION The CUTEST_creport_threaded subroutine obtains statistics concerning function evaluation and CPU diff --git a/man/man3/cutest_csetup.3 b/man/man3/cutest_csetup.3 index 09954ab..facd2b2 100644 --- a/man/man3/cutest_csetup.3 +++ b/man/man3/cutest_csetup.3 @@ -8,6 +8,12 @@ minimization. CALL CUTEST_csetup( status, input, out, io_buffer, n, m, X, X_l, X_u, Y, C_l, C_u, EQUATN, LINEAR, e_order, l_order, v_order ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csetup_s( ... ) .SH DESCRIPTION The CUTEST_csetup subroutine sets up the correct data structures for subsequent computations on the problem decoded from a SIF file by diff --git a/man/man3/cutest_csetup_threaded.3 b/man/man3/cutest_csetup_threaded.3 index 8ab1122..eed0e0d 100644 --- a/man/man3/cutest_csetup_threaded.3 +++ b/man/man3/cutest_csetup_threaded.3 @@ -8,6 +8,12 @@ minimization. CALL CUTEST_csetup_threaded( status, input, out, threads, IO_BUFFERS, n, m, X, X_l, X_u, Y, C_l, C_u, EQUATN, LINEAR, e_order, l_order, v_order ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csetup_threaded_s( ... ) .SH DESCRIPTION The CUTEST_csetup_threaded subroutine sets up the correct data structures for subsequent threaded computations on the problem decoded from a SIF file by diff --git a/man/man3/cutest_csgr.3 b/man/man3/cutest_csgr.3 index 453c505..9d1b16a 100644 --- a/man/man3/cutest_csgr.3 +++ b/man/man3/cutest_csgr.3 @@ -7,6 +7,12 @@ objective/Lagrangian function. .HP 1i CALL CUTEST_csgr( status, n, m, X, Y, grlagf, nnzj, lj, J_val, J_var, J_fun ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgr_s( ... ) .SH DESCRIPTION The CUTEST_csgr subroutine evaluates the gradients of the general constraints and of either the objective function or the Lagrangian function diff --git a/man/man3/cutest_csgr_threaded.3 b/man/man3/cutest_csgr_threaded.3 index 060d494..bdbeaec 100644 --- a/man/man3/cutest_csgr_threaded.3 +++ b/man/man3/cutest_csgr_threaded.3 @@ -7,6 +7,12 @@ gradient of objective/Lagrangian function. .HP 1i CALL CUTEST_csgr_threaded( status, n, m, X, Y, grlagf, nnzj, lj, J_val, J_var, J_fun, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgr_threaded_s( ... ) .SH DESCRIPTION The CUTEST_csgr_threaded subroutine evaluates the gradients of the general constraints and of either the objective function or the Lagrangian function diff --git a/man/man3/cutest_csgreh.3 b/man/man3/cutest_csgreh.3 index 39eff8a..d6c259f 100644 --- a/man/man3/cutest_csgreh.3 +++ b/man/man3/cutest_csgreh.3 @@ -9,6 +9,12 @@ the objective/Lagrangian in sparse format. CALL CUTEST_csgreh( status, n, m, X, Y, grlagf, nnzj, lj, J_val, J_var, J_fun, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgreh_s( ... ) .SH DESCRIPTION The CUTEST_csgreh subroutine evaluates both the gradients of the general constraint functions and diff --git a/man/man3/cutest_csgreh_threaded.3 b/man/man3/cutest_csgreh_threaded.3 index 81a3d0d..c45830a 100644 --- a/man/man3/cutest_csgreh_threaded.3 +++ b/man/man3/cutest_csgreh_threaded.3 @@ -10,6 +10,12 @@ CALL CUTEST_csgreh_threaded( status, n, m, X, Y, grlagf, nnzj, lj, J_val, J_var, J_fun, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgreh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_csgreh_threaded subroutine evaluates both the gradients of the general constraint functions and diff --git a/man/man3/cutest_csgrp.3 b/man/man3/cutest_csgrp.3 index eba058f..417af75 100644 --- a/man/man3/cutest_csgrp.3 +++ b/man/man3/cutest_csgrp.3 @@ -6,6 +6,12 @@ constraints gradients and gradient of objective/Lagrangian function. .SH SYNOPSIS .HP 1i CALL CUTEST_csgrp( status, n, nnzj, lj, J_var, J_fun ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgrp_s( ... ) .SH DESCRIPTION The CUTEST_csgrp subroutine evaluates the sparsity pattern used when storing the gradients of the general constraints and of either the objective function diff --git a/man/man3/cutest_csgrsh.3 b/man/man3/cutest_csgrsh.3 index 7f6c557..f37bf53 100644 --- a/man/man3/cutest_csgrsh.3 +++ b/man/man3/cutest_csgrsh.3 @@ -9,6 +9,12 @@ in sparse format. CALL CUTEST_csgrsh( status, n, m, X, Y, grlagf, nnzj, lj, J_val, J_var, J_fun, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgrsh_s( ... ) .SH DESCRIPTION The CUTEST_csgrsh subroutine evaluates the gradients of the general constraints, the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_csgrsh_threaded.3 b/man/man3/cutest_csgrsh_threaded.3 index fa3ed6e..0109603 100644 --- a/man/man3/cutest_csgrsh_threaded.3 +++ b/man/man3/cutest_csgrsh_threaded.3 @@ -9,6 +9,12 @@ in sparse format. CALL CUTEST_csgrsh_threaded( status, n, m, X, Y, grlagf, nnzj, lj, J_val, J_var, J_fun, nnzh, lh, H_val, H_row, H_col, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgrsh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_csgrsh_threaded subroutine evaluates the gradients of the general constraints, the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_csgrshp.3 b/man/man3/cutest_csgrshp.3 index 9e953b2..76aaeb0 100644 --- a/man/man3/cutest_csgrshp.3 +++ b/man/man3/cutest_csgrshp.3 @@ -7,6 +7,12 @@ and the Hessian of the Lagrangian. .SH SYNOPSIS .HP 1i CALL CUTEST_csgrshp( status, n, nnzj, lj, J_var, J_fun, nnzh, lh, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csgrshp_s( ... ) .SH DESCRIPTION The CUTEST_csgrshp subroutine evaluates sparsity pattern used when storing the gradients of the general constraints and of either the objective function diff --git a/man/man3/cutest_csh.3 b/man/man3/cutest_csh.3 index 2605547..d90d398 100644 --- a/man/man3/cutest_csh.3 +++ b/man/man3/cutest_csh.3 @@ -7,6 +7,12 @@ sparse format. .HP 1i CALL CUTEST_csh( status, n, m, X, Y, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csh_s( ... ) .SH DESCRIPTION The CUTEST_csh subroutine evaluates the Hessian of the Lagrangian function .EQ diff --git a/man/man3/cutest_csh_threaded.3 b/man/man3/cutest_csh_threaded.3 index ba02303..6d2ad80 100644 --- a/man/man3/cutest_csh_threaded.3 +++ b/man/man3/cutest_csh_threaded.3 @@ -7,6 +7,12 @@ sparse format. .HP 1i CALL CUTEST_csh_threaded( status, n, m, X, Y, nnzh, lh, H_val, H_row, H_col, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_csh_threaded subroutine evaluates the Hessian of the Lagrangian function constraints, the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_cshc.3 b/man/man3/cutest_cshc.3 index 88ad18a..0bd1b47 100644 --- a/man/man3/cutest_cshc.3 +++ b/man/man3/cutest_cshc.3 @@ -7,6 +7,12 @@ the Lagrangian, in sparse format. .HP 1i CALL CUTEST_cshc( status, n, m, X, Y, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshc_s( ... ) .SH DESCRIPTION The CUTEST_cshc subroutine evaluates the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_cshc_threaded.3 b/man/man3/cutest_cshc_threaded.3 index 7095fa1..f1fd4bf 100644 --- a/man/man3/cutest_cshc_threaded.3 +++ b/man/man3/cutest_cshc_threaded.3 @@ -7,6 +7,12 @@ part of the Lagrangian, in sparse format. .HP 1i CALL CUTEST_cshc_threaded( status, n, m, X, Y, nnzh, lh, H_val, H_row, H_col, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshc_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cshc_threaded subroutine evaluates the Hessian matrix of the constraint part diff --git a/man/man3/cutest_cshcprod.3 b/man/man3/cutest_cshcprod.3 index 5307d87..b5a46bb 100644 --- a/man/man3/cutest_cshcprod.3 +++ b/man/man3/cutest_cshcprod.3 @@ -8,6 +8,12 @@ vector with the Hessian matrix of the constraint part of the Lagrangian. CALL CUTEST_cshcprod( status, n, goth, X, Y, nnz_vector, INDEX_nz_vector, VECTOR, nnz_result, INDEX_nz_result, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshcprod_s( ... ) .SH DESCRIPTION The CUTEST_cshcprod subroutine forms the product of a sparse vector with the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_cshcprod_threaded.3 b/man/man3/cutest_cshcprod_threaded.3 index 06b72d2..233b4e2 100644 --- a/man/man3/cutest_cshcprod_threaded.3 +++ b/man/man3/cutest_cshcprod_threaded.3 @@ -8,6 +8,12 @@ spaarse vector with the Hessian matrix of the constraint part of the Lagrangian. CALL CUTEST_cshcprod_threaded( status, n, goth, X, Y, nnz_vector, INDEX_nz_vector, VECTOR, nnz_result, INDEX_nz_result, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshcprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cshcprod_threaded subroutine forms the product of a sparse vector with the Hessian matrix of the constraint part of the Lagrangian function diff --git a/man/man3/cutest_cshj.3 b/man/man3/cutest_cshj.3 index fd7d000..ca9d0a3 100644 --- a/man/man3/cutest_cshj.3 +++ b/man/man3/cutest_cshj.3 @@ -7,6 +7,12 @@ function, in sparse format. .HP 1i CALL CUTEST_cshj( status, n, m, X, y0, Y, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshj_s( ... ) .SH DESCRIPTION The CUTEST_cshj subroutine evaluates the Hessian of the John function .EQ diff --git a/man/man3/cutest_cshj_threaded.3 b/man/man3/cutest_cshj_threaded.3 index b0de83d..a3ac251 100644 --- a/man/man3/cutest_cshj_threaded.3 +++ b/man/man3/cutest_cshj_threaded.3 @@ -7,6 +7,12 @@ function, in sparse format. .HP 1i CALL CUTEST_cshj_threaded( status, n, m, X, y0, Y, nnzh, lh, H_val, H_row, H_col, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshj_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cshj_threaded subroutine evaluates the Hessian of the John function .EQ diff --git a/man/man3/cutest_cshp.3 b/man/man3/cutest_cshp.3 index 887d1f2..9fb05b2 100644 --- a/man/man3/cutest_cshp.3 +++ b/man/man3/cutest_cshp.3 @@ -6,6 +6,12 @@ of the Lagrangian function. .SH SYNOPSIS .HP 1i CALL CUTEST_cshp( status, n, nnzh, lh, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshp_s( ... ) .SH DESCRIPTION The CUTEST_cshp subroutine evaluates the sparsity pattern of the Hessian of the Lagrangian function diff --git a/man/man3/cutest_cshprod.3 b/man/man3/cutest_cshprod.3 index 2a4d9d1..370f4e0 100644 --- a/man/man3/cutest_cshprod.3 +++ b/man/man3/cutest_cshprod.3 @@ -8,6 +8,12 @@ sparse vector with the Hessian matrix of the Lagrangian. CALL CUTEST_cshprod( status, n, goth, X, Y, nnz_vector, INDEX_nz_vector, VECTOR, nnz_result, INDEX_nz_result, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshprod_s( ... ) .SH DESCRIPTION The CUTEST_cshprod subroutine forms the product of a sparse vector with the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_cshprod_threaded.3 b/man/man3/cutest_cshprod_threaded.3 index e38d20d..69a2bbd 100644 --- a/man/man3/cutest_cshprod_threaded.3 +++ b/man/man3/cutest_cshprod_threaded.3 @@ -8,6 +8,12 @@ sparse vector with the Hessian matrix of the Lagrangian. CALL CUTEST_cshprod_threaded( status, n, goth, X, Y, nnz_vector, INDEX_nz_vector, VECTOR, nnz_result, INDEX_nz_result, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cshprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_cshprod_threaded subroutine forms the product of a sparse vector with the Hessian matrix of the Lagrangian function diff --git a/man/man3/cutest_csjp.3 b/man/man3/cutest_csjp.3 index 0ce3d03..ebb2e66 100644 --- a/man/man3/cutest_csjp.3 +++ b/man/man3/cutest_csjp.3 @@ -6,6 +6,12 @@ Jacobian of constraints gradients. .SH SYNOPSIS .HP 1i CALL CUTEST_csjp( status, nnzj, lj, J_var, J_con ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csjp_s( ... ) .SH DESCRIPTION The CUTEST_csjp subroutine evaluates the sparsity pattern used when storing the Jacobian matrix of gradients of the general constraints diff --git a/man/man3/cutest_csjprod.3 b/man/man3/cutest_csjprod.3 index 41b1ef5..229e9b2 100644 --- a/man/man3/cutest_csjprod.3 +++ b/man/man3/cutest_csjprod.3 @@ -9,6 +9,12 @@ vector with the Jacobian of the constraints, or its transpose. CALL CUTEST_csjprod( status, n, m, gotj, jtrans, X, nnz_vector, INDEX_nz_vector, VECTOR, lvector, nnz_result, INDEX_nz_result, RESULT, lresult ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csjprod_s( ... ) .SH DESCRIPTION The CUTEST_csjprod subroutine forms the product of a sparse vector with the Jacobian matrix, or with its transpose, diff --git a/man/man3/cutest_csjprod_threaded.3 b/man/man3/cutest_csjprod_threaded.3 index 4b165c2..e781547 100644 --- a/man/man3/cutest_csjprod_threaded.3 +++ b/man/man3/cutest_csjprod_threaded.3 @@ -9,6 +9,12 @@ sparse vector with the Jacobian of the constraints, or its transpose. CALL CUTEST_csjprod_threaded( status, n, m, gotj, jtrans, X, nnz_vector, INDEX_nz_vector, VECTOR, lvector, nnz_result, INDEX_nz_result, RESULT, lresult, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_csjprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_csjprod_threaded subroutine forms the product of a sparse vector with the Jacobian matrix, or with its transpose, diff --git a/man/man3/cutest_cterminate.3 b/man/man3/cutest_cterminate.3 index a49609d..3a8a7ac 100644 --- a/man/man3/cutest_cterminate.3 +++ b/man/man3/cutest_cterminate.3 @@ -5,6 +5,12 @@ CUTEST_cterminate \- CUTEst tool to remove all workspace used. .SH SYNOPSIS .HP 1i CALL CUTEST_cterminate( status ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cterminate_s( ... ) .SH DESCRIPTION The CUTEST_uterminate subroutine deallocates all workspace arrays created since the last call to CUTEST_csetup. diff --git a/man/man3/cutest_cvartype.3 b/man/man3/cutest_cvartype.3 index d273c50..fcf433f 100644 --- a/man/man3/cutest_cvartype.3 +++ b/man/man3/cutest_cvartype.3 @@ -5,6 +5,12 @@ CUTEST_cvartype \- CUTEst tool to determine the type of each variable. .SH SYNOPSIS .HP 1i CALL CUTEST_cvartype( status, n, X_type ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_cvartype_s( ... ) .SH DESCRIPTION The CUTEST_cvartype subroutine determines the type (continuous, 0-1, integer) of each variable involved in the problem diff --git a/man/man3/cutest_pname.3 b/man/man3/cutest_pname.3 index 288f853..50d3cac 100644 --- a/man/man3/cutest_pname.3 +++ b/man/man3/cutest_pname.3 @@ -6,6 +6,12 @@ from OUTSDIF.d. .SH SYNOPSIS .HP 1i CALL CUTEST_pname( status, input, pname ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_pname_s( ... ) .SH DESCRIPTION The CUTEST_pname subroutine obtains the name of the problem directly from the datafile OUTSDIF.d that was created by the script \fIsifdecoder\fP diff --git a/man/man3/cutest_probname.3 b/man/man3/cutest_probname.3 index 66deb04..2853270 100644 --- a/man/man3/cutest_probname.3 +++ b/man/man3/cutest_probname.3 @@ -5,6 +5,12 @@ CUTEST_probname \- CUTEst tool to obtain the name of the problem. .SH SYNOPSIS .HP 1i CALL CUTEST_probname( status, pname ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_probname_s( ... ) .SH DESCRIPTION The CUTEST_probname subroutine obtains the name of the problem. diff --git a/man/man3/cutest_timings.3 b/man/man3/cutest_timings.3 index 6f96acd..0ab079e 100644 --- a/man/man3/cutest_timings.3 +++ b/man/man3/cutest_timings.3 @@ -6,6 +6,12 @@ subrotine. .SH SYNOPSIS .HP 1i CALL CUTEST_timings( status, name, time ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_timings_s( ... ) .SH DESCRIPTION The CUTEST_timings subroutine obtains the CPU time used by an individual CUTEst evaluation subroutine. diff --git a/man/man3/cutest_timings_threaded.3 b/man/man3/cutest_timings_threaded.3 index 387171b..36debd5 100644 --- a/man/man3/cutest_timings_threaded.3 +++ b/man/man3/cutest_timings_threaded.3 @@ -6,6 +6,12 @@ subrotine. .SH SYNOPSIS .HP 1i CALL CUTEST_timings_threaded( status, name, time, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_timings_threaded_s( ... ) .SH DESCRIPTION The CUTEST_timings_threaded subroutine obtains the CPU time used by an individual CUTEst evaluation subroutine. diff --git a/man/man3/cutest_ubandh.3 b/man/man3/cutest_ubandh.3 index 264a6fe..bc9f555 100644 --- a/man/man3/cutest_ubandh.3 +++ b/man/man3/cutest_ubandh.3 @@ -6,6 +6,12 @@ matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_ubandh( status, n, X, nsemib, BANDH, lbandh, maxsbw ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ubandh_s( ... ) .SH DESCRIPTION The CUTEST_ubandh subroutine extracts the elements which lie within a band of given semi-bandwidth out of the Hessian matrix of the objective diff --git a/man/man3/cutest_ubandh_threaded.3 b/man/man3/cutest_ubandh_threaded.3 index 81a004b..0e9df5c 100644 --- a/man/man3/cutest_ubandh_threaded.3 +++ b/man/man3/cutest_ubandh_threaded.3 @@ -6,6 +6,12 @@ from the Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_ubandh_threaded( status, n, X, nsemib, BANDH, lbandh, maxsbw, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ubandh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ubandh_threaded subroutine extracts the elements which lie within a band of given semi-bandwidth out of the Hessian matrix of the objective diff --git a/man/man3/cutest_udh.3 b/man/man3/cutest_udh.3 index 3b1f397..c3557c5 100644 --- a/man/man3/cutest_udh.3 +++ b/man/man3/cutest_udh.3 @@ -5,6 +5,12 @@ CUTEST_udh \- CUTEst tool to evaluate the Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_udh( status, n, X, lh1, H_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_udh_s( ... ) .SH DESCRIPTION The CUTEST_udh subroutine evaluates the Hessian matrix of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_udh_threaded.3 b/man/man3/cutest_udh_threaded.3 index afade72..40a2bd6 100644 --- a/man/man3/cutest_udh_threaded.3 +++ b/man/man3/cutest_udh_threaded.3 @@ -5,6 +5,12 @@ CUTEST_udh_threaded \- CUTEst tool to evaluate the Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_udh_threaded( status, n, X, lh1, H_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_udh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_udh_threaded subroutine evaluates the Hessian matrix of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_udimen.3 b/man/man3/cutest_udimen.3 index ab75e67..d2b2275 100644 --- a/man/man3/cutest_udimen.3 +++ b/man/man3/cutest_udimen.3 @@ -5,6 +5,12 @@ CUTEST_udimen \- CUTEst tool to get the number of variables involved. .SH SYNOPSIS .HP 1i CALL CUTEST_udimen( status, input, n ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_udimen_s( ... ) .SH DESCRIPTION The CUTEST_udimen subroutine discovers how many variables are involved in the problem decoded from a SIF file by the script \fIsifdecoder\fP. diff --git a/man/man3/cutest_udimse.3 b/man/man3/cutest_udimse.3 index 717e327..05d6e76 100644 --- a/man/man3/cutest_udimse.3 +++ b/man/man3/cutest_udimse.3 @@ -6,6 +6,12 @@ store the sparse Hessian matrix in finite element format. .SH SYNOPSIS .HP 1i CALL CUTEST_udimse( status, ne, he_val_ne, he_row_ne ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_udimse_s( ... ) .SH DESCRIPTION The CUTEST_udimse subroutine determine the number of nonzeros required to store the Hessian matrix of the objective function of the problem diff --git a/man/man3/cutest_udimsh.3 b/man/man3/cutest_udimsh.3 index eb1ea09..2cdff29 100644 --- a/man/man3/cutest_udimsh.3 +++ b/man/man3/cutest_udimsh.3 @@ -6,6 +6,12 @@ store the sparse Hessian matrix in coordinate format. .SH SYNOPSIS .HP 1i CALL CUTEST_udimsh( status, nnzh ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_udimsh_s( ... ) .SH DESCRIPTION The CUTEST_udimsh subroutine determine the number of nonzeros required to store the Hessian matrix of the objective function of the problem diff --git a/man/man3/cutest_ueh.3 b/man/man3/cutest_ueh.3 index 08108e2..851cf59 100644 --- a/man/man3/cutest_ueh.3 +++ b/man/man3/cutest_ueh.3 @@ -7,6 +7,12 @@ element format. CALL CUTEST_ueh( status, n, X, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ueh_s( ... ) .SH DESCRIPTION The CUTEST_ueh subroutine evaluates the Hessian matrix of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ueh_threaded.3 b/man/man3/cutest_ueh_threaded.3 index 22c7571..fed27e6 100644 --- a/man/man3/cutest_ueh_threaded.3 +++ b/man/man3/cutest_ueh_threaded.3 @@ -7,6 +7,12 @@ in finite element format. CALL CUTEST_ueh_threaded( status, n, X, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ueh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ueh_threaded subroutine evaluates the Hessian matrix of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ufn.3 b/man/man3/cutest_ufn.3 index de94ca7..d3dbd8a 100644 --- a/man/man3/cutest_ufn.3 +++ b/man/man3/cutest_ufn.3 @@ -5,6 +5,12 @@ CUTEST_ufn \- CUTEst tool to evaluate function value. .SH SYNOPSIS .HP 1i CALL CUTEST_ufn( status, n, X, f ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ufn_s( ... ) .SH DESCRIPTION The CUTEST_ufn subroutine evaluates the value of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ufn_threaded.3 b/man/man3/cutest_ufn_threaded.3 index 3ad1612..a28a3c3 100644 --- a/man/man3/cutest_ufn_threaded.3 +++ b/man/man3/cutest_ufn_threaded.3 @@ -5,6 +5,12 @@ CUTEST_ufn_threaded \- CUTEst tool to evaluate function value. .SH SYNOPSIS .HP 1i CALL CUTEST_ufn_threaded( status, n, X, f, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ufn_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ufn_threaded subroutine evaluates the value of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ugr.3 b/man/man3/cutest_ugr.3 index fb385c9..f4436bc 100644 --- a/man/man3/cutest_ugr.3 +++ b/man/man3/cutest_ugr.3 @@ -5,6 +5,12 @@ CUTEST_ugr \- CUTEst tool to evaluate gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_ugr( status, n, X, G ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugr_s( ... ) .SH DESCRIPTION The CUTEST_ugr subroutine evaluates the gradient of the objective function of the problem decoded from a SIF file by the script \fIsifdecoder\fP at the diff --git a/man/man3/cutest_ugr_threaded.3 b/man/man3/cutest_ugr_threaded.3 index 3a6dbe3..8da7133 100644 --- a/man/man3/cutest_ugr_threaded.3 +++ b/man/man3/cutest_ugr_threaded.3 @@ -5,6 +5,12 @@ CUTEST_ugr_threaded \- CUTEst tool to evaluate gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_ugr_threaded( status, n, X, G, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugr_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ugr_threaded subroutine evaluates the gradient of the objective function of the problem decoded from a SIF file by the script \fIsifdecoder\fP at the diff --git a/man/man3/cutest_ugrdh.3 b/man/man3/cutest_ugrdh.3 index 7dcdc31..9c85702 100644 --- a/man/man3/cutest_ugrdh.3 +++ b/man/man3/cutest_ugrdh.3 @@ -5,6 +5,12 @@ CUTEST_ugrdh \- CUTEst tool to evaluate the gradient and Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_ugrdh( status, n, X, G, lh1, H_val ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugrdh_s( ... ) .SH DESCRIPTION The CUTEST_ugrdh subroutine evaluates the gradient and Hessian matrix of the objective function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_ugrdh_threaded.3 b/man/man3/cutest_ugrdh_threaded.3 index 8614941..88a1f3d 100644 --- a/man/man3/cutest_ugrdh_threaded.3 +++ b/man/man3/cutest_ugrdh_threaded.3 @@ -6,6 +6,12 @@ Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_ugrdh_threaded( status, n, X, G, lh1, H_val, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugrdh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ugrdh_threaded subroutine evaluates the gradient and Hessian matrix of the objective function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_ugreh.3 b/man/man3/cutest_ugreh.3 index 6cc0eff..dcf64e2 100644 --- a/man/man3/cutest_ugreh.3 +++ b/man/man3/cutest_ugreh.3 @@ -8,6 +8,12 @@ in finite element format. CALL CUTEST_ugreh( status, n, X, G, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugreh_s( ... ) .SH DESCRIPTION The CUTEST_ugreh subroutine evaluates the gradient and Hessian matrix of the objective function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_ugreh_threaded.3 b/man/man3/cutest_ugreh_threaded.3 index 367c74e..008ec7e 100644 --- a/man/man3/cutest_ugreh_threaded.3 +++ b/man/man3/cutest_ugreh_threaded.3 @@ -8,6 +8,12 @@ sparse Hessian matrix in finite element format. CALL CUTEST_ugreh_threaded( status, n, X, G, ne, lhe_ptr, HE_row_ptr, HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugreh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ugreh_threaded subroutine evaluates the gradient and Hessian matrix of the objective function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_ugrsh.3 b/man/man3/cutest_ugrsh.3 index 4c1a76d..ac2366f 100644 --- a/man/man3/cutest_ugrsh.3 +++ b/man/man3/cutest_ugrsh.3 @@ -7,6 +7,12 @@ in coordinate format. .HP 1i CALL CUTEST_ugrsh( status, n, X, G, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugrsh_s( ... ) .SH DESCRIPTION The CUTEST_ugrsh subroutine evaluates the gradient and Hessian matrix of the objective function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_ugrsh_threaded.3 b/man/man3/cutest_ugrsh_threaded.3 index cbd875c..94064af 100644 --- a/man/man3/cutest_ugrsh_threaded.3 +++ b/man/man3/cutest_ugrsh_threaded.3 @@ -7,6 +7,12 @@ in coordinate format. .HP 1i CALL CUTEST_ugrsh_threaded( status, n, X, G, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ugrsh_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ugrsh_threaded subroutine evaluates the gradient and Hessian matrix of the objective function of the problem decoded from a SIF file by the diff --git a/man/man3/cutest_uhprod.3 b/man/man3/cutest_uhprod.3 index 128bf57..1c368b0 100644 --- a/man/man3/cutest_uhprod.3 +++ b/man/man3/cutest_uhprod.3 @@ -6,6 +6,12 @@ the Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_uhprod( status, n, goth, X, VECTOR, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_uhprod_s( ... ) .SH DESCRIPTION The CUTEST_uhprod subroutine forms the product of a vector with the Hessian matrix of the objective function of the problem decoded from a SIF file diff --git a/man/man3/cutest_uhprod_threaded.3 b/man/man3/cutest_uhprod_threaded.3 index 43cf443..886c98e 100644 --- a/man/man3/cutest_uhprod_threaded.3 +++ b/man/man3/cutest_uhprod_threaded.3 @@ -6,6 +6,12 @@ the Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_uhprod_threaded( status, n, goth, X, VECTOR, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_uhprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_uhprod_threaded subroutine forms the product of a vector with the Hessian matrix of the objective function of the problem decoded from a SIF file diff --git a/man/man3/cutest_unames.3 b/man/man3/cutest_unames.3 index d8909c4..fb296da 100644 --- a/man/man3/cutest_unames.3 +++ b/man/man3/cutest_unames.3 @@ -5,6 +5,12 @@ CUTEST_unames \- CUTEst tool to obtain the names of the problem and its variable .SH SYNOPSIS .HP 1i CALL CUTEST_unames( status, n, pname, VNAME ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_unames_s( ... ) .SH DESCRIPTION The CUTEST_unames subroutine obtains the names of the problem and its variables. diff --git a/man/man3/cutest_uofg.3 b/man/man3/cutest_uofg.3 index f67a5c2..f120e53 100644 --- a/man/man3/cutest_uofg.3 +++ b/man/man3/cutest_uofg.3 @@ -5,6 +5,12 @@ CUTEST_uofg \- CUTEst tool to evaluate function value and possibly gradient. .SH SYNOPSIS .HP 1i CALL CUTEST_uofg( status, n, X, f, G, grad ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_uofg_s( ... ) .SH DESCRIPTION The CUTEST_uofg subroutine evaluates the value of the objective function of the problem decoded from a SIF file by the script \fIsifdecoder\fP at diff --git a/man/man3/cutest_uofg_threaded.3 b/man/man3/cutest_uofg_threaded.3 index eea1f7b..c260dfb 100644 --- a/man/man3/cutest_uofg_threaded.3 +++ b/man/man3/cutest_uofg_threaded.3 @@ -5,6 +5,12 @@ CUTEST_uofg_threaded \- CUTEst tool to evaluate function value and possibly grad .SH SYNOPSIS .HP 1i CALL CUTEST_uofg_threaded( status, n, X, f, G, grad, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_uofg_threaded_s( ... ) .SH DESCRIPTION The CUTEST_uofg_threaded subroutine evaluates the value of the objective function of the problem decoded from a SIF file by the script \fIsifdecoder\fP at diff --git a/man/man3/cutest_ureport.3 b/man/man3/cutest_ureport.3 index a306520..c3e47a6 100644 --- a/man/man3/cutest_ureport.3 +++ b/man/man3/cutest_ureport.3 @@ -6,6 +6,12 @@ evaluation and CPU time used. .SH SYNOPSIS .HP 1i CALL CUTEST_ureport( status, CALLS, TIME ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ureport_s( ... ) .SH DESCRIPTION The CUTEST_ureport subroutine obtains statistics concerning function evaluation and CPU diff --git a/man/man3/cutest_ureport_threaded.3 b/man/man3/cutest_ureport_threaded.3 index 47484be..f03013f 100644 --- a/man/man3/cutest_ureport_threaded.3 +++ b/man/man3/cutest_ureport_threaded.3 @@ -6,6 +6,12 @@ evaluation and CPU time used. .SH SYNOPSIS .HP 1i CALL CUTEST_ureport_threaded( status, CALLS, TIME, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ureport_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ureport_threaded subroutine obtains statistics concerning function evaluation and CPU diff --git a/man/man3/cutest_usetup.3 b/man/man3/cutest_usetup.3 index 2eea5a3..2847c19 100644 --- a/man/man3/cutest_usetup.3 +++ b/man/man3/cutest_usetup.3 @@ -6,6 +6,12 @@ for unconstrained or bound-constrained minimization. .SH SYNOPSIS .HP 1i CALL CUTEST_usetup( status, input, out, io_buffer, n, X, X_l, X_u ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_usetup_s( ... ) .SH DESCRIPTION The CUTEST_usetup subroutine sets up the correct data structures for subsequent computations in the case where the only possible diff --git a/man/man3/cutest_usetup_threaded.3 b/man/man3/cutest_usetup_threaded.3 index 9816411..a5d0f0f 100644 --- a/man/man3/cutest_usetup_threaded.3 +++ b/man/man3/cutest_usetup_threaded.3 @@ -7,6 +7,12 @@ for unconstrained or bound-constrained minimization. .HP 1i CALL CUTEST_usetup_threaded( status, input, out, threads, IO_BUFFERS, n, X, X_l, X_u ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_usetup_threaded_s( ... ) .SH DESCRIPTION The CUTEST_usetup_threaded subroutine sets up the correct data structures for subsequent threaded computations in the case where the only possible diff --git a/man/man3/cutest_ush.3 b/man/man3/cutest_ush.3 index bf58d6f..fd9d353 100644 --- a/man/man3/cutest_ush.3 +++ b/man/man3/cutest_ush.3 @@ -6,6 +6,12 @@ of the objective function. .SH SYNOPSIS .HP 1i CALL CUTEST_ush( status, n, X, nnzh, lh, H_val, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ush_s( ... ) .SH DESCRIPTION The CUTEST_ush subroutine evaluates the Hessian matrix of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ush_threaded.3 b/man/man3/cutest_ush_threaded.3 index 3f5b4b7..f0b9784 100644 --- a/man/man3/cutest_ush_threaded.3 +++ b/man/man3/cutest_ush_threaded.3 @@ -5,6 +5,12 @@ CUTEST_ush_threaded \- CUTEst tool to evaluate the sparse Hessian matrix. .SH SYNOPSIS .HP 1i CALL CUTEST_ush_threaded( status, n, X, nnzh, LH, H_val, H_row, H_col, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ush_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ush_threaded subroutine evaluates X_typessian matrix of the objective function of the problem decoded from a SIF file by the script diff --git a/man/man3/cutest_ushp.3 b/man/man3/cutest_ushp.3 index a7617fb..af439f1 100644 --- a/man/man3/cutest_ushp.3 +++ b/man/man3/cutest_ushp.3 @@ -6,6 +6,12 @@ matrix of the objective function. .SH SYNOPSIS .HP 1i CALL CUTEST_ushp( status, n, nnzh, lh, H_row, H_col ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ushp_s( ... ) .SH DESCRIPTION The CUTEST_ushp subroutine evaluates the sparsity pattern of the Hessian matrix of diff --git a/man/man3/cutest_ushprod.3 b/man/man3/cutest_ushprod.3 index 4121c32..dafc880 100644 --- a/man/man3/cutest_ushprod.3 +++ b/man/man3/cutest_ushprod.3 @@ -8,6 +8,12 @@ the Hessian matrix. CALL CUTEST_ushprod( status, n, goth, X, nnz_vector, INDEX_nz_vector, VECTOR, nnz_result, INDEX_nz_result, RESULT ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ushprod_s( ... ) .SH DESCRIPTION The CUTEST_ushprod subroutine forms the product of a sparse vector with the Hessian diff --git a/man/man3/cutest_ushprod_threaded.3 b/man/man3/cutest_ushprod_threaded.3 index a518bd1..dd476f6 100644 --- a/man/man3/cutest_ushprod_threaded.3 +++ b/man/man3/cutest_ushprod_threaded.3 @@ -8,6 +8,12 @@ the Hessian matrix. CALL CUTEST_ushprod_threaded( status, n, goth, X, nnz_vector, INDEX_nz_vector, VECTOR, nnz_result, INDEX_nz_result, RESULT, thread ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_ushprod_threaded_s( ... ) .SH DESCRIPTION The CUTEST_ushprod_threaded subroutine forms the product of a sparse vector with the Hessian diff --git a/man/man3/cutest_uterminate.3 b/man/man3/cutest_uterminate.3 index f896e97..35807b2 100644 --- a/man/man3/cutest_uterminate.3 +++ b/man/man3/cutest_uterminate.3 @@ -5,6 +5,12 @@ CUTEST_uterminate \- CUTEst tool to remove all workspace used. .SH SYNOPSIS .HP 1i CALL CUTEST_uterminate( status ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_uterminate_s( ... ) .SH DESCRIPTION The CUTEST_uterminate subroutine deallocates all workspace arrays created since the last call to CUTEST_usetup. diff --git a/man/man3/cutest_uvartype.3 b/man/man3/cutest_uvartype.3 index b7038a7..4235774 100644 --- a/man/man3/cutest_uvartype.3 +++ b/man/man3/cutest_uvartype.3 @@ -5,6 +5,12 @@ CUTEST_uvartype \- CUTEst tool to determine the type of each variable. .SH SYNOPSIS .HP 1i CALL CUTEST_uvartype( status, n, X_type ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_uvartype_s( ... ) .SH DESCRIPTION The CUTEST_uvartype subroutine determines the type (continuous, 0-1, integer) of each variable involved in the problem decoded diff --git a/man/man3/cutest_varnames.3 b/man/man3/cutest_varnames.3 index b971c06..7d4d068 100644 --- a/man/man3/cutest_varnames.3 +++ b/man/man3/cutest_varnames.3 @@ -5,6 +5,12 @@ CUTEST_varnames \- CUTEst tool to obtain the names of the problem variables. .SH SYNOPSIS .HP 1i CALL CUTEST_varnames( status, n, VNAME ) + +.HP 1i +For real rather than double precision arguments, instead + +.HP 1i +CALL CUTEST_varnames_s( ... ) .SH DESCRIPTION The CUTEST_varnames subroutine obtains the names of the problem variables. diff --git a/packages/defaults/tao b/packages/defaults/tao index 2b162f4..223b4d9 100755 --- a/packages/defaults/tao +++ b/packages/defaults/tao @@ -18,9 +18,21 @@ export PACKOBJS="" # Define package and system libraries using -llibrary to include library.a # or library.so together with any nonstandard library paths using -L(path) -export PACKLIBS="-Wl,-rpath,$TAO_DIR/lib/lib$BOPT/$PETSC_ARCH -Wl,-rpath,$PETSC_DIR/lib/lib$BOPT/$PETSC_ARCH -L$TAO_DIR/lib/lib$BOPT/$PETSC_ARCH -ltaofortran -ltao -L$PETSC_DIR/lib/lib$BOPT/$PETSC_ARCH -lpetscfortran -lpetscsnes -lpetscsles -lpetscdm -lpetscmat -lpetscvec -lpetsc $MPI_LIB" +export PACKLIBS="-Wl,-rpath,$PETSC_DIR/$PETSC_ARCH/lib \ + -L$PETSC_DIR/$PETSC_ARCH/lib \ + -Wl,-rpath,/usr/lib/x86_64-linux-gnu/openmpi/lib/fortran/gfortran \ + -L/usr/lib/x86_64-linux-gnu/openmpi/lib/fortran/gfortran \ + -Wl,-rpath,/usr/lib/gcc/x86_64-linux-gnu/11 \ + -L/usr/lib/gcc/x86_64-linux-gnu/11 \ + -lpetsc -lopenblas -lm -lX11 -lmpi_usempif08 -lmpi_usempi_ignore_tkr \ + -lmpi_mpifh -lmpi -lopen-rte -lopen-pal -lhwloc -levent_core \ + -levent_pthreads -lgfortran -lm -lz -lgfortran -lm -lgfortran -lgcc_s \ + -lquadmath -lstdc++ -lquadmath" # Define the name of the package specification file if any. This possibly # precision-dependent file must either lie in the current directory or in # ${CUTEST}/src/${PACKDIR} -export SPECS="" +export SPECS="TAO.SPC" + + + diff --git a/src/algencan/algencan_main.f b/src/algencan/algencan_main.F similarity index 76% rename from src/algencan/algencan_main.f rename to src/algencan/algencan_main.F index 2e8563e..1052c1b 100644 --- a/src/algencan/algencan_main.f +++ b/src/algencan/algencan_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 17 Feb 2013 at 15:30:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM ALGENCAN_main @@ -15,17 +18,18 @@ PROGRAM ALGENCAN_main C Set up parameters, variables and arrays required by constrained tools - INTEGER, PARAMETER :: input = 10, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: inform, iprint, m, n, ncomp, status - DOUBLE PRECISION :: cnorm, efacc, eoacc, epsfeas, epsopt, f - DOUBLE PRECISION :: nlpsupn, snorm + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ), PARAMETER :: input = 10, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: inform, iprint, m, n, ncomp, status + REAL ( KIND = rp_ ) :: cnorm, efacc, eoacc, epsfeas, epsopt, f + REAL ( KIND = rp_ ) :: nlpsupn, snorm LOGICAL :: checkder CHARACTER * 10 :: pname - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) LOGICAL :: CODED( 11 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: LAMBDA + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: LAMBDA LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR C Open the relevant file @@ -36,7 +40,7 @@ PROGRAM ALGENCAN_main C compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C close input so that inip can open it again! CLOSE( input ) @@ -64,8 +68,8 @@ PROGRAM ALGENCAN_main C output information - CALL CUTEST_creport( status, CALLS, CPU ) - CALL CUTEST_probname( status, pname ) + CALL CUTEST_creport_r( status, CALLS, CPU ) + CALL CUTEST_probname_r( status, pname ) IF ( out .GT. 0 ) * WRITE ( out, 2000 ) pname, n, m, CALLS( 1 ), CALLS( 2 ), * CALLS( 5 ), CALLS( 6 ), inform, f, CPU( 1 ), CPU( 2 ) @@ -75,7 +79,7 @@ PROGRAM ALGENCAN_main CALL endp( n, X, X_l, X_u, m, LAMBDA, EQUATN, LINEAR ) DEALLOCATE( X, X_l, X_u, LAMBDA, EQUATN, LINEAR, * STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -111,12 +115,14 @@ PROGRAM ALGENCAN_main subroutine param(epsfeas,epsopt,efacc,eoacc,iprint,ncomp) + use CUTEST_KINDS_precision + C SCALAR ARGUMENTS - integer iprint,ncomp - double precision efacc,eoacc,epsfeas,epsopt + integer ( kind = ip_ ) iprint,ncomp + real ( kind = rp_ ) efacc,eoacc,epsfeas,epsopt - epsfeas = 1.0d-08 - epsopt = 1.0d-08 + epsfeas = ( 10.0_rp_ ) ** ( - 8 ) + epsopt = ( 10.0_rp_ ) ** ( - 8 ) efacc = sqrt( epsfeas ) eoacc = sqrt( epsopt ) @@ -131,41 +137,45 @@ subroutine param(epsfeas,epsopt,efacc,eoacc,iprint,ncomp) subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS logical checkder - integer m,n + integer ( kind = ip_ ) m,n C ARRAY ARGUMENTS logical coded(11),equatn(m),linear(m) - double precision l(n),lambda(m),u(n),x(n) + real ( kind = rp_ ) l(n),lambda(m),u(n),x(n) C#include "../../algencan/dim.par" include "dim.par" include "cutest.com" C LOCAL SCALARS - integer cind,i,sind, status + integer ( kind = ip_ ) cind,i,sind, status character * 10 pname - double precision dum + real ( kind = rp_ ) dum, big + parameter ( big = ( 10.0_rp_ ) ** 20 ) C LOCAL ARRAYS - character * 10 gnames(mmax),xnames(nmax) - double precision c(mmax),cl(mmax),cu(mmax) +C character * 10 gnames(mmax),xnames(nmax) +C real ( kind = rp_ ) c(mmax),cl(mmax),cu(mmax) + character * 10 gnames(m),xnames(n) + real ( kind = rp_ ) c(m),cl(m),cu(m) C EXTERNAL SUBROUTINES - external csetup,cnames + external CUTEST_csetup_r, CUTEST_cnames_r C Set problem data open(10,file='OUTSDIF.d',form='formatted',status='old') rewind( 10 ) - call CUTEST_csetup(status,10,20,11,n,m,x,l,u,lambda,cl,cu, + call CUTEST_csetup_r(status,10,20,11,n,m,x,l,u,lambda,cl,cu, + equatn,linear,1,0,0) if ( status .ne. 0 ) go to 910 - call CUTEST_cnames(status,n,m,pname,xnames,gnames) + call CUTEST_cnames_r(status,n,m,pname,xnames,gnames) if ( status .ne. 0 ) go to 910 close(10) @@ -187,7 +197,7 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) C Compute constraints to initialize slacks if ( useslacks ) then - call CUTEST_cfn(status,n,m,x,dum,c) + call CUTEST_cfn_r(status,n,m,x,dum,c) if ( status .ne. 0 ) go to 910 end if @@ -202,12 +212,12 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) slaind(i) = - 1 ccor(i) = 0 cmap(i) = i - ca(i) = 1.0d0 + ca(i) = 1.0_rp_ cb(i) = - cu(i) C Ranged inequality constraint: add slack or split it. - else if ( cl(i) .gt. - 1.0d+20 .and. cu(i) .lt. 1.0d+20 ) then + else if ( cl(i) .gt. - big .and. cu(i) .lt. big ) then nranges = nranges + 1 @@ -224,8 +234,8 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) slaind(i) = sind ccor(i) = 0 cmap(i) = i - ca(i) = 1.0d0 - cb(i) = 0.0d0 + ca(i) = 1.0_rp_ + cb(i) = 0.0_rp_ equatn(i) = .true. @@ -239,34 +249,34 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) slaind(cind) = - 1 cmap(cind) = i - ca(cind) = 1.0d0 + ca(cind) = 1.0_rp_ cb(cind) = - cu(i) slaind(i) = - 1 ccor(i) = cind cmap(i) = i - ca(i) = - 1.0d0 + ca(i) = - 1.0_rp_ cb(i) = cl(i) end if C Inequality constraint of type c(x) <= u. - else if ( cu(i) .lt. 1.0d+20 ) then + else if ( cu(i) .lt. big ) then slaind(i) = - 1 ccor(i) = 0 cmap(i) = i - ca(i) = 1.0d0 + ca(i) = 1.0_rp_ cb(i) = - cu(i) C Inequality constraint of type l <= c(x). - else if ( cl(i) .gt. - 1.0d+20 ) then + else if ( cl(i) .gt. - big ) then slaind(i) = - 1 ccor(i) = 0 cmap(i) = i - ca(i) = - 1.0d0 + ca(i) = - 1.0_rp_ cb(i) = cl(i) end if @@ -285,7 +295,7 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) C Lagrange multipliers approximation do i = 1,m - lambda(i) = 0.0d0 + lambda(i) = 0.0_rp_ end do C In this CUTEst interface evalfc, evalgjac, evalhl and evalhlp are @@ -302,7 +312,7 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) coded( 9) = .false. ! evalgjacp coded(10) = .true. ! evalhl coded(11) = .false. ! evalhlp (coded but not being used) - ! (In fact, the case sf=0.0d0 is incomplete, + ! (In fact, the case sf=0.0 is incomplete, ! September 11th, 2009) checkder = .false. @@ -319,14 +329,15 @@ subroutine inip(n,x,l,u,m,lambda,equatn,linear,coded,checkder) subroutine endp(n,x,l,u,m,lambda,equatn,linear) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer m,n + integer ( kind = ip_ ) m,n C ARRAY ARGUMENTS logical equatn(m),linear(m) - double precision l(n),lambda(m),u(n),x(n) + real ( kind = rp_ ) l(n),lambda(m),u(n),x(n) end @@ -335,14 +346,15 @@ subroutine endp(n,x,l,u,m,lambda,equatn,linear) subroutine evalf(n,x,f,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,n - double precision f + integer ( kind = ip_ ) flag,n + real ( kind = rp_ ) f C ARRAY ARGUMENTS - double precision x(n) + real ( kind = rp_ ) x(n) flag = - 1 @@ -353,13 +365,14 @@ subroutine evalf(n,x,f,flag) subroutine evalg(n,x,g,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,n + integer ( kind = ip_ ) flag,n C ARRAY ARGUMENTS - double precision g(n),x(n) + real ( kind = rp_ ) g(n),x(n) flag = - 1 @@ -370,14 +383,15 @@ subroutine evalg(n,x,g,flag) subroutine evalh(n,x,hlin,hcol,hval,hnnz,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,hnnz,n + integer ( kind = ip_ ) flag,hnnz,n C ARRAY ARGUMENTS - integer hcol(*),hlin(*) - double precision hval(*),x(n) + integer ( kind = ip_ ) hcol(*),hlin(*) + real ( kind = rp_ ) hval(*),x(n) flag = - 1 @@ -388,14 +402,15 @@ subroutine evalh(n,x,hlin,hcol,hval,hnnz,flag) subroutine evalc(n,x,ind,c,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,ind,n - double precision c + integer ( kind = ip_ ) flag,ind,n + real ( kind = rp_ ) c C ARRAY ARGUMENTS - double precision x(n) + real ( kind = rp_ ) x(n) flag = - 1 @@ -406,14 +421,15 @@ subroutine evalc(n,x,ind,c,flag) subroutine evaljac(n,x,ind,jcvar,jcval,jcnnz,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,ind,jcnnz,n + integer ( kind = ip_ ) flag,ind,jcnnz,n C ARRAY ARGUMENTS - integer jcvar(*) - double precision jcval(*),x(n) + integer ( kind = ip_ ) jcvar(*) + real ( kind = rp_ ) jcval(*),x(n) flag = - 1 @@ -424,14 +440,15 @@ subroutine evaljac(n,x,ind,jcvar,jcval,jcnnz,flag) subroutine evalhc(n,x,hclin,hccol,hcval,hcnnz,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,hcnnz,n + integer ( kind = ip_ ) flag,hcnnz,n C ARRAY ARGUMENTS - integer hccol(*),hclin(*) - double precision hcval(*),x(n) + integer ( kind = ip_ ) hccol(*),hclin(*) + real ( kind = rp_ ) hcval(*),x(n) flag = - 1 @@ -442,32 +459,31 @@ subroutine evalhc(n,x,hclin,hccol,hcval,hcnnz,flag) subroutine evalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,hnnz,m,n, status - double precision sf + integer ( kind = ip_ ) flag,hnnz,m,n, status + real ( kind = rp_ ) sf C ARRAY ARGUMENTS - integer hlin(*),hcol(*) - double precision hval(*),lambda(m),sc(m),x(n) + integer ( kind = ip_ ) hlin(*),hcol(*) + real ( kind = rp_ ) hval(*),lambda(m),sc(m),x(n) C#include "../../algencan/dim.par" include "dim.par" include "cutest.com" C LOCAL SCALARS - integer i + integer ( kind = ip_ ) i C LOCAL ARRAYS - double precision v(mmax) - -C EXTERNAL SUBROUTINES - external csh,csh1 +! real ( kind = rp_ ) v(mmax) + real ( kind = rp_ ) v(m) flag = 0 - if ( sf .eq. 0.0d0 ) then + if ( sf .eq. 0.0_rp_ ) then C flag = - 1 C return @@ -477,15 +493,15 @@ subroutine evalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) C return do i = 1,mcutest - v(i) = 0.0d0 + v(i) = 0.0_rp_ end do do i = 1,m v(cmap(i)) = v(cmap(i)) + ca(i) * lambda(i) * sc(i) end do - call CUTEST_cshc(status,ncutest,mcutest,x,v, - * hnnz,hnnzmax,hval,hlin,hcol) + call CUTEST_cshc_r(status,ncutest,mcutest,x,v, + * hnnz,hnnzmax,hval,hlin,hcol) if ( status .ne. 0 ) go to 910 C Interchange row and column indices @@ -498,15 +514,15 @@ subroutine evalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) end if do i = 1,mcutest - v(i) = 0.0d0 + v(i) = 0.0_rp_ end do do i = 1,m v(cmap(i)) = v(cmap(i)) + ca(i) * lambda(i) * sc(i) / sf end do - call CUTEST_csh(status,ncutest,mcutest,x,v, - * hnnz,hnnzmax,hval,hlin,hcol) + call CUTEST_csh_r(status,ncutest,mcutest,x,v, + * hnnz,hnnzmax,hval,hlin,hcol) if ( status .ne. 0 ) go to 910 C Interchange row and column indices @@ -529,31 +545,38 @@ subroutine evalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) subroutine ievalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,hnnz,m,n - double precision sf + integer ( kind = ip_ ) flag,hnnz,m,n + real ( kind = rp_ ) sf C ARRAY ARGUMENTS - integer hlin(*),hcol(*) - double precision hval(*),lambda(m),sc(m),x(n) + integer ( kind = ip_ ) hlin(*),hcol(*) + real ( kind = rp_ ) hval(*),lambda(m),sc(m),x(n) C#include "../../algencan/dim.par" include "dim.par" include "cutest.com" C LOCAL SCALARS - integer col,con,hnnztmp,hnnzmaxtmp,i,ind,itmp,j,lin,nextj,rnnz - integer status - double precision val + integer ( kind = ip_ ) col,con,hnnztmp,hnnzmaxtmp,i,ind,itmp,j + integer ( kind = ip_ ) lin,nextj,rnnz + integer ( kind = ip_ ) status + real ( kind = rp_ ) val C LOCAL ARRAYS - integer hcon(hnnzmax),pos(nmax),rind(nmax),stlin(nmax) - double precision rval(nmax),v(mmax) +C integer ( kind = ip_ ) hcon(hnnzmax),pos(nmax),rind(nmax) +C integer ( kind = ip_ ) stlin(nmax) +C real ( kind = rp_ ) rval(nmax),v(mmax) + integer ( kind = ip_ ), allocatable, dimension( : ) :: hcon + integer ( kind = ip_ ) pos(n),rind(n) + integer ( kind = ip_ ) stlin(n) + real ( kind = rp_ ) rval(n),v(m) C EXTERNAL SUBROUTINES - external cish + external CUTEST_cish_r flag = 0 @@ -562,7 +585,7 @@ subroutine ievalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) C ================================================================== do i = 1,mcutest - v(i) = 0.0d0 + v(i) = 0.0_rp_ end do do i = 1,m @@ -575,9 +598,11 @@ subroutine ievalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) C COMPUTE HESSIAN OF THE OBJECTIVE FUNCTION - call CUTEST_cish(status,ncutest,x,0,hnnz,hnnzmax,hval,hlin,hcol) + call CUTEST_cish_r(status,ncutest,x,0,hnnz,hnnzmax,hval,hlin,hcol) if ( status .ne. 0 ) go to 910 + allocate( hcon( hnnz ), stat = i ) + C For each element of the Hessian of the objective function, C set constraint index as zero do i = 1,hnnz @@ -592,7 +617,7 @@ subroutine ievalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) do j = 1,mcutest C Compute Hessian of constraint j - call CUTEST_cish(status,ncutest,x,j,hnnztmp,hnnzmaxtmp, + call CUTEST_cish_r(status,ncutest,x,j,hnnztmp,hnnzmaxtmp, + hval(hnnz+ind+1),hlin(hnnz+ind+1),hcol(hnnz+ind+1)) if ( status .ne. 0 ) go to 910 @@ -720,6 +745,7 @@ subroutine ievalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) go to 30 end if + deallocate( hcon, stat = i ) return 910 continue @@ -733,32 +759,34 @@ subroutine ievalhl(n,x,m,lambda,sf,sc,hlin,hcol,hval,hnnz,flag) subroutine evalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS logical goth - integer flag,m,n - double precision sf + integer ( kind = ip_ ) flag,m,n + real ( kind = rp_ ) sf C ARRAY ARGUMENTS - double precision hp(n),lambda(m),p(n),sc(m),x(n) + real ( kind = rp_ ) hp(n),lambda(m),p(n),sc(m),x(n) C#include "../../algencan/dim.par" include "dim.par" include "cutest.com" C LOCAL SCALARS - integer i, status + integer ( kind = ip_ ) i, status C LOCAL ARRAYS - double precision v(mmax) +C real ( kind = rp_ ) v(mmax) + real ( kind = rp_ ) v(m) C EXTERNAL SUBROUTINES - external cprod + external CUTEST_cprod_r flag = 0 - if ( sf .eq. 0.0d0 ) then + if ( sf .eq. 0.0_rp_ ) then flag = - 1 return @@ -769,14 +797,14 @@ subroutine evalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) end if do i = 1,mcutest - v(i) = 0.0d0 + v(i) = 0.0_rp_ end do do i = 1,m v(cmap(i)) = v(cmap(i)) + ca(i) * lambda(i) * sc(i) / sf end do - call CUTEST_chprod(status,ncutest,mcutest,goth,x,v,p,hp) + call CUTEST_chprod_r(status,ncutest,mcutest,goth,x,v,p,hp) if ( status .ne. 0 ) go to 910 do i = 1,ncutest @@ -784,7 +812,7 @@ subroutine evalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) end do do i = ncutest + 1,n - hp(i) = 0.0d0 + hp(i) = 0.0_rp_ end do goth = .true. @@ -801,15 +829,16 @@ subroutine evalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) subroutine ievalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS logical goth - integer flag,m,n - double precision sf + integer ( kind = ip_ ) flag,m,n + real ( kind = rp_ ) sf C ARRAY ARGUMENTS - double precision hp(n),lambda(m),p(n),sc(m),x(n) + real ( kind = rp_ ) hp(n),lambda(m),p(n),sc(m),x(n) C#include "../../algencan/dim.par" include "dim.par" @@ -818,8 +847,8 @@ subroutine ievalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) include "cutest.com" C LOCAL SCALARS - integer col,i,lin - double precision val + integer ( kind = ip_ ) col,i,lin + real ( kind = rp_ ) val flag = 0 @@ -829,7 +858,7 @@ subroutine ievalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) end if do i = 1,ncutest - hp(i) = 0.0d0 + hp(i) = 0.0_rp_ end do do i = 1,hnnz @@ -845,7 +874,7 @@ subroutine ievalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) end do do i = ncutest + 1,n - hp(i) = 0.0d0 + hp(i) = 0.0_rp_ end do end @@ -855,28 +884,29 @@ subroutine ievalhlp(n,x,m,lambda,sf,sc,p,hp,goth,flag) subroutine evalfc(n,x,f,m,c,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,m,n - double precision f + integer ( kind = ip_ ) flag,m,n + real ( kind = rp_ ) f C ARRAY ARGUMENTS - double precision c(m),x(n) + real ( kind = rp_ ) c(m),x(n) C#include "../../algencan/dim.par" include "dim.par" include "cutest.com" C LOCAL SCALARS - integer i,sind, status + integer ( kind = ip_ ) i,sind, status C EXTERNAL SUBROUTINES - external cfn + external CUTEST_cfn_r flag = 0 - call CUTEST_cfn(status,ncutest,mcutest,x,f,c) + call CUTEST_cfn_r(status,ncutest,mcutest,x,f,c) if ( status .ne. 0 ) go to 910 do i = m,1,-1 @@ -902,38 +932,39 @@ subroutine evalfc(n,x,f,m,c,flag) subroutine evalgjac(n,x,g,m,jcfun,jcvar,jcval,jcnnz,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,jcnnz,m,n + integer ( kind = ip_ ) flag,jcnnz,m,n C ARRAY ARGUMENTS - integer jcfun(*),jcvar(*) - double precision g(n),jcval(*),x(n) + integer ( kind = ip_ ) jcfun(*),jcvar(*) + real ( kind = rp_ ) g(n),jcval(*),x(n) C#include "../../algencan/dim.par" include "dim.par" include "cutest.com" C LOCAL SCALARS - integer fu2,fun,i,jcnnztmp,sind,var, status + integer ( kind = ip_ ) fu2,fun,i,jcnnztmp,sind,var, status C LOCAL ARRAYS - double precision dum3(1) + real ( kind = rp_ ) dum3(1) C EXTERNAL SUBROUTINES - external csgr + external CUTEST_csgr_r flag = 0 - call CUTEST_csgr(status,ncutest,mcutest,x,dum3,.false., - + jcnnz,jcnnzmax,jcval,jcvar,jcfun) + call CUTEST_csgr_r(status,ncutest,mcutest,x,dum3,.false., + + jcnnz,jcnnzmax,jcval,jcvar,jcfun) if ( status .ne. 0 ) go to 910 C Remove gradient from the sparse structure do i = 1,n - g(i) = 0.0d0 + g(i) = 0.0_rp_ end do i = 1 @@ -989,7 +1020,7 @@ subroutine evalgjac(n,x,g,m,jcfun,jcvar,jcval,jcnnz,flag) jcnnz = jcnnz + 1 jcfun(jcnnz) = i jcvar(jcnnz) = sind - jcval(jcnnz) = - 1.0d0 + jcval(jcnnz) = - 1.0_rp_ end if end do return @@ -1005,15 +1036,16 @@ subroutine evalgjac(n,x,g,m,jcfun,jcvar,jcval,jcnnz,flag) subroutine evalgjacp(n,x,g,m,p,q,work,gotj,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS logical gotj - integer flag,m,n + integer ( kind = ip_ ) flag,m,n character work C ARRAY ARGUMENTS - double precision g(n),p(m),q(n),x(n) + real ( kind = rp_ ) g(n),p(m),q(n),x(n) C The usage of this subroutine for solving problems in the CUTEst C collection (in replacement of evalgjac) was never evaluated. @@ -1027,13 +1059,14 @@ subroutine evalgjacp(n,x,g,m,p,q,work,gotj,flag) subroutine intswap(i,j) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer i,j + integer ( kind = ip_ ) i,j C LOCAL SCALARS - integer tmp + integer ( kind = ip_ ) tmp tmp = i i = j @@ -1046,13 +1079,14 @@ subroutine intswap(i,j) subroutine dblswap(a,b) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - double precision a,b + real ( kind = rp_ ) a,b C LOCAL SCALARS - double precision tmp + real ( kind = rp_ ) tmp tmp = a a = b diff --git a/src/algencan/algencan_test.f b/src/algencan/algencan_test.F similarity index 57% rename from src/algencan/algencan_test.f rename to src/algencan/algencan_test.F index d445be3..6dfb3bc 100644 --- a/src/algencan/algencan_test.f +++ b/src/algencan/algencan_test.F @@ -1,4 +1,6 @@ -! ( Last modified on 18 Feb 2013 at 13:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 12:30 GMT. + +#include "cutest_modules.h" ! Dummy ALGENCAN for testing algencan_main interface to CUTEst ! Nick Gould, 18th February 2013 @@ -7,20 +9,21 @@ subroutine algencan(epsfeas,epsopt,efacc,eoacc,iprint,ncomp,n,x,l, +u,m,lambda,equatn,linear,coded,checkder,fu,cnormu,snorm,nlpsupn, +inform) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS logical checkder - integer inform,iprint,m,n,ncomp - double precision cnormu,efacc,eoacc,epsfeas,epsopt,fu,nlpsupn, + integer ( kind = ip_ ) inform,iprint,m,n,ncomp + real ( kind = rp_ ) cnormu,efacc,eoacc,epsfeas,epsopt,fu,nlpsupn, + snorm C ARRAY ARGUMENTS logical coded(11),equatn(m),linear(m) - double precision l(n),lambda(m),u(n),x(n) + real ( kind = rp_ ) l(n),lambda(m),u(n),x(n) - integer flag - double precision c(m) + integer ( kind = ip_ ) flag + real ( kind = rp_ ) c(m) call evalfc(n,x,fu,m,c,flag) inform=0 end diff --git a/src/algencan/cutest.com b/src/algencan/cutest.com index 30bee6b..9654233 100644 --- a/src/algencan/cutest.com +++ b/src/algencan/cutest.com @@ -4,7 +4,7 @@ C COMMON SCALARS C COMMON ARRAYS integer ccor(mmax),cmap(mmax),slaind(mmax) - double precision ca(mmax),cb(mmax) + real ( kind = rp_ ) ca(mmax),cb(mmax) C COMMON BLOCKS common /probdata/ ca,cb,ccor,cmap,slaind,mcutest,ncutest, diff --git a/src/algencan/hessdat.com b/src/algencan/hessdat.com index e59db3d..4085eee 100644 --- a/src/algencan/hessdat.com +++ b/src/algencan/hessdat.com @@ -3,7 +3,7 @@ C COMMON SCALARS C COMMON ARRAYS integer hcol(hnnzmax),hlin(hnnzmax) - double precision hval(hnnzmax) + real ( kind = rp_ ) hval(hnnzmax) C COMMON BLOCKS common /hdata/ hval,hlin,hcol,hnnz diff --git a/src/algencan/makemaster b/src/algencan/makemaster index af56513..22cfadd 100644 --- a/src/algencan/makemaster +++ b/src/algencan/makemaster @@ -1,146 +1,38 @@ # Main body of the installation makefile for CUTEst ALGENCAN interface +# Main body of the installation makefile for CUTEst UNCMIN interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 17 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-06 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = ALGENCAN -package = algencan - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = ALGENCAN +package = algencan -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - $(SED) -f $(SEDS) ../$(package)/dim.par > $(OBJ)/dim.par - $(SED) -f $(SEDS) ../$(package)/cutest.com > $(OBJ)/cutest.com - $(SED) -f $(SEDS) ../$(package)/hessdat.com > $(OBJ)/hessdat.com -# $(CP) dim.par cutest.com hessdat.com $(OBJ)/ - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f $(OBJ)/dim.par $(OBJ)/cutest.com \ - $(OBJ)/hessdat.com - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/bobyqa/bobyqa_main.f90 b/src/bobyqa/bobyqa_main.F90 similarity index 75% rename from src/bobyqa/bobyqa_main.f90 rename to src/bobyqa/bobyqa_main.F90 index ea30608..af68a33 100644 --- a/src/bobyqa/bobyqa_main.f90 +++ b/src/bobyqa/bobyqa_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 27 Jan 2013 at 17:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM BOBYQA_main @@ -6,18 +9,18 @@ PROGRAM BOBYQA_main ! Nick Gould, January 2013 - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: maxfun, lw, status, iprint, i, ierr, npt - REAL( KIND = wp ) :: rhobeg, rhoend - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+19 - REAL( KIND = wp ), DIMENSION( : ), ALLOCATABLE :: W - REAL( KIND = wp ), DIMENSION( 4 ) :: CPU - REAL( KIND = wp ), DIMENSION( 4 ) :: CALLS - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 + INTEGER ( KIND = ip_ ) :: maxfun, lw, status, iprint, i, ierr, npt + REAL( KIND = rp_ ) :: rhobeg, rhoend + REAL( KIND = rp_ ), PARAMETER :: infty = 1.0E+19_rp_ + REAL( KIND = rp_ ), DIMENSION( : ), ALLOCATABLE :: W + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CPU + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CALLS + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46, out = 6 ! open the relevant file @@ -34,12 +37,12 @@ PROGRAM BOBYQA_main CUTEST_problem_global%allocate_J = .FALSE. - CALL CUTEST_problem_setup( status, CUTEST_problem_global, input ) + CALL CUTEST_problem_setup_r( status, CUTEST_problem_global, input ) IF ( status /= 0 ) GO TO 910 ! set up the data structures necessary to hold the problem functions. - CALL CUTEST_usetup( status, input, out, io_buffer, & + CALL CUTEST_usetup_r( status, input, out, io_buffer, & CUTEST_problem_global%n, CUTEST_problem_global%x, & CUTEST_problem_global%x_l, CUTEST_problem_global%x_u ) IF ( status /= 0 ) GO TO 910 @@ -85,12 +88,12 @@ PROGRAM BOBYQA_main ! output report - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_unames( status, CUTEST_problem_global%n, & - CUTEST_problem_global%pname, & - CUTEST_problem_global%vnames ) + CALL CUTEST_unames_r( status, CUTEST_problem_global%n, & + CUTEST_problem_global%pname, & + CUTEST_problem_global%vnames ) WRITE( out, 2110 ) ( i, CUTEST_problem_global%vnames( i ), & CUTEST_problem_global%x( i ), CUTEST_problem_global%x_l( i ), & CUTEST_problem_global%x_u( i ), i = 1, CUTEST_problem_global%n ) @@ -99,10 +102,10 @@ PROGRAM BOBYQA_main ! clean-up data structures - CALL CUTEST_problem_terminate( status, CUTEST_problem_global ) + CALL CUTEST_problem_terminate_r( status, CUTEST_problem_global ) IF ( status /= 0 ) GO TO 910 DEALLOCATE( W, STAT = ierr ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP ! error returns @@ -140,20 +143,20 @@ SUBROUTINE CALFUN( n, X, f ) ! evaluates the objective function value in a format compatible with BOBYQA, ! but using the CUTEst tools. - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: n - REAL( KIND = wp ), INTENT( OUT ) :: f - REAL( KIND = wp ), INTENT( IN ) :: X( n ) - REAL( KIND = wp ), PARAMETER :: biginf = 9.0D+19 + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n + REAL( KIND = rp_ ), INTENT( OUT ) :: f + REAL( KIND = rp_ ), INTENT( IN ) :: X( n ) + REAL( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ INTEGER :: status ! Evaluate the objective function and constraints. - CALL CUTEST_ufn( status, CUTEST_problem_global%n, & - X, CUTEST_problem_global%f ) + CALL CUTEST_ufn_r( status, CUTEST_problem_global%n, & + X, CUTEST_problem_global%f ) IF ( status /= 0 ) GO TO 910 f = CUTEST_problem_global%f RETURN diff --git a/src/bobyqa/bobyqa_test.f90 b/src/bobyqa/bobyqa_test.F90 similarity index 50% rename from src/bobyqa/bobyqa_test.f90 rename to src/bobyqa/bobyqa_test.F90 index 2935f03..e53a46d 100644 --- a/src/bobyqa/bobyqa_test.f90 +++ b/src/bobyqa/bobyqa_test.F90 @@ -1,19 +1,21 @@ -! ( Last modified on 27 Jan 2013 at 17:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 11:45 GMT. + +#include "cutest_modules.h" ! Dummy BOBYQA for testing bobyqa_main interface to CUTEst ! Nick Gould, 27th January 2013 SUBROUTINE BOBYQA( n, npt, X, X_l, X_u, & rhobeg, rhoend, iprint, maxfun, W ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) + USE CUTEST_KINDS_precision ! dummy arguments - INTEGER :: n, npt, iprint, maxfun - REAL( KIND = wp ) :: rhobeg, rhoend - REAL( KIND = wp ) :: X( * ), X_l( * ), X_u( * ), W( * ) + INTEGER ( KIND = ip_ ) :: n, npt, iprint, maxfun + REAL( KIND = rp_ ) :: rhobeg, rhoend + REAL( KIND = rp_ ) :: X( * ), X_l( * ), X_u( * ), W( * ) - REAL( KIND = wp ) :: f + REAL( KIND = rp_ ) :: f CALL CALFUN( n, X, f ) RETURN diff --git a/src/bobyqa/makemaster b/src/bobyqa/makemaster index 75cb02e..71fdcab 100644 --- a/src/bobyqa/makemaster +++ b/src/bobyqa/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst BOBYQA interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 29 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = BOBYQA -package = bobyqa - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = BOBYQA +package = bobyqa -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/cg_descent/README.cg_descent b/src/cg_descent/README.cg_descent index 5f4972e..bb39573 100644 --- a/src/cg_descent/README.cg_descent +++ b/src/cg_descent/README.cg_descent @@ -119,15 +119,23 @@ BLAS = "-L/data/GotoBLAS2 -lpthread" To run with CUTEst, use the runcutest command with the -p cg_descent option. See the man page for runcutest for more details of other options. -REFERENCE ---------- - -See http://www.gnu.org/software/gsl/manual/gsl-ref.pdf (PDF) or - http://www.gnu.org/software/gsl/manual/html_node/ (HTML) - -The manual has also been published as a printed book (under the GNU Free -Documentation License), the latest edition is - - GNU Scientific Library Reference Manual - Third Edition (January 2009), - M. Galassi et al, ISBN 0954612078 (paperback) RRP $39.95. - +REFERENCES +---------- + +W. W. Hager and H. Zhang, + A new conjugate gradient method with guaranteed descent + and an efficient line search, + SIAM Journal on Optimization, 16 (2005), 170-192. + +W. W. Hager and H. Zhang, + Algorithm 851: CG_DESCENT, A conjugate gradient method with + guaranteed descent, + ACM Transactions on Mathematical Software, 32 (2006), 113-137. + +W. W. Hager and H. Zhang, + A survey of nonlinear conjugate gradient methods, + Pacific Journal of Optimization, 2 (2006), pp. 35-58. + +W. W. Hager and H. Zhang, + Limited memory conjugate gradients, + SIAM Journal on Optimization, 23 (2013), 2150-2168. diff --git a/src/cg_descent/cg_descent_main.f b/src/cg_descent/cg_descent_main.F similarity index 75% rename from src/cg_descent/cg_descent_main.f rename to src/cg_descent/cg_descent_main.F index e91dab2..1dc79ec 100644 --- a/src/cg_descent/cg_descent_main.f +++ b/src/cg_descent/cg_descent_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 2 Apr 2014 at 10:10:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM CG_DESCENT_main @@ -12,27 +15,29 @@ PROGRAM CG_DESCENT_main C to accomodate version 1.4 of CG_DESCENT. C Dominique Orban, July 2007 + USE CUTEST_KINDS_precision IMPLICIT NONE - INTEGER :: i, iter, n, nf, ng, nxpand, nsecnt - INTEGER :: status, stat - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: out = 6 - INTEGER, PARAMETER :: input = 55, inspec = 56, outcp = 57 - DOUBLE PRECISION :: f, tol, gnorm + + INTEGER ( KIND = ip_ ) :: i, iter, n, nf, ng, nxpand, nsecnt + INTEGER ( KIND = ip_ ) :: status, stat + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6, outcp = 57 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, inspec = 56 + REAL ( KIND = rp_ ) :: f, tol, gnorm LOGICAL :: bounds - DOUBLE PRECISION :: delta, sigma, epsilon, gamma,stopfa - DOUBLE PRECISION :: rho, eta, psi0, psi1, psi2, quadcu, rstrtf - DOUBLE PRECISION :: maxitf, feps, awlffct, qdecay + REAL ( KIND = rp_ ) :: delta, sigma, epsilon, gamma,stopfa + REAL ( KIND = rp_ ) :: rho, eta, psi0, psi1, psi2, quadcu, rstrtf + REAL ( KIND = rp_ ) :: maxitf, feps, awlffct, qdecay LOGICAL :: quadst, prntlv, prntfi, strule, awolfe LOGICAL :: step, prtrul, debug - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19, zero = 0.0D0 - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, G, D - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: XTEMP, GTEMP + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0D+19, zero = 0.0D0 + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, G, D + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: XTEMP, GTEMP CHARACTER ( LEN = 10 ) :: pname CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES CHARACTER ( LEN = 17 ), PARAMETER :: cgparm = 'cg_descent_f.parm' CHARACTER ( LEN = 15 ) :: spcdat - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) EXTERNAL :: CG_DESCENT_EVALF, CG_DESCENT_EVALG C Open the Spec file for the method. @@ -73,7 +78,7 @@ PROGRAM CG_DESCENT_main C Check to see if there is sufficient room - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 ALLOCATE( X( n ), G( n ), D( n ), XTEMP( n ), GTEMP( n ), @@ -82,13 +87,13 @@ PROGRAM CG_DESCENT_main C Set up SIF data. - CALL CUTEST_usetup( status, input, out, io_buffer, n, X, + CALL CUTEST_usetup_r( status, input, out, io_buffer, n, X, * XTEMP, GTEMP ) IF ( status /= 0 ) GO TO 910 C Obtain variable names. - CALL CUTEST_unames( status, N, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, N, PNAME, XNAMES ) IF ( status /= 0 ) GO TO 910 C Set up algorithmic input data. @@ -104,7 +109,7 @@ PROGRAM CG_DESCENT_main IF ( step ) THEN IF ( gnorm .LE. 0.0D+0 ) THEN - CALL CUTEST_ugr( status, N, X, G ) + CALL CUTEST_ugr_r( status, N, X, G ) IF ( status /= 0 ) GO TO 910 gnorm = 0.0D+0 DO 11 i = 1, n @@ -121,7 +126,7 @@ PROGRAM CG_DESCENT_main C Terminal exit. - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 WRITE ( out, 2010 ) f, gnorm C DO 120 i = 1, n @@ -130,7 +135,7 @@ PROGRAM CG_DESCENT_main WRITE ( out, 2000 ) pname, n, INT( CALLS(1) ), INT( CALLS(2) ), * stat, f, CPU(1), CPU(2) CLOSE( INPUT ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -169,14 +174,15 @@ SUBROUTINE CG_DESCENT_evalf( f, X, n ) C Evaluate the objective function - INTEGER :: n - DOUBLE PRECISION :: f - DOUBLE PRECISION :: X( n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ) :: X( n ) EXTERNAL CUTEST_ufn - INTEGER :: status + INTEGER ( KIND = ip_ ) :: status - CALL CUTEST_ufn( status, n, X, f ) + CALL CUTEST_ufn_r( status, n, X, f ) IF ( status /= 0 ) STOP RETURN @@ -186,12 +192,13 @@ SUBROUTINE CG_DESCENT_evalg( G, X, n ) C Evaluate the gradiuent of the objective function - INTEGER :: n - DOUBLE PRECISION :: X( n ), G( n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: X( n ), G( n ) EXTERNAL CUTEST_ugr - INTEGER :: status + INTEGER ( KIND = ip_ ) :: status - CALL CUTEST_ugr( status, N, X, G ) + CALL CUTEST_ugr_r( status, N, X, G ) IF ( status /= 0 ) STOP RETURN diff --git a/src/cg_descent/cg_descent_main.c b/src/cg_descent/cg_descent_main.c index 6fd5782..46646a0 100644 --- a/src/cg_descent/cg_descent_main.c +++ b/src/cg_descent/cg_descent_main.c @@ -1,3 +1,5 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-02 AT 14:30 GMT */ + /* ==================================================== * CUTEst interface for cg_descent April. 5, 2014 * @@ -27,6 +29,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ */ #include "cutest.h" +#include "cutest_routines.h" #include "cg_user.h" /* @@ -38,23 +41,23 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ */ /* prototypes */ -double cg_value +rp_ cg_value ( - double *x, + rp_ *x, INT n ) ; void cg_grad ( - double *g, - double *x, + rp_ *g, + rp_ *x, INT n ) ; -double cg_valgrad +rp_ cg_valgrad ( - double *g, - double *x, + rp_ *g, + rp_ *x, INT n ) ; @@ -68,24 +71,24 @@ double cg_valgrad /* wall clock: */ /* struct timeval tv ; int sec, usec ; - double walltime ; */ + rp_ walltime ; */ char *fname = "OUTSDIF.d"; /* CUTEst data file */ integer funit = 42; /* FORTRAN unit number for OUTSDIF.d */ integer io_buffer = 11; /* FORTRAN unit for internal i/o */ integer iout = 6; /* FORTRAN unit number for error output */ integer ierr; /* Exit flag from OPEN and CLOSE */ integer status; /* Exit flag from CUTEst tools */ - double grad_tol = 1.e-6; /* required gradient tolerance */ + rp_ grad_tol = 1.e-6; /* required gradient tolerance */ VarTypes vtypes; integer ncon_dummy ; - doublereal *x, *bl, *bu ; + rp_ *x, *bl, *bu ; char *pname, *vnames ; logical efirst = FALSE_, lfirst = FALSE_, nvfrst = FALSE_, grad; logical constrained = FALSE_; - doublereal calls[7], cpu[4]; + rp_ calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; integer ExitCode; int i, status_cg_descent ; @@ -100,6 +103,7 @@ double cg_valgrad /* Open problem description file OUTSDIF.d */ ierr = 0; + printf("a\n") ; FORTRAN_open( &funit, fname, &ierr ) ; if( ierr ) { printf("Error opening file OUTSDIF.d.\nAborting.\n") ; @@ -109,7 +113,7 @@ double cg_valgrad /* Get problem name (this works under gfortran, but not all compilers*/ /* MALLOC( pname, FSTRING_LEN+1, char ); - CUTEST_pname( &status, &funit, pname ) ; + CUTEST_pname_r( &status, &funit, pname ) ; if (status) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -126,7 +130,7 @@ double cg_valgrad /* printf (" ** the problem is %s\n", pname ) ; */ /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon) ; + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon) ; if (status) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -147,11 +151,11 @@ double cg_valgrad /* Reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC( x, CUTEst_nvar, doublereal ) ; - MALLOC( bl, CUTEst_nvar, doublereal ) ; - MALLOC( bu, CUTEst_nvar, doublereal ) ; - CUTEST_usetup( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, - x, bl, bu ) ; + MALLOC( x, CUTEst_nvar, rp_ ) ; + MALLOC( bl, CUTEst_nvar, rp_ ) ; + MALLOC( bu, CUTEst_nvar, rp_ ) ; + CUTEST_usetup_r( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, + x, bl, bu ) ; if (status) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -160,7 +164,7 @@ double cg_valgrad /* Get problem name */ MALLOC( pname, FSTRING_LEN+1, char ); - CUTEST_probname( &status, pname ) ; + CUTEST_probname_r( &status, pname ) ; if (status) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -177,7 +181,7 @@ double cg_valgrad /*printf ("Problem: %s (n = %i)\n", pname, CUTEst_nvar ) ;*/ /* MALLOC(vnames, CUTEst_nvar*FSTRING_LEN, char); - CUTEST_unames( &status, &CUTEst_nvar, pname, vnames); + CUTEST_unames_r( &status, &CUTEst_nvar, pname, vnames); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -199,6 +203,12 @@ double cg_valgrad spec = fopen ("CG_DESCENT.SPC", "r") ; +#ifdef CUTEST_SINGLE + char pg[ ]="%g"; +#else + char pg[ ]="%lg"; +#endif + if ( spec != NULL ) { while (fgets (s, MAXLINE, spec) != (char *) NULL) @@ -208,7 +218,7 @@ double cg_valgrad sl = strlen("grad_tol") ; if (strncmp (s, "grad_tol", sl) == 0) { - sscanf (s+sl, "%lg", &grad_tol) ; + sscanf (s+sl, pg, &grad_tol) ; continue ; } sl = strlen("PrintFinal") ; @@ -256,19 +266,19 @@ double cg_valgrad sl = strlen("eta0") ; if (strncmp (s, "eta0", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.eta0) ; + sscanf (s+sl, pg, &cg_parm.eta0) ; continue ; } sl = strlen("eta1") ; if (strncmp (s, "eta1", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.eta1) ; + sscanf (s+sl, pg, &cg_parm.eta1) ; continue ; } sl = strlen("eta2") ; if (strncmp (s, "eta2", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.eta2) ; + sscanf (s+sl, pg, &cg_parm.eta2) ; continue ; } sl = strlen("AWolfe") ; @@ -280,13 +290,13 @@ double cg_valgrad sl = strlen("AWolfeFac") ; if (strncmp (s, "AWolfeFac", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.AWolfeFac) ; + sscanf (s+sl, pg, &cg_parm.AWolfeFac) ; continue ; } sl = strlen("Qdecay") ; if (strncmp (s, "Qdecay", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.Qdecay) ; + sscanf (s+sl, pg, &cg_parm.Qdecay) ; continue ; } sl = strlen("StopRule") ; @@ -298,7 +308,7 @@ double cg_valgrad sl = strlen("StopFac") ; if (strncmp (s, "StopFac", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.StopFac) ; + sscanf (s+sl, pg, &cg_parm.StopFac) ; continue ; } sl = strlen("PertRule") ; @@ -310,13 +320,13 @@ double cg_valgrad sl = strlen("eps") ; if (strncmp (s, "eps", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.eps) ; + sscanf (s+sl, pg, &cg_parm.eps) ; continue ; } sl = strlen("egrow") ; if (strncmp (s, "egrow", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.egrow) ; + sscanf (s+sl, pg, &cg_parm.egrow) ; continue ; } sl = strlen("QuadStep") ; @@ -328,13 +338,13 @@ double cg_valgrad sl = strlen("QuadCutOff") ; if (strncmp (s, "QuadCutOff", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.QuadCutOff) ; + sscanf (s+sl, pg, &cg_parm.QuadCutOff) ; continue ; } sl = strlen("QuadSafe") ; if (strncmp (s, "QuadSafe", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.QuadSafe) ; + sscanf (s+sl, pg, &cg_parm.QuadSafe) ; continue ; } sl = strlen("UseCubic") ; @@ -346,13 +356,13 @@ double cg_valgrad sl = strlen("CubicCutOff") ; if (strncmp (s, "CubicCutOff", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.CubicCutOff) ; + sscanf (s+sl, pg, &cg_parm.CubicCutOff) ; continue ; } sl = strlen("SmallCost") ; if (strncmp (s, "SmallCost", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.SmallCost) ; + sscanf (s+sl, pg, &cg_parm.SmallCost) ; continue ; } sl = strlen("debug") ; @@ -364,13 +374,13 @@ double cg_valgrad sl = strlen("debugtol") ; if (strncmp (s, "debugtol", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.debugtol) ; + sscanf (s+sl, pg, &cg_parm.debugtol) ; continue ; } sl = strlen("step") ; if (strncmp (s, "step", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.step) ; + sscanf (s+sl, pg, &cg_parm.step) ; continue ; } sl = strlen("maxit") ; @@ -388,19 +398,19 @@ double cg_valgrad sl = strlen("ExpandSafe") ; if (strncmp (s, "ExpandSafe", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.ExpandSafe) ; + sscanf (s+sl, pg, &cg_parm.ExpandSafe) ; continue ; } sl = strlen("SecantAmp") ; if (strncmp (s, "SecantAmp", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.SecantAmp) ; + sscanf (s+sl, pg, &cg_parm.SecantAmp) ; continue ; } sl = strlen("RhoGrow") ; if (strncmp (s, "RhoGrow", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.RhoGrow) ; + sscanf (s+sl, pg, &cg_parm.RhoGrow) ; continue ; } sl = strlen("neps") ; @@ -424,25 +434,25 @@ double cg_valgrad sl = strlen("restart_fac") ; if (strncmp (s, "restart_fac", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.restart_fac) ; + sscanf (s+sl, pg, &cg_parm.restart_fac) ; continue ; } sl = strlen("feps") ; if (strncmp (s, "feps", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.feps) ; + sscanf (s+sl, pg, &cg_parm.feps) ; continue ; } sl = strlen("nan_rho") ; if (strncmp (s, "nan_rho", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.nan_rho) ; + sscanf (s+sl, pg, &cg_parm.nan_rho) ; continue ; } sl = strlen("nan_decay") ; if (strncmp (s, "nan_decay", sl) == 0) { - sscanf (s+sl, "%lg", &cg_parm.nan_decay) ; + sscanf (s+sl, pg, &cg_parm.nan_decay) ; continue ; } } @@ -458,12 +468,12 @@ double cg_valgrad status_cg_descent = cg_descent (x, CUTEst_nvar, &Stats, &cg_parm, grad_tol, cg_value, cg_grad, cg_valgrad, NULL) ; /* gettimeofday (&tv, NULL) ; - walltime = tv.tv_sec - sec + (double) (tv.tv_usec - usec) /1.e6 ;*/ + walltime = tv.tv_sec - sec + (rp_) (tv.tv_usec - usec) /1.e6 ;*/ ExitCode = 0; /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu) ; + CUTEST_creport_r( &status, calls, cpu) ; if (status) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -505,7 +515,7 @@ double cg_valgrad FREE( pname ) ; FREE( x ) ; FREE( bl ) ; FREE( bu ) ; - CUTEST_uterminate( &status ) ; + CUTEST_uterminate_r( &status ) ; return 0; } @@ -513,16 +523,16 @@ double cg_valgrad #ifdef __cplusplus } /* Closing brace for extern "C" block */ #endif -double cg_value +rp_ cg_value ( - double *x, + rp_ *x, INT n ) { - double f ; + rp_ f ; integer status; - CUTEST_ufn( &status, &CUTEst_nvar, x, &f) ; + CUTEST_ufn_r( &status, &CUTEst_nvar, x, &f) ; if ((status == 1) || (status == 2)) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); @@ -533,31 +543,31 @@ double cg_value void cg_grad ( - double *g, - double *x, + rp_ *g, + rp_ *x, INT n ) { integer status; - CUTEST_ugr( &status, &CUTEst_nvar, x, g) ; + CUTEST_ugr_r( &status, &CUTEst_nvar, x, g) ; if ((status == 1) || (status == 2)) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); } } -double cg_valgrad +rp_ cg_valgrad ( - double *g, - double *x, + rp_ *g, + rp_ *x, INT n ) { logical grad ; - double f ; + rp_ f ; integer status; grad = 1 ; - CUTEST_uofg( &status, &CUTEst_nvar, x, &f, g, &grad ) ; + CUTEST_uofg_r( &status, &CUTEst_nvar, x, &f, g, &grad ) ; if ((status == 1) || (status == 2)) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); diff --git a/src/cg_descent/cg_descent_test.f b/src/cg_descent/cg_descent_test.F similarity index 56% rename from src/cg_descent/cg_descent_test.f rename to src/cg_descent/cg_descent_test.F index db662d5..facd5ea 100644 --- a/src/cg_descent/cg_descent_test.f +++ b/src/cg_descent/cg_descent_test.F @@ -1,14 +1,19 @@ -C ( Last modified on 4 Jan 2013 at 14:10:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" C Dummy CG_DECSCENT for testing cg_descent_main interface to CUTEst + C Nick Gould, 4th January 2013 SUBROUTINE CG_DESCENT( tol, X, n, EVALF, EVALG, stat, gnorm, f, * iter, nf, ng, D, G, XTEMP, GTEMP ) - INTEGER n, iter, nf, ng, stat - DOUBLE PRECISION f, tol, gnorm - EXTERNAL EVALF, EVALG - DOUBLE PRECISION :: X( n ), G( n ), D( n ), XTEMP( n ), GTEMP( n ) + USE CUTEST_KINDS_precision + INTEGER :: n, iter, nf, ng, stat + REAL ( KIND = rp_ ) :: f, tol, gnorm + EXTERNAL EVALF, EVALG + REAL ( KIND = rp_ ) :: X( n ), G( n ), D( n ) + REAL ( KIND = rp_ ) :: XTEMP( n ), GTEMP( n ) WRITE( 6, "( ' Calling CG_DESCENT_dummy with n = ', I0 )" ) n CALL EVALF( f, X, n ) diff --git a/src/cg_descent/cg_descent_test.c b/src/cg_descent/cg_descent_test.c index 5bcb881..57c7d8e 100644 --- a/src/cg_descent/cg_descent_test.c +++ b/src/cg_descent/cg_descent_test.c @@ -1,3 +1,5 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-02 AT 14:30 GMT */ + #include #include #include @@ -5,6 +7,8 @@ #include #include +#include "cutest.h" + #define INT long int #define INT_INF LONG_MAX #define INF DBL_MAX @@ -38,8 +42,8 @@ void cg_default typedef struct cg_stats_struct /* statistics returned to user */ { - double f ; /*function value at solution */ - double gnorm ; /* max abs component of gradient */ + rp_ f ; /*function value at solution */ + rp_ gnorm ; /* max abs component of gradient */ INT iter ; /* number of iterations */ INT IterSub ; /* number of subspace iterations */ INT NumSub ; /* total number subspaces */ @@ -63,18 +67,18 @@ int cg_descent /* return status of solution process: 11 (function nan or +-INF and could not be repaired) 12 (invalid choice for memory parameter) */ ( - double *x, /* input: starting guess, output: the solution */ + rp_ *x, /* input: starting guess, output: the solution */ INT n, /* problem dimension */ cg_stats *Stat, /* structure with statistics (can be NULL) */ cg_parameter *UParm, /* user parameters, NULL = use default parameters */ - double grad_tol, /* StopRule = 1: |g|_infty <= max (grad_tol, + rp_ grad_tol, /* StopRule = 1: |g|_infty <= max (grad_tol, StopFac*initial |g|_infty) [default] StopRule = 0: |g|_infty <= grad_tol(1+|f|) */ - double (*value) (double *, INT), /* f = value (x, n) */ - void (*grad) (double *, double *, INT), /* grad (g, x, n) */ - double (*valgrad) (double *, double *, INT), /* f = valgrad (g, x, n), + rp_ (*value) (rp_ *, INT), /* f = value (x, n) */ + void (*grad) (rp_ *, rp_ *, INT), /* grad (g, x, n) */ + rp_ (*valgrad) (rp_ *, rp_ *, INT), /* f = valgrad (g, x, n), NULL = compute value & gradient using value & grad */ - double *Work /* NULL => let code allocate memory + rp_ *Work /* NULL => let code allocate memory not NULL => use array Work for required memory The amount of memory needed depends on the value of the parameter memory in the Parm structure. @@ -84,9 +88,9 @@ int cg_descent /* return status of solution process: ) { int status, i ; - double f, gnorm, t, gi ; - double *g ; - g = (double *) malloc (n*sizeof (double)) ; + rp_ f, gnorm, t, gi ; + rp_ *g ; + g = (rp_ *) malloc (n*sizeof (rp_)) ; printf (" Calling dummy cg_descent\n"); f = value (x, n); diff --git a/src/cg_descent/makemaster b/src/cg_descent/makemaster index 87206c0..6f09986 100644 --- a/src/cg_descent/makemaster +++ b/src/cg_descent/makemaster @@ -1,181 +1,37 @@ # Main body of the installation makefile for CUTEst CG_DESCENT interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 2 4 2014 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = CG_DESCENT -package = cg_descent - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +include $(CUTEST)/src/makedefs/defaults -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# package name -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -$(PACKAGE)_fortran = $(OBJ)/$(package)_main_fortran.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d -# - valgrind -v --tool=memcheck --leak-check=yes --show-reachable=yes --track-origins=yes $(OBJ)/run_test -# - $(OBJ)/run_test - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -run_test_fortran: tools test_cutest_unconstrained $(package) \ - $(OBJ)/$(package)_test_fortran.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main_fortran.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations +PACKAGE = CG_DESCENT +package = cg_descent -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.c > \ - $(OBJ)/$(package)_test.c - cd $(OBJ); $(CC) -o $(package)_test.o $(CFLAGS) \ - $(package)_test.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_test.o $(CFLAGSN) $(package)_test.c ) - $(RM) $(OBJ)/$(package)_test.c - @printf '[ OK ]\n' +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -$(OBJ)/$(package)_test_fortran.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test_fortran.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test_fortran.o \ - $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +# include standard CUTEst makefile definitions -# CUTEst interface main programs +include $(CUTEST)/src/makedefs/definitions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.c > \ - $(OBJ)/$(package)_main.c - cd $(OBJ); $(CC) -o $(package)_main.o $(CFLAGS) $(package)_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_main.o $(CFLAGSN) $(package)_main.c ) - $(RM) $(OBJ)/$(package)_main.c - @printf '[ OK ]\n' +# include compilation and run instructions -$(OBJ)/$(package)_main_fortran.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main_fortran.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main_fortran.o $(FFLAGS77N) \ - $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/cgplus/cgplus_main.f b/src/cgplus/cgplus_main.F similarity index 78% rename from src/cgplus/cgplus_main.f rename to src/cgplus/cgplus_main.F index a51c993..19bc0ec 100644 --- a/src/cgplus/cgplus_main.f +++ b/src/cgplus/cgplus_main.F @@ -1,6 +1,9 @@ -C ( Last modified on 2 Jan 2013 at 15:10:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 14:40 GMT. - PROGRAM CGPLUS_main +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM CGPLUS_main C CG+ test driver for problems derived from SIF files. @@ -8,19 +11,22 @@ PROGRAM CGPLUS_main C July 2004 C Revised for CUTEst, January 2013 - INTEGER :: n, maxit, status, iflag, IPRINT( 2 ) - INTEGER :: lp, mp, i, method, iter, nfun, irest - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: out = 6, input = 55, inspec = 56 - DOUBLE PRECISION :: f, eps, gnorm, tlev - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19, zero = 0.0D0 + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, maxit, status, iflag, IPRINT( 2 ) + INTEGER ( KIND = ip_ ) :: lp, mp, i, method, iter, nfun, irest + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6, input = 55 + INTEGER ( KIND = ip_ ), PARAMETER :: inspec = 56 + REAL ( KIND = rp_ ) :: f, eps, gnorm, tlev + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ LOGICAL :: bounds, finish - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, G, D, GOLD, W + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, W, D + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: G, GOLD CHARACTER ( LEN = 10 ) :: pname, spcdat CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES COMMON / CGDD / mp, lp COMMON / RUNINF / iter, nfun - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) C C Open the Spec file for the method. @@ -52,7 +58,7 @@ PROGRAM CGPLUS_main C Check to see if there is sufficient room - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 ALLOCATE( X( n ), G( n ), D( n ), GOLD( n ), W( n ), XNAMES( n ), @@ -61,12 +67,13 @@ PROGRAM CGPLUS_main C Set up SIF data. - CALL CUTEST_usetup( status, input, out, io_buffer, n, X, W, GOLD ) + CALL CUTEST_usetup_r( status, input, out, io_buffer, n, X, + * W, GOLD ) IF ( status /= 0 ) GO TO 910 C Obtain variable names. - CALL CUTEST_unames( status, N, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, N, PNAME, XNAMES ) IF ( status /= 0 ) GO TO 910 C Set up algorithmic input data. @@ -90,7 +97,7 @@ PROGRAM CGPLUS_main C Evaluate the function and gradient - CALL CUTEST_uofg( status, n, X, f, G, .TRUE. ) + CALL CUTEST_uofg_r( status, n, X, f, G, .TRUE. ) IF ( status /= 0 ) GO TO 910 C Call the optimizer. @@ -108,7 +115,7 @@ PROGRAM CGPLUS_main C the parameter 'FINISH' must be set to 'TRUE' when the test is satisfied. IF ( iflag .EQ. 2 ) THEN - tlev = eps * ( 1.0D+0 + ABS( f ) ) + tlev = eps * ( 1.0E+0_rp_ + ABS( f ) ) DO 40 i = 1, n IF( ABS( G( i ) ) .GT. tlev ) GO TO 30 40 CONTINUE @@ -119,9 +126,9 @@ PROGRAM CGPLUS_main C Terminal exit. - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - gnorm = zero + gnorm = 0.0_rp_ DO 110 i = 1, n gnorm = MAX( gnorm, ABS( G( i ) ) ) 110 CONTINUE @@ -133,7 +140,7 @@ PROGRAM CGPLUS_main WRITE ( out, 2000 ) pname, n, INT( CALLS(1) ), INT( CALLS(2) ), * iflag, F, CPU(1), CPU(2) CLOSE( input ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE diff --git a/src/cgplus/cgplus_test.F b/src/cgplus/cgplus_test.F new file mode 100644 index 0000000..9cab49c --- /dev/null +++ b/src/cgplus/cgplus_test.F @@ -0,0 +1,18 @@ +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 14:40 GMT. + +#include "cutest_modules.h" + +C Dummy CGFAM for testing cgplus_main interface to CUTEst +C Nick Gould, 4th January 2013 + + SUBROUTINE CGFAM( n, X, f, G, D, GOLD, IPRINT, eps, W, + * iflag, irest, method, finish ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n, iflag, irest, method, IPRINT( 2 ) + REAL ( KIND = rp_ ) f, eps + LOGICAL finish + REAL ( KIND = rp_ ) X( n ), G( n ), D( n ), GOLD( n ), W( n ) + + iflag = iflag + 1 + RETURN + END diff --git a/src/cgplus/cgplus_test.f b/src/cgplus/cgplus_test.f deleted file mode 100644 index be1396a..0000000 --- a/src/cgplus/cgplus_test.f +++ /dev/null @@ -1,15 +0,0 @@ -C ( Last modified on 4 Jan 2013 at 14:45:00 ) - -C Dummy CGFAM for testing cgplus_main interface to CUTEst -C Nick Gould, 4th January 2013 - - SUBROUTINE CGFAM( n, X, f, G, D, GOLD, IPRINT, eps, W, - * iflag, irest, method, finish ) - INTEGER n, iflag, irest, method, IPRINT( 2 ) - DOUBLE PRECISION f, eps - LOGICAL finish - DOUBLE PRECISION X( n ), G( n ), D( n ), GOLD( n ), W( n ) - - iflag = iflag + 1 - RETURN - END diff --git a/src/cgplus/makemaster b/src/cgplus/makemaster index 7529ebf..ffcbef0 100644 --- a/src/cgplus/makemaster +++ b/src/cgplus/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst CGPLUS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 4 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-06 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = CGPLUS -package = cgplus - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = CGPLUS +package = cgplus -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/cobyla/cobyla77_main.f b/src/cobyla/cobyla77_main.f deleted file mode 100644 index 34e59b2..0000000 --- a/src/cobyla/cobyla77_main.f +++ /dev/null @@ -1,248 +0,0 @@ -C ( Last modified on 3 Jan 2013 at 13:40:00 ) - PROGRAM COBMA -C -C COBYLA test driver for problems derived from SIF files. -C -C A. R. Conn and Ph. Toint (based upon Nick Gould's vf13ma.f) -C January 1995. -C - INTEGER M, N, MAXFUN, MCON, LW, LIW - INTEGER IPRINT, I, MGEQ, INDR, INPUT, IOUT, NFIX - INTEGER :: io_buffer = 11 - DOUBLE PRECISION RHOBEG, RHOEND, F - - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IW - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, C - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: CL, CU, W - LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR - - DOUBLE PRECISION CPU( 4 ), CALLS( 4 ) - - CHARACTER ( LEN = 10 ) :: PNAME - CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAME - CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: CNAME - - PARAMETER ( INPUT = 55, INDR = 46, IOUT = 6 ) - DOUBLE PRECISION BIGINF - PARAMETER ( BIGINF = 9.0D+19 ) - COMMON / FCOBFN / BL, BU, CL, CU, MGEQ, MCON -C -C Open the relevant file. -C - - OPEN ( INPUT, FILE = 'OUTSDIF.d', FORM = 'FORMATTED', - * STATUS = 'OLD' ) - REWIND INPUT - -C allocate space - - CALL CUTEST_udimen( status, INPUT, N, MCON ) - IF ( status /= 0 ) GO TO 910 - - lw = n * ( 3 * n + 2 * mcon + 11 ) + 4 * mcon + 6 - liw = n + 1 - ALLOCATE( X( n ), BL( n ), BU( n ), C( mcon ), CL( mcon ), - * CU( mcon ), IW( liw ), W( lw ), EQUATN( MCON ), - * LINEAR( MCON ), VNAME( N ), CNAME( MCON ), - * STAT = status ) - IF ( status /= 0 ) GO TO 990 -C -C Set up the data structures necessary to hold the problem functions. -C - CALL CUTEST_csetup( status, INPUT, IOUT, io_buffer, n, mcon, X, - * BL, BU, C, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) - IF ( status /= 0 ) GO TO 910 - CLOSE ( INPUT ) -C -C Count the number of general equality constraints and ignore them by -C shifting the remaining constraints at the beginning of the constraints' list -C - MGEQ = 0 - DO 20 I = 1, MCON - IF ( EQUATN( I ) ) MGEQ = MGEQ + 1 - 20 CONTINUE - IF ( MGEQ .GT. 0 ) THEN - WRITE( 6, 3090 ) MGEQ - DO 30 I = MCON, MGEQ + 1, -1 - CU( I - MGEQ ) = CU( I ) - CL( I - MGEQ ) = CL( I ) - 30 CONTINUE - END IF - M = MCON - MGEQ -C -C If constraints have both lower and upper bounds, they have to be -C included twice! -C - DO 40 I = 1, MCON - MGEQ - IF ( CL( I ) .GT. - BIGINF .AND. - * CU( I ) .LT. BIGINF ) M = M + 1 - 40 CONTINUE -C -C Include any simple bounds. -C - NFIX = 0 - DO 50 I = 1, N - IF ( BL( I ) .EQ. BU( I ) ) THEN - NFIX = NFIX + 1 - ELSE - IF ( BL( I ) .GT. - BIGINF ) M = M + 1 - IF ( BU( I ) .LT. BIGINF ) M = M + 1 - END IF - 50 CONTINUE - IF ( NFIX .GT. 0 ) WRITE( 6, 3020 ) NFIX -C -C Open the Spec file for the method. -C - OPEN( INDR, FILE = 'COBYLA.SPC', FORM = 'FORMATTED', - * STATUS = 'OLD') - REWIND INDR -C -C Read input Spec data. -C -C RHOBEG = the size of the simplex initially -C RHOEND = the size of the simplex at termination -C MAXFUN = the maximum number of function calls allowed. -C IPRINT should be set to 0, 1, 2 or 3, it controls the amount of printing. -C -C Set up algorithmic input data. -C - READ ( INDR, 1000 ) RHOBEG, RHOEND, MAXFUN, IPRINT - CLOSE ( INDR ) -C -C Evaluate the objective function and constraints. -C - CALL CALCFC( N, X, F, C ) -C -C Perform the minimization. -C - CALL COBYLA( N, M, X, RHOBEG, RHOEND, IPRINT, MAXFUN, W, IW) - CALL CUTEST_creport( status, CALLS, CPU ) - IF ( status /= 0 ) GO TO 910 -C - CALL CUTEST_cnames( status, N, MCON, PNAME, VNAME, CNAME ) - IF ( status /= 0 ) GO TO 910 - CALL CALCFC( N, X, F, C ) - WRITE( 6, 2110 ) ( I, VNAME( I ), X( I ), BL( I ), BU( I ), - * I = 1, N ) - IF ( MCON .GT. 0 ) WRITE( 6, 2120 ) ( I, CNAME( I ), C( I ), - * CL( I ), CU( I ), LINEAR( I ), I = 1, MCON ) - WRITE( 6, 2000 ) PNAME, N, MCON, CALLS(1), CALLS(5), F, - * CPU(1), CPU(2) - STOP - - 910 CONTINUE - WRITE( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") - * status - STOP - - 990 CONTINUE - WRITE( 6, "( ' Allocation error, status = ', I0 )" ) status - STOP -C -C Non-executable statements -C - 2000 FORMAT( /, 24('*'), ' CUTEst statistics ', 24('*') // - * ,' Code used : COBYLA ', / - * ,' Problem : ', A10, / - * ,' # variables = ', I10 / - * ,' # constraints = ', I10 / - * ,' # objective functions = ', F8.2 / - * ,' # constraints functions = ', F8.2 / - * ,' Final f = ', E15.7 / - * ,' Set up time = ', 0P, F10.2, ' seconds' / - * ' Solve time = ', 0P, F10.2, ' seconds' // - * 66('*') / ) - 1000 FORMAT( D12.4, /, D12.4, /,I6, /, I6 ) - 2110 FORMAT( /, ' The variables:', /, - * ' I name value lower bound upper bound', - * /, ( I6, 1X, A10, 1P, 3D12.4 ) ) - 2120 FORMAT( /, ' The constraints:', /, - * ' I name value lower bound upper bound', - * ' linear? ', - * /, ( I6, 1X, A10, 1P, 3D12.4, 5X, L1 ) ) - 3000 FORMAT( /,' ** Program CSETUP: array length ', A6, ' too small.', - * /,' -- Miminimization abandoned.', - * /,' -- Increase the parameter ', A6, ' by at least ', I8, - * ' and restart.' ) - 3020 FORMAT( /,' ** Warning from COBMA. **', - * /,' In the problem as stated , ', I6, - * ' variables are fixed: they are changed to free.' ) - 3090 FORMAT( /,' ** Warning from COBMA. **', - * /,' The problem as stated includes ', I6, - * ' equality constraints: they are ignored ' ) -C -C End of COBMA. -C - END - SUBROUTINE CALCFC( N, X, F, C ) -C -C Evaluates the objective function value in a format compatible with COBYLA, -C but using the CUTEst tools. -C -C A. R. Conn and Ph. Toint -C January 1995. -C - INTEGER N, MGEQ, MCON, I, MT - DOUBLE PRECISION F, X( N ), C( MCON ), BL( n ), BU( n ) - DOUBLE PRECISION CL( MCON ), CU( MCON ) - COMMON /FCOBFN/ BL, BU, CL, CU, MGEQ, MCON -C - DOUBLE PRECISION BIGINF - PARAMETER ( BIGINF = 9.0D+19 ) -C -C Evaluate the objective function and constraints. -C - CALL CUTEST_cfn( status, N, MCON, X, F, C ) - IF ( status /= 0 ) GO TO 910 -C -C If there are equality constraints, ignore them -C and shift all the inequality constraint values. -C - IF ( MGEQ .GT. 0 ) THEN - DO 10 I = MCON, MGEQ + 1, - 1 - C( I - MGEQ ) = C( I ) - 10 CONTINUE - END IF -C -C If constraints have both lower and upper bounds, they have to -C be included twice! Reverse the signs of less-than-or-equal-to -C constraints. -C - MT = MCON - MGEQ + 1 - DO 40 I = 1, MCON - MGEQ - IF ( CL( I ) .GT. - BIGINF .AND. - * CU( I ) .LT. BIGINF ) THEN - C( I ) = CU( I ) - C( I ) - C( MT ) = C( I ) - CL( I ) - MT = MT + 1 - ELSE IF ( CL( I ) .GT. - BIGINF ) THEN - C( I ) = C( I ) - CL( I ) - ELSE IF ( CU( I ) .LT. BIGINF ) THEN - C( I ) = CU( I ) - C( I ) - END IF - 40 CONTINUE -C -C Include any simple bounds, including fixed variables. -C - DO 50 I = 1, N - IF ( BL( I ) .NE. BU( I ) ) THEN - IF ( BL( I ) .GT. - BIGINF ) THEN - C( MT ) = X( I ) - BL( I ) - MT = MT + 1 - END IF - IF ( BU( I ) .LT. BIGINF ) THEN - C( MT ) = BU( I ) - X( I ) - MT = MT + 1 - END IF - END IF - 50 CONTINUE - RETURN - - 910 CONTINUE - WRITE( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") status - STOP - -C -C End of CALCFC. -C - END diff --git a/src/cobyla/cobyla_main.f90 b/src/cobyla/cobyla_main.F90 similarity index 82% rename from src/cobyla/cobyla_main.f90 rename to src/cobyla/cobyla_main.F90 index dad7a8d..347843d 100644 --- a/src/cobyla/cobyla_main.f90 +++ b/src/cobyla/cobyla_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 3 Jan 2013 at 13:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM COBYLA_main @@ -9,19 +12,20 @@ PROGRAM COBYLA_main ! Fortran 90/95 version, D. Orban, December 2006 ! Revised for CUTEst, Nick Gould, January 2013 - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: m, maxfun, lw, liw, status, iprint, i, mgeq, nfix, ierr - INTEGER, DIMENSION(:), ALLOCATABLE :: IW - REAL( KIND = wp ) :: rhobeg, rhoend - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+19 - REAL( KIND = wp ), DIMENSION(:), ALLOCATABLE :: W - REAL( KIND = wp ), DIMENSION( 4 ) :: CPU - REAL( KIND = wp ), DIMENSION( 7 ) :: CALLS - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 + INTEGER ( KIND = ip_ ) :: m, maxfun, lw, liw, status, iprint + INTEGER ( KIND = ip_ ) :: i, mgeq, nfix, ierr + INTEGER ( KIND = ip_ ) , DIMENSION( : ), ALLOCATABLE :: IW + REAL( KIND = rp_ ) :: rhobeg, rhoend + REAL( KIND = rp_ ), PARAMETER :: infty = 1.0E+19_rp_ + REAL( KIND = rp_ ), DIMENSION( : ), ALLOCATABLE :: W + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CPU + REAL( KIND = rp_ ), DIMENSION( 7 ) :: CALLS + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ) , PARAMETER :: input = 55, indr = 46, out = 6 ! open the relevant file @@ -38,12 +42,12 @@ PROGRAM COBYLA_main CUTEST_problem_global%allocate_J = .FALSE. - CALL CUTEST_problem_setup( status, CUTEST_problem_global, input ) + CALL CUTEST_problem_setup_r( status, CUTEST_problem_global, input ) IF ( status /= 0 ) GO TO 910 ! set up the data structures necessary to hold the problem functions. - CALL CUTEST_csetup( status, input, out, io_buffer, & + CALL CUTEST_csetup_r( status, input, out, io_buffer, & CUTEST_problem_global%n, CUTEST_problem_global%m, & CUTEST_problem_global%x, CUTEST_problem_global%x_l, & CUTEST_problem_global%x_u, CUTEST_problem_global%y, & @@ -121,10 +125,10 @@ PROGRAM COBYLA_main ! output report - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_cnames( status, CUTEST_problem_global%n, & + CALL CUTEST_cnames_r( status, CUTEST_problem_global%n, & CUTEST_problem_global%m, & CUTEST_problem_global%pname, & CUTEST_problem_global%vnames, & @@ -142,11 +146,11 @@ PROGRAM COBYLA_main ! clean-up data structures - CALL CUTEST_problem_terminate( status, CUTEST_problem_global ) + CALL CUTEST_problem_terminate_r( status, CUTEST_problem_global ) IF ( status /= 0 ) GO TO 910 DEALLOCATE( IW, STAT = ierr ) DEALLOCATE( W, STAT = ierr ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP ! error returns @@ -180,12 +184,12 @@ PROGRAM COBYLA_main ' i name value lower bound upper bound', & ' linear? ', & /, ( I6, 1X, A10, 1P, 3D12.4, 5X, L1 ) ) -3020 FORMAT( /,' ** Warning from COBYLA_main. **', & - /,' In the problem as stated , ', I0, & - ' variables are fixed: they are changed to free.' ) -3090 FORMAT( /,' ** Warning from COBYLA_main. **', & +3020 FORMAT( /,' ** Warning from COBYLA_main **', & + /,' In the problem as stated, ', I0, & + ' variable(s) are fixed', /, ' - they are changed to free' ) +3090 FORMAT( /,' ** Warning from COBYLA_main **', & /,' The problem as stated includes ', I0, & - ' equality constraints: they are ignored ' ) + ' equality constraint(s)', /, ' - they are ignored' ) ! End of COBYLA_main @@ -196,20 +200,20 @@ SUBROUTINE CALCFC( n, m, X, f, C ) ! evaluates the objective function value in a format compatible with COBYLA, ! but using the CUTEst tools. - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: n, m - REAL( KIND = wp ), INTENT( OUT ) :: f - REAL( KIND = wp ), INTENT( IN ) :: X( n ) - REAL( KIND = wp ), INTENT( OUT ) :: C( m ) - REAL( KIND = wp ), PARAMETER :: biginf = 9.0D+19 + INTEGER ( KIND = ip_ ) , INTENT( IN ) :: n, m + REAL ( KIND = rp_ ), INTENT( OUT ) :: f + REAL ( KIND = rp_ ), INTENT( IN ) :: X( n ) + REAL ( KIND = rp_ ), INTENT( OUT ) :: C( m ) + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ INTEGER :: mgeq, i, mt, status ! Evaluate the objective function and constraints. - CALL CUTEST_cfn( status, CUTEST_problem_global%n, & + CALL CUTEST_cfn_r( status, CUTEST_problem_global%n, & CUTEST_problem_global%m, X, CUTEST_problem_global%f, & CUTEST_problem_global%C ) IF ( status /= 0 ) GO TO 910 diff --git a/src/cobyla/cobyla_test.F90 b/src/cobyla/cobyla_test.F90 new file mode 100644 index 0000000..caa97cc --- /dev/null +++ b/src/cobyla/cobyla_test.F90 @@ -0,0 +1,23 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 12:25 GMT. + +#include "cutest_modules.h" + +! Dummy COBYLA for testing cobyla_main interface to CUTEst +! Nick Gould, 7th January 2013 + + SUBROUTINE COBYLA( n, m, X, rhobeg, rhoend, iprint, maxfun, W, IW ) + USE CUTEST_KINDS_precision + +! dummy arguments + + INTEGER ( KIND = ip_ ) :: n, m, iprint, maxfun + REAL( KIND = rp_ ) :: rhobeg, rhoend + INTEGER ( KIND = ip_ ) :: IW( * ) + REAL( KIND = rp_ ) :: X( * ), W( * ) + + REAL( KIND = rp_ ) :: f + REAL( KIND = rp_ ) :: C( m ) + CALL CALCFC( n, m, X, f, C ) + + RETURN + END diff --git a/src/cobyla/cobyla_test.f90 b/src/cobyla/cobyla_test.f90 deleted file mode 100644 index c949529..0000000 --- a/src/cobyla/cobyla_test.f90 +++ /dev/null @@ -1,21 +0,0 @@ -! ( Last modified on 7 Jan 2013 at 16:30:00 ) - -! Dummy COBYLA for testing cobyla_main interface to CUTEst -! Nick Gould, 7th January 2013 - - SUBROUTINE COBYLA( n, m, X, rhobeg, rhoend, iprint, maxfun, W, IW ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - -! dummy arguments - - INTEGER :: n, m, iprint, maxfun - REAL( KIND = wp ) :: rhobeg, rhoend - INTEGER :: IW( * ) - REAL( KIND = wp ) :: X( * ), W( * ) - - REAL( KIND = wp ) :: f - REAL( KIND = wp ) :: C( m ) - CALL CALCFC( n, m, X, f, C ) - - RETURN - END diff --git a/src/cobyla/makemaster b/src/cobyla/makemaster index 6e8496a..0cd0661 100644 --- a/src/cobyla/makemaster +++ b/src/cobyla/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst COBYLA interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 7 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = COBYLA -package = cobyla - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = COBYLA +package = cobyla -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/curvi/curvi_main.f90 b/src/curvi/curvi_main.F90 similarity index 76% rename from src/curvi/curvi_main.f90 rename to src/curvi/curvi_main.F90 index 8a3e279..250282b 100644 --- a/src/curvi/curvi_main.f90 +++ b/src/curvi/curvi_main.F90 @@ -1,21 +1,28 @@ -! ( Last modified on 9 Apr 2019 at 11:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-24 AT 15:00 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM CURVI_main + USE CUTEST_KINDS_precision + + IMPLICIT NONE + ! CURVI test driver for problems derived from SIF files. ! Nick Gould, April 2019 - INTEGER :: n, derivs, maxit, i, status, ibound, lwa, nf, ng, nh, nit - INTEGER :: idiff, kmax, g - INTEGER, PARAMETER :: input = 55, out = 6, inspec = 56 - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION :: biginf, eps, fopt - DOUBLE PRECISION, PARAMETER :: tiny = 1.0D-6 + INTEGER ( KIND = ip_ ) :: n, derivs, maxit, i, status, ibound, lwa + INTEGER ( KIND = ip_ ) :: idiff, kmax, g, nf, ng, nh, nit, ier, itrid + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6, inspec = 56 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + REAL ( KIND = rp_ ) :: biginf, eps, fopt, gnorm + REAL ( KIND = rp_ ), PARAMETER :: tiny = 1.0D-6 CHARACTER ( LEN = 10 ) :: pname - DOUBLE PRECISION :: CPU( 2 ), CALLS( 4 ) - INTEGER, ALLOCATABLE, DIMENSION( : ) :: JBOUND - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, WA + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: JBOUND + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, WA CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES EXTERNAL :: CURVI_evalf, CURVI_evalg, CURVI_evalh @@ -60,7 +67,7 @@ PROGRAM CURVI_main ! find the problem dimension - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 ! allocate workspace @@ -79,11 +86,13 @@ PROGRAM CURVI_main ! set up SIF data - CALL CUTEST_usetup( status, input, out, io_buffer, n, X, BL, BU ) + CALL CUTEST_usetup_r( status, input, out, io_buffer, n, X, BL, BU ) + IF ( status /= 0 ) GO TO 910 + CLOSE( input ) ! obtain variable names - CALL CUTEST_unames( status, n, pname, XNAMES ) + CALL CUTEST_unames_r( status, n, pname, XNAMES ) IF ( status /= 0 ) GO TO 910 ! record whether there are simple bounds, and the status of each bound @@ -134,10 +143,10 @@ PROGRAM CURVI_main ! output solution - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - g = n + n*n + g = n + n * n gnorm = MAXVAL( ABS( WA( g + 1 : g + n ) ) ) WRITE( out, "( /, ' XL X', & & ' XU PROJ(G)' )" ) @@ -160,7 +169,7 @@ PROGRAM CURVI_main & ' Solve time = ', 0P, F10.2, ' seconds', //, & & 66('*') / )" ) pname, n, ( CALLS( i ), i = 1, 3 ), & nit, ier, fopt, gnorm, CPU( 1 ), CPU( 2 ) - CLOSE( input ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -173,46 +182,49 @@ PROGRAM CURVI_main END SUBROUTINE CURVI_evalf( n, X, f ) - INTEGER :: n - DOUBLE PRECISION :: f, X( n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ufn( status, n, X, f ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: f, X( n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ufn_r( status, n, X, f ) IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) & status STOP END IF RETURN - END + END SUBROUTINE CURVI_evalf SUBROUTINE CURVI_evalg( n, X, G ) - INTEGER :: n - DOUBLE PRECISION :: X( n ), G( n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ugr( status, n, X, G ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: X( n ), G( n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ugr_r( status, n, X, G ) IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) & status STOP END IF RETURN - END + END SUBROUTINE CURVI_evalg SUBROUTINE CURVI_evalh( n, X, H ) - INTEGER :: n - DOUBLE PRECISION :: X( n ), H( n * ( n + 1 ) / 2) - DOUBLE PRECISION, ALLOCATABLE :: H_sym( :, : ) - INTEGER :: status, i, j, l - INTEGER, PARAMETER :: out = 6 + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: X( n ), H( n * ( n + 1 ) / 2) + REAL ( KIND = rp_ ), ALLOCATABLE :: H_sym( :, : ) + INTEGER ( KIND = ip_ ) :: status, i, j, l + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 IF ( .NOT. ALLOCATED( H_sym ) ) ALLOCATE( H_sym( n, n ), STAT = status ) IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) & status STOP END IF - CALL CUTEST_udh( status, n, X, n, H_sym ) + CALL CUTEST_udh_r( status, n, X, n, H_sym ) IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) & status @@ -226,4 +238,4 @@ SUBROUTINE CURVI_evalh( n, X, H ) END DO END DO RETURN - END + END SUBROUTINE CURVI_evalh diff --git a/src/curvi/curvi_test.F90 b/src/curvi/curvi_test.F90 new file mode 100644 index 0000000..d340f0f --- /dev/null +++ b/src/curvi/curvi_test.F90 @@ -0,0 +1,55 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-24 AT 15:10 GMT. + +#include "cutest_modules.h" + +! Dummy CURVI for testing curvi_main interface to CUTEst +! Nick Gould, 9th April 2019 + + SUBROUTINE curvif( fu, n, X0, fopt, eps, ibound, JBOUND, BL, BU, WA, nfu, & + nit, idiff, kmax, ier ) + USE CUTEST_KINDS_precision + EXTERNAL :: fu + INTEGER ( KIND = ip_ ) :: n, itrid, ibound, nfu, nit, idiff, kmax, ier + REAL ( KIND = rp_ ) :: fopt, eps + INTEGER ( KIND = ip_ ) :: JBOUND( n ) + REAL ( KIND = rp_ ) :: X0( n ), WA( * ), BL( n ), BU( n ) + CALL fu( n, X0, fopt ) + WA( : n ) = 0.0 + ier = - 1 + RETURN + END SUBROUTINE curvif + + SUBROUTINE curvig( fu, gradie, n, X0, fopt, eps, ibound, JBOUND, BL, BU, & + WA, nfu, ngr, nit, ier ) + USE CUTEST_KINDS_precision + EXTERNAL :: fu, gradie + INTEGER ( KIND = ip_ ) :: n, itrid, ibound, nfu, ngr, nit, ier + REAL ( KIND = rp_ ) :: fopt, eps + INTEGER ( KIND = ip_ ) :: JBOUND( n ) + REAL ( KIND = rp_ ) :: X0( n ), WA( * ), BL( n ), BU( n ) + INTEGER ( KIND = ip_ ) :: g + g = n + n * n + CALL fu( n, X0, fopt ) + CALL gradie( n, X0, WA( g + 1 : g + n ) ) + ier = - 2 + RETURN + END SUBROUTINE curvig + + SUBROUTINE curvih( fu, gradie, hessia, n, X0, fopt, eps, itrid, ibound, & + JBOUND, BL, BU, WA, nfu, ngr, nhes, nit, ier ) + USE CUTEST_KINDS_precision + EXTERNAL :: fu, gradie, hessia + INTEGER ( KIND = ip_ ) :: n, itrid, ibound, nfu, ngr, nhes, nit, ier + REAL ( KIND = rp_ ) :: fopt, eps + INTEGER ( KIND = ip_ ) :: JBOUND( n ) + REAL ( KIND = rp_ ) :: X0( n ), WA( * ), BL( n ), BU( n ) + INTEGER ( KIND = ip_ ) :: g, h + g = n + n * n + h = g + 8 * n + CALL fu( n, X0, fopt ) + CALL gradie( n, X0, WA ) + CALL gradie( n, X0, WA( g + 1 : g + n ) ) + CALL hessia( n, X0, WA( h + 1 : h + n * ( n + 1 ) / 2 ) ) + ier = - 3 + RETURN + END SUBROUTINE curvih diff --git a/src/curvi/curvi_test.f90 b/src/curvi/curvi_test.f90 deleted file mode 100644 index 8ad141b..0000000 --- a/src/curvi/curvi_test.f90 +++ /dev/null @@ -1,43 +0,0 @@ -! ( Last modified on 9 Apr 2019 at 14:10:00 ) - -! Dummy CURVI for testing curvi_main interface to CUTEst -! Nick Gould, 9th April 2019 - - SUBROUTINE curvif( fu, n, X0, fopt, eps, ibound, JBOUND, BL, BU, WA, nfu, & - nit, idiff, kmax, ier ) - external :: fu - integer :: n, itrid, ibound, nfu, nit, idiff, kmax, ier - double precision :: fopt, eps - integer :: JBOUND( n ) - double precision :: X0( n ), WA( * ), BL( n ), BU( n ) - call fu( n, X0, fopt ) - WA( : n ) = 0.0 - ier = - 1 - END SUBROUTINE curvif - - SUBROUTINE curvig( fu, gradie, n, X0, fopt, eps, ibound, JBOUND, BL, BU, & - WA, nfu, ngr, nit, ier ) - external :: fu, gradie - integer :: n, itrid, ibound, nfu, ngr, nit, ier - double precision :: fopt, eps - integer :: JBOUND( n ) - double precision :: X0( n ), WA( * ), BL( n ), BU( n ) - call fu( n, X0, fopt ) - call gradie( n, X0, WA ) - WA( : n ) = 0.0 - ier = - 2 - END SUBROUTINE curvig - - SUBROUTINE curvih( fu, gradie, hessia, n, X0, fopt, eps, itrid, ibound, & - JBOUND, BL, BU, WA, nfu, ngr, nhes, nit, ier ) - external :: fu, gradie, hessia - integer :: n, itrid, ibound, nfu, ngr, nhes, nit, ier - double precision :: fopt, eps - integer :: JBOUND( n ) - double precision :: X0( n ), WA( * ), BL( n ), BU( n ) - call fu( n, X0, fopt ) - call gradie( n, X0, WA ) - call hessia( n, X0, WA ) - WA( : n ) = 0.0 - ier = - 3 - END SUBROUTINE curvih diff --git a/src/curvi/makemaster b/src/curvi/makemaster index 65d2c3e..c16a05f 100644 --- a/src/curvi/makemaster +++ b/src/curvi/makemaster @@ -1,140 +1,36 @@ # Main body of the installation makefile for CUTEst CURVI interface +# Nick Gould, for GALAHAD productions +# This version: 2023-11-06 -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 09 IV 2019 +# include standard CUTEst makefile defaults before package-specifics -# package +include $(CUTEST)/src/makedefs/defaults -PACKAGE = CURVI -package = curvi - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests +PACKAGE = CURVI +package = curvi -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# include standard CUTEst makefile definitions -# individual compilations +include $(CUTEST)/src/makedefs/definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +# include compilation and run instructions -# CUTEst interface main programs +include $(CUTEST)/src/makedefs/instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +# select specific run test -# book keeping +run_test: run_unconstrained_test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +# include standard package compilation instructions -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/compile diff --git a/src/curvi/u_test.output b/src/curvi/u_test.output index 08eae3b..fb8f216 100644 --- a/src/curvi/u_test.output +++ b/src/curvi/u_test.output @@ -1,10 +1,10 @@ - X G -X1 0.0000E+00 0.0000E+00 -X2 0.0000E+00 0.0000E+00 -X3 0.0000E+00 0.0000E+00 -X4 0.0000E+00 0.0000E+00 -X5 0.0000E+00 0.0000E+00 + XL X XU PROJ(G) +X1 -1.0000E+20 0.0000E+00 1.0000E+20 -8.0000E+00 +X2 -1.0000E+20 0.0000E+00 1.0000E+20 0.0000E+00 +X3 -1.0000E+20 0.0000E+00 1.0000E+20 1.0000E+00 +X4 -1.0000E+20 0.0000E+00 1.0000E+20 -1.0000E+00 +X5 -1.0000E+20 0.0000E+00 1.0000E+20 0.0000E+00 ************************ CUTEst statistics ************************ @@ -12,11 +12,12 @@ X5 0.0000E+00 0.0000E+00 Problem : ALLINITU3 # variables = 5 # objective functions = 1.00 - # objective gradients = 1.00 + # objective gradients = 2.00 # objective Hessians = 1.00 + # iterations = 0 Exit code = -3 Final f = 1.3000000E+01 - Final ||g|| = 0.0000000E+00 + Final ||g|| = 8.0000000E+00 Set up time = 0.00 seconds Solve time = 0.00 seconds diff --git a/src/cutest2 b/src/cutest2 index 70cc62d..366774b 100644 --- a/src/cutest2 +++ b/src/cutest2 @@ -1,55 +1,55 @@ -package interface updated -tools 2023-11-03 -test 2023-11-06 +tools +test +stats -algencan f -bobyqa f90 -cg_descent c & f -cgplus f -cobyla f & f90 -curvi f90 -derchk c -dfo f90 -directsearch f90 -e04nqf f90 -filtersd f -filtersqp f -gen77 f -gen90 f90 -genc c -gen f & f90 & c -gsl c -highs f90 -hrb f90 -ipopt f -knitro c -la04 f -lbfgsb f -lbfgs f -lincoa f90 -loqo c -minos f -newuoa f90 -nitsol f -nlpqlp f -nomad c -npsol f -osqp c -pds f -pennlp f -praxis f -ql f -qplib f90 -ral_nlls f90 -snopt f -spg f -sqic f90 -stats f90 -stenmin f -tao F -tenmin f -test f90 -tron f -uncmin f 2023-11-07 -vf13 f -worhp c + +* algencan +* bobyqa +* cg_descent +* cgplus +* cobyla +* curvi +* derchk +* dfo +* directsearch +* e04nqf +* filtersd +* filtersqp +* gen77 +* gen90 +* genc +* gsl (no single) +* highs +* hrb +* ipopt +* knitro (no single) +* la04 +* lbfgs +* lbfgsb +* lincoa +* loqo (no single) +* matlab +* minos +* newuoa +* nitsol +* nlpqlp +* nomad +* npsol +* octave +* osqp +* pds +* pennlp +* praxis +* ql +* qplib +* ral_nlls +* snopt +* spg +* sqic +* stenmin +- tao (broken) +* tenmin +* tron +* uncmin +* vf13 +* worhp (no single) diff --git a/src/derchk/derchk_main.c b/src/derchk/derchk_main.c index c646893..286787d 100644 --- a/src/derchk/derchk_main.c +++ b/src/derchk/derchk_main.c @@ -1,3 +1,4 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-02 AT 15:30 GMT */ /* =========================================== * CUTEst interface to derivative checker @@ -21,15 +22,16 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #endif #include "cutest.h" +#include "cutest_routines.h" #define DERCHK derchk #define DERCHKSPC derchkspc #define GETINFO getinfo - doublereal DERCHK(doublereal); + rp_ DERCHK(rp_); void DERCHKSPC(integer, char*); - void GETINFO( integer, integer, doublereal*, doublereal*, - doublereal*, doublereal*, logical*, logical*, + void GETINFO( integer, integer, rp_*, rp_*, + rp_*, rp_*, logical*, logical*, VarTypes* ); integer CUTEst_nvar; /* number of variables */ @@ -50,25 +52,34 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ VarTypes vtypes; integer ncon_dummy; - doublereal *x, *bl, *bu, *dummy1, *dummy2; - doublereal *v = NULL, *cl = NULL, *cu = NULL; + rp_ *x, *bl, *bu, *dummy1, *dummy2; + rp_ *v = NULL, *cl = NULL, *cu = NULL; logical *equatn = NULL, *linear = NULL; char *pname, *vnames, *gnames, *cptr; char **Vnames, **Gnames; /* vnames and gnames as arrays of strings */ logical grad; integer e_order = 0, l_order = 0, v_order = 0; logical constrained = FALSE_; + logical header_unset; - doublereal calls[7], cpu[4]; + rp_ calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; - doublereal dummy; + rp_ dummy; integer ExitCode; int i, j; - doublereal h, fxp, fxm, approx, derr, xi; - doublereal *cxp, *cxm, *g; + rp_ h, fxp, fxm, approx, derr, xi, der_max; + rp_ *cxp, *cxm, *g; int nerr = 0; +#ifdef CUTEST_SINGLE + h = 1.0e-4; + der_max = 1.0e-2; +#else + h = 1.0e-8; + der_max = 1.0e-4; +#endif + /* Open problem description file OUTSDIF.d */ ierr = 0; FORTRAN_open(&funit, fname, &ierr); @@ -78,7 +89,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon); + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -92,16 +103,16 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ /* Reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC(x, CUTEst_nvar, doublereal); - MALLOC(bl, CUTEst_nvar, doublereal); - MALLOC(bu, CUTEst_nvar, doublereal); + MALLOC(x, CUTEst_nvar, rp_); + MALLOC(bl, CUTEst_nvar, rp_); + MALLOC(bu, CUTEst_nvar, rp_); if (constrained) { MALLOC(equatn, CUTEst_ncon+1, logical); MALLOC(linear, CUTEst_ncon+1, logical); - MALLOC(v, CUTEst_ncon+1, doublereal); - MALLOC(cl, CUTEst_ncon+1, doublereal); - MALLOC(cu, CUTEst_ncon+1, doublereal); - CUTEST_csetup( &status, &funit, &iout, &io_buffer, + MALLOC(v, CUTEst_ncon+1, rp_); + MALLOC(cl, CUTEst_ncon+1, rp_); + MALLOC(cu, CUTEst_ncon+1, rp_); + CUTEST_csetup_r( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, v, cl, cu, equatn, linear, &e_order, &l_order, &v_order ); @@ -112,9 +123,9 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } else { MALLOC(equatn, 1, logical); MALLOC(linear, 1, logical); - MALLOC(cl, 1, doublereal); - MALLOC(cu, 1, doublereal); - CUTEST_usetup( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, + MALLOC(cl, 1, rp_); + MALLOC(cu, 1, rp_); + CUTEST_usetup_r( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, x, bl, bu); if (status) { printf("CUTEst error.\nAborting.\n"); @@ -134,14 +145,14 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ MALLOC(Gnames, CUTEst_ncon, char*); /* Array of strings */ for (i = 0; i < CUTEst_ncon; i++) MALLOC(Gnames[i], FSTRING_LEN+1, char); - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, + CUTEST_cnames_r( &status, &CUTEst_nvar, &CUTEst_ncon, pname, vnames, gnames); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } } else { - CUTEST_unames( &status, &CUTEst_nvar, pname, vnames); + CUTEST_unames_r( &status, &CUTEst_nvar, pname, vnames); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -193,33 +204,32 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ x[i] = pow(-1,i) * (2*i+1); /* Evaluate gradient at initial point. */ - MALLOC(g, CUTEst_nvar, doublereal); - CUTEST_ugr( &status, &CUTEst_nvar, x, g); + MALLOC(g, CUTEst_nvar, rp_); + CUTEST_ugr_r( &status, &CUTEst_nvar, x, g); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } /* Check first derivatives of objective and constraints. */ - h = 1.0e-8; + if (constrained) { - MALLOC(cxp, CUTEst_ncon+1, doublereal); - MALLOC(cxm, CUTEst_ncon+1, doublereal); + MALLOC(cxp, CUTEst_ncon+1, rp_); + MALLOC(cxm, CUTEst_ncon+1, rp_); } - fprintf(stderr, "%10s %22s %22s %7s\n", - "Variable", "AD", "Numerical", "Error"); + header_unset = TRUE_; for (i = 0; i < CUTEst_nvar; i++) { xi = x[i]; x[i] = xi + h; if (constrained) { - CUTEST_cfn( &status, &CUTEst_nvar, &CUTEst_ncon, + CUTEST_cfn_r( &status, &CUTEst_nvar, &CUTEst_ncon, x, &fxp, cxp); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } } else { - CUTEST_ufn( &status, &CUTEst_nvar, x, &fxp); + CUTEST_ufn_r( &status, &CUTEst_nvar, x, &fxp); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -227,14 +237,14 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } x[i] = xi - h; if (constrained) { - CUTEST_cfn( &status, &CUTEst_nvar, &CUTEst_ncon, + CUTEST_cfn_r( &status, &CUTEst_nvar, &CUTEst_ncon, x, &fxm, cxm); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } } else { - CUTEST_ufn( &status, &CUTEst_nvar, x, &fxm); + CUTEST_ufn_r( &status, &CUTEst_nvar, x, &fxm); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -245,7 +255,12 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ /* Check i-th derivative of objective */ approx = (fxp-fxm)/(2*h); derr = fabs(g[i] - approx)/fmax(1,fabs(g[i])); - if (derr > 1.0e-4) { + if (derr > der_max) { + if (header_unset) { + fprintf(stderr, "%10s %22s %22s %7s\n", + "Variable", "AD", "Numerical", "Error"); + header_unset = FALSE_; + } nerr++; fprintf(stderr, "%10s %22.15e %22.15e %7.1e\n", Vnames[i], g[i], approx, derr); @@ -258,7 +273,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu); + CUTEST_creport_r( &status, calls, cpu); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -308,14 +323,14 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ for (i = 0; i < CUTEst_ncon; i++) FREE(Gnames[i]); if (constrained) FREE(Gnames); - CUTEST_uterminate( &status ); + CUTEST_uterminate_r( &status ); return 0; } - void getinfo( integer n, integer m, doublereal *bl, doublereal *bu, - doublereal *cl, doublereal *cu, logical *equatn, + void getinfo( integer n, integer m, rp_ *bl, rp_ *bu, + rp_ *cl, rp_ *cu, logical *equatn, logical *linear, VarTypes *vartypes ) { int i; diff --git a/src/derchk/makemaster b/src/derchk/makemaster index 3fef0c1..a569b72 100644 --- a/src/derchk/makemaster +++ b/src/derchk/makemaster @@ -1,139 +1,51 @@ # Main body of the installation makefile for CUTEst DERCHK interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 9 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = DERCHK -package = derchk - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used +include $(CUTEST)/src/makedefs/defaults -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# Archive manipulation strings +# package name -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o +PACKAGE = DERCHK +package = derchk -SUCC = precision version) compiled successfully +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# main compilations and runs +# include standard CUTEst makefile definitions -all: $(package) +include $(CUTEST)/src/makedefs/definitions -# basic packages +# include compilation and run instructions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +include $(CUTEST)/src/makedefs/instructions -# run example tests +# run example test run_test: tools test_cutest $(OBJ)/$(package)_main.o echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(U_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(U_TEST) -L$(OBJ) $(LIBS) ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - $(OBJ)/run_test >& ../$(package)/u_test.output cat ../$(package)/u_test.output rm $(OBJ)/run_test ../$(package)/OUTSDIF.d echo " Test of constrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - $(OBJ)/run_test >& ../$(package)/c_test.output cat ../$(package)/c_test.output rm $(OBJ)/run_test ../$(package)/OUTSDIF.d -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.c > \ - $(OBJ)/$(package)_main.c - cd $(OBJ); $(CC) -o $(package)_main.o $(CFLAGS) $(package)_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_main.o $(CFLAGSN) $(package)_main.c ) - $(RM) $(OBJ)/$(package)_main.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/dfo/dfo_main.f90 b/src/dfo/dfo_main.F90 similarity index 68% rename from src/dfo/dfo_main.f90 rename to src/dfo/dfo_main.F90 index 2ded39e..ca5751d 100644 --- a/src/dfo/dfo_main.f90 +++ b/src/dfo/dfo_main.F90 @@ -1,42 +1,46 @@ -! ( Last modified on 3 Jan 2013 at 14:40:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-24 AT 10:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" + ! Main CUTEst driver for DFO 2.0.0. ! Original version by K. C. Dang, 2008 ! Fortran 90 version by D. Orban, 2009 ! Revised for CUTEst, Nick Gould, January 2013 -Program DFO_main -! Use CUTEst_precis -! Use CUTEst_interfaces - Implicit None +PROGRAM DFO_main -! Variable declarations + USE CUTEST_KINDS_precision +! USE CUTEst_precis +! USE CUTEst_interfaces - Integer :: N, M, NCLIN, NCNLN, NLIN, NEQ, NBNDS, status - INTEGER :: io_buffer = 11 - Integer, Parameter :: INDR = 46 - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - Real(Kind = wp), Dimension(:), Allocatable :: X0, BL, BU, V, CL, CU - Logical, Dimension(:), Allocatable :: EQUATN, LINEAR - Logical :: IFINIV, constrained - Character(Len = 10) :: pname - Character(Len = 10), Dimension(:), Allocatable :: VNAMES, GNAMES - Character(Len = 256) :: pname_256 - Character(Len = 256), Dimension(:), Allocatable :: VNAMES_256, GNAMES_256 + IMPLICIT NONE +! Variable declarations + + INTEGER ( KIND = ip_ ) :: N, M, NCLIN, NCNLN, NLIN, NEQ, NBNDS, status + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: INDR = 46 + REAL( KIND = rp_ ), DIMENSION(:), ALLOCATABLE :: X0, BL, BU, V, CL, CU + LOGICAL, DIMENSION(:), ALLOCATABLE :: EQUATN, LINEAR + LOGICAL :: IFINIV, constrained + CHARACTER ( LEN = 10 ) :: pname + CHARACTER ( LEN = 10 ), DIMENSION(:), ALLOCATABLE :: VNAMES, GNAMES + CHARACTER ( LEN = 256 ) :: pname_256 + CHARACTER ( LEN = 256 ), DIMENSION(:), ALLOCATABLE :: VNAMES_256, GNAMES_256 ! - Variables for I/O - Integer, Parameter :: out=6, INPUT=47, INSPEC=198, REPRTOUT=1812 + INTEGER ( KIND = ip_ ), Parameter :: out = 6, INPUT = 47 + INTEGER ( KIND = ip_ ), Parameter :: INSPEC = 198, REPRTOUT = 1812 ! - Variables for algorithm parameter - Integer :: NX, MAXIT, MAXNF,STPCRTR, IPRINT, SCALE + INTEGER ( KIND = ip_ ) :: NX, MAXIT, MAXNF,STPCRTR, IPRINT, SCALE ! LOGICAL IFINTV - Real(Kind = wp) :: DELMIN, DELTA, CNSTOL, PP, STPTHR + REAL( KIND = rp_) :: DELMIN, DELTA, CNSTOL, PP, STPTHR ! - Variables for CUTEst report - Real(Kind = wp) :: CPU(4), CALLS(7) + REAL( KIND = rp_) :: CPU(4), CALLS(7) ! - Variables for working space - Integer :: LDA - Integer :: IT, NF, INFO - Integer :: I - Real(Kind = wp) :: F0 - Real(Kind = wp), Dimension(:), Allocatable :: X, FX, C, CONX, LB, UB, ALIN + INTEGER ( KIND = ip_ ) :: LDA, IT, NF, INFO, I + REAL ( KIND = rp_ ) :: F0 + REAL ( KIND = rp_ ), DIMENSION(:), ALLOCATABLE :: X, FX, C, CONX, LB, UB, ALIN ! Open data file. @@ -45,12 +49,13 @@ Program DFO_main ! Allocate working vectors. - constrained = .False. - Call CUTEST_cdimen( status, input, n, m ) + Call CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 If( M > 0 ) Then constrained = .True. - Else If( M < 0 ) Then + Else If( M == 0 ) Then + constrained = .False. + Else Write( 6, '(A)' ) 'Error reading OUTSDIF.d' Stop Endif @@ -62,12 +67,12 @@ Program DFO_main If( constrained ) Then Allocate(C(M), V(M), CL(M), CU(M), EQUATN(M), LINEAR(M), STAT = status ) IF ( status /= 0 ) GO TO 990 - Call CUTEST_csetup( status, INPUT, out, io_buffer,N, M, X0, BL, BU, & - V, CL, CU, EQUATN, LINEAR, 0, 1, 0 ) + Call CUTEST_csetup_r( status, INPUT, out, io_buffer,N, M, X0, BL, BU, & + V, CL, CU, EQUATN, LINEAR, 0, 1, 0 ) Else Allocate(C(0), EQUATN(0), LINEAR(0), STAT = status ) IF ( status /= 0 ) GO TO 990 - Call CUTEST_usetup( status, INPUT, out, io_buffer, N, X0, BL, BU ) + Call CUTEST_usetup_r( status, INPUT, out, io_buffer, N, X0, BL, BU ) Endif IF ( status /= 0 ) GO TO 910 @@ -78,13 +83,13 @@ Program DFO_main If( constrained ) Then Allocate( GNAMES( m ), GNAMES_256( m ), STAT = status) IF ( status /= 0 ) GO TO 990 - Call CUTEST_cnames( status, n, m, pname, VNAMES, GNAMES ) + Call CUTEST_cnames_r( status, n, m, pname, VNAMES, GNAMES ) DO i = 1, 10 GNAMES_256( 1 : m ) ( i : i ) = GNAMES( 1 : m )( i : i ) END DO Else Allocate( GNAMES_256( 0 ), STAT = status) - Call CUTEST_unames( status, n, pname, VNAMES ) + Call CUTEST_unames_r( status, n, pname, VNAMES ) Endif DO i = 1, 10 pname_256( i : i ) = pname( i : i ) @@ -143,9 +148,9 @@ Program DFO_main ! Evaluate initial objective and constraint values If( constrained ) Then - Call CUTEST_cfn( status, n, m, X0, f0, C ) + Call CUTEST_cfn_r( status, n, m, X0, f0, C ) Else - Call CUTEST_ufn( status, n, X0, f0 ) + Call CUTEST_ufn_r( status, n, X0, f0 ) Endif IF ( status /= 0 ) GO TO 910 If( NX == 1 ) Then @@ -155,13 +160,13 @@ Program DFO_main Else If( constrained ) Then Do I = 1, NX - Call CUTEST_cfn( status, n, m, X((I-1)*N + 1:I*N), FX(I), & + Call CUTEST_cfn_r( status, n, m, X((I-1)*N + 1:I*N), FX(I), & CONX((I-1)*M + 1:I*M)) IF ( status /= 0 ) GO TO 910 End Do Else Do I = 1, NX - Call CUTEST_ufn( status,N, X((I-1)*N + 1:I*N), FX(I)) + Call CUTEST_ufn_r( status,N, X((I-1)*N + 1:I*N), FX(I)) IF ( status /= 0 ) GO TO 910 End Do Endif @@ -176,16 +181,26 @@ Program DFO_main ! Write out statistics - Call CUTEST_creport( status,CALLS, CPU) + If( constrained ) Then + Call CUTEST_creport_r( status, CALLS, CPU ) + Write(out, 2000) PNAME, N, M, NLIN, NEQ, M-NEQ, NBNDS, CALLS(1), CALLS(5) + Else + Call CUTEST_ureport_r( status, CALLS, CPU ) + Write(out, 2000) PNAME, N, M, NLIN, NEQ, M-NEQ, NBNDS, CALLS(1), 0.0_rp_ + End If IF ( status /= 0 ) GO TO 910 - Write(out, 2000) PNAME, N, M, NLIN, NEQ, M-NEQ, NBNDS, CALLS(1), CALLS(5) Write(out, 2001) INFO, FX(1), CPU(1), CPU(2) ! Write select statistics to file Open(REPRTOUT, FILE = 'cutest.log', FORM = 'FORMATTED') - Write(REPRTOUT, 2002) PNAME, N, M, IT, Int(CALLS(1)), Int(CALLS(5)), & - INFO, FX(1), F0, CPU(1), CPU(2) + If( constrained ) Then + Write(REPRTOUT, 2002) PNAME, N, M, IT, Int(CALLS(1)), Int(CALLS(5)), & + INFO, FX(1), F0, CPU(1), CPU(2) + Else + Write(REPRTOUT, 2002) PNAME, N, M, IT, Int(CALLS(1)), 0, & + INFO, FX(1), F0, CPU(1), CPU(2) + End if Close(REPRTOUT) 999 Continue Close(INPUT) @@ -205,13 +220,15 @@ Program DFO_main Deallocate(GNAMES) Deallocate(C) Deallocate(CONX) + CALL CUTEST_cterminate_r( status ) + Else + CALL CUTEST_uterminate_r( status ) Endif Deallocate(LB) Deallocate(UB) Deallocate(X) Deallocate(FX) Deallocate(ALIN) - CALL CUTEST_uterminate( status ) STOP 910 CONTINUE @@ -257,31 +274,32 @@ Program DFO_main ,' Initial f : FZERO : F : ', E15.7 ,/ & ,' Set up time (in second) : PTIME : F : ', 0P,F15.7 ,/ & ,' Solve time (in second) : STIME : F : ', 0P,F15.7 ,/) -End Program DFO_main +END PROGRAM DFO_main !============================================================================== -Subroutine FUN(N, M, X, F, C, IFERR) +SUBROUTINE FUN(N, M, X, F, C, IFERR) + + USE CUTEST_KINDS_precision ! Evaluate objective and constraint values at X - Implicit None - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - Integer, Intent(In) :: N, M - Real(Kind=wp), Dimension(N), Intent(In) :: X - Real(Kind=wp), Dimension(M), Intent(Out) :: C - Real(Kind=wp), Intent(Out) :: F - Logical, Intent(Out) :: IFERR -!Intrinsic :: ISNAN ! Only in GFortran >= 4.3 + IMPLICIT NONE + INTEGER ( KIND = ip_ ), INTENT( In ) :: N, M + REAL( KIND = rp_ ), DIMENSION( N ), Intent( In ) :: X + REAL( KIND = rp_ ), DIMENSION( M ), Intent( Out ) :: C + REAL( KIND = rp_ ), INTENT( OUT ) :: F + LOGICAL, INTENT( OUT ) :: IFERR +!INTRINSIC :: ISNAN ! Only in GFortran >= 4.3 - Integer :: i, status + Integer ( KIND = ip_ ) :: i, status IFERR = .False. If( M > 0 ) Then - Call CUTEST_cfn( status, n, m, X, f, C ) + Call CUTEST_cfn_r( status, n, m, X, f, C ) Else - Call CUTEST_ufn( status, n, X, f) + Call CUTEST_ufn_r( status, n, X, f) Endif IF ( status /= 0 ) THEN Write(6,*) 'CUTEst : evaluation failed with status = ', status @@ -304,22 +322,23 @@ Subroutine FUN(N, M, X, F, C, IFERR) End Do 3000 Continue Return -End Subroutine FUN +END SUBROUTINE FUN !============================================================================== - Subroutine GETINFO(N, M, BL, BU, EQUATN, LINEAR, NLIN, NEQ, NBNDS) + SUBROUTINE GETINFO(N, M, BL, BU, EQUATN, LINEAR, NLIN, NEQ, NBNDS) + + USE CUTEST_KINDS_precision ! Input/Output variables - Implicit None + IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - Real( Kind = wp ), Parameter :: INFTY = 1.0D+19 - Integer, Intent( IN ) :: N, M - Integer, Intent( OUT ) :: NLIN, NEQ, NBNDS - Real( Kind = wp ), Dimension( N ), Intent( IN ) :: BL, BU - Logical, Dimension( M ), Intent( IN ) :: EQUATN, LINEAR + REAL( KIND = rp_ ), PARAMETER :: INFTY = 1.0E+19_rp_ + INTEGER ( KIND = ip_ ), INTENT( IN ) :: N, M + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: NLIN, NEQ, NBNDS + REAL( KIND = rp_ ), DIMENSION( N ), INTENT( IN ) :: BL, BU + LOGICAL, DIMENSION( M ), INTENT( IN ) :: EQUATN, LINEAR ! Local variables @@ -339,6 +358,6 @@ Subroutine GETINFO(N, M, BL, BU, EQUATN, LINEAR, NLIN, NEQ, NBNDS) NBNDS = NBNDS + 1 Endif End Do - End Subroutine GETINFO + END SUBROUTINE GETINFO !============================================================================== diff --git a/src/dfo/dfo_test.f90 b/src/dfo/dfo_test.F90 similarity index 56% rename from src/dfo/dfo_test.f90 rename to src/dfo/dfo_test.F90 index bb193c4..28ca8e9 100644 --- a/src/dfo/dfo_test.f90 +++ b/src/dfo/dfo_test.F90 @@ -1,4 +1,6 @@ -! ( Last modified on 7 Jan 2013 at 15:15:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-24 AT 10:40 GMT. + +#include "cutest_modules.h" ! Dummy DFO for testing dfo_main interface to CUTEst ! Nick Gould, 7th January 2013 @@ -7,17 +9,18 @@ SUBROUTINE DFO( n, nx, X, ldx, FX, CONX, ifiniv, m, C, nclin , ncnln, & LB, UB, A, lda, XNAMES, pname, CNAMES, it, nf, info, & maxit, maxnf, stpcrtr, delmin, stpthr, cnstolp, delta, & pp, scale, ioutp, iprintp ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) + + USE CUTEST_KINDS_precision ! dummy arguments - INTEGER :: n, m, nx, ldx, nclin, ncnln, lda, it, nf, info - INTEGER :: maxnf, maxit, stpcrtr, scale, ioutp, iprintp - LOGICAL :: ifiniv + INTEGER ( KIND = ip_ ) :: n, m, nx, ldx, nclin, ncnln, lda, it, nf, info + INTEGER ( KIND = ip_ ) :: maxnf, maxit, stpcrtr, scale, ioutp, iprintp + LOGICAL ( KIND = ip_ ) :: ifiniv CHARACTER ( LEN = 256 ) :: pname - REAL ( KIND = wp ) :: delmin, stpthr, cnstolp, delta, pp - REAL ( KIND = wp ) :: X( ldx * nx ), FX( nx ) , LB( * ), UB( * ) - REAL ( KIND = wp ) :: C( * ), CONX( * ), A( lda * n ) + REAL ( KIND = rp_ ) :: delmin, stpthr, cnstolp, delta, pp + REAL ( KIND = rp_ ) :: X( ldx * nx ), FX( nx ) , LB( * ), UB( * ) + REAL ( KIND = rp_ ) :: C( * ), CONX( * ), A( lda * n ) CHARACTER ( LEN = 256 ) :: XNAMES( N ), CNAMES( * ) ! local variables diff --git a/src/dfo/makemaster b/src/dfo/makemaster index a7ca486..5994ce3 100644 --- a/src/dfo/makemaster +++ b/src/dfo/makemaster @@ -1,149 +1,37 @@ # Main body of the installation makefile for CUTEst DFO interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 7 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-24 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = DFO -package = dfo - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest $(OBJ)/$(package)_main.o $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = DFO +package = dfo -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_both_tests -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/directsearch/directsearch_main.f90 b/src/directsearch/directsearch_main.F90 similarity index 80% rename from src/directsearch/directsearch_main.f90 rename to src/directsearch/directsearch_main.F90 index 8d743c6..d3f55dc 100644 --- a/src/directsearch/directsearch_main.f90 +++ b/src/directsearch/directsearch_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 16 Feb 2013 at 12:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-22 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM DIRECTSEARCH_main @@ -8,21 +11,22 @@ PROGRAM DIRECTSEARCH_main ! Nick Gould, February 2013 -! USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: n, status, i, ierr - INTEGER :: type, maxf, stype, sedge, stopc, iaux, istat + INTEGER ( KIND = ip_ ) :: n, status, i, ierr + INTEGER ( KIND = ip_ ) :: type, maxf, stype, sedge, stopc, iaux, istat LOGICAL :: right, stddev - REAL( KIND = wp ) :: sigma, alpha, beta, gamma, stepi, stepf - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+19 - REAL( KIND = wp ), DIMENSION( : ), ALLOCATABLE :: X0, SSTEPI, AUX - REAL( KIND = wp ), DIMENSION( 4 ) :: CPU - REAL( KIND = wp ), DIMENSION( 4 ) :: CALLS + REAL( KIND = rp_ ) :: sigma, alpha, beta, gamma, stepi, stepf + REAL( KIND = rp_ ), PARAMETER :: infty = REAL( 1.0D+19, KIND = rp_ ) + REAL( KIND = rp_ ), DIMENSION( : ), ALLOCATABLE :: X0, SSTEPI, AUX + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CPU + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CALLS CHARACTER ( len = 10 ) :: pname - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: input = 55, indr = 46, in = 5, out = 6 + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: in = 5, out = 6 EXTERNAL :: DIRECTSEARCH_evalf ! open the relevant file @@ -32,7 +36,7 @@ PROGRAM DIRECTSEARCH_main ! compute problem dimensions - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 ! allocate space @@ -42,7 +46,7 @@ PROGRAM DIRECTSEARCH_main ! set up the data structures necessary to hold the problem functions - CALL CUTEST_usetup( status, input, out, io_buffer, n, X0, AUX, SSTEPI ) + CALL CUTEST_usetup_r( status, input, out, io_buffer, n, X0, AUX, SSTEPI ) IF ( status /= 0 ) GO TO 910 CLOSE( input ) @@ -131,17 +135,17 @@ PROGRAM DIRECTSEARCH_main ! output report - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) WRITE( out, 2000 ) pname, n, CALLS( 1 ), istat, AUX( 2 ), iaux, & CPU( 1 ), CPU( 2 ) ! clean-up data structures DEALLOCATE( X0, AUX, SSTEPI, STAT = ierr ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP ! error returns @@ -177,20 +181,20 @@ SUBROUTINE DIRECTSEARCH_evalf( X, f, n ) ! evaluates the objective function value in a format compatible with ! DIRECTSEARCH, but using the CUTEst tools. - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: n - REAL( KIND = wp ), INTENT( OUT ) :: f - REAL( KIND = wp ), INTENT( IN ) :: X( n ) - REAL( KIND = wp ), PARAMETER :: biginf = 9.0D+19 + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n + REAL( KIND = rp_ ), INTENT( OUT ) :: f + REAL( KIND = rp_ ), INTENT( IN ) :: X( n ) INTEGER :: status ! Evaluate the objective function and constraints. - CALL CUTEST_ufn( status, CUTEST_problem_global%n, & - X, CUTEST_problem_global%f ) + CUTEST_problem_global%n = n + CALL CUTEST_ufn_r( status, CUTEST_problem_global%n, & + X, CUTEST_problem_global%f ) IF ( status /= 0 ) GO TO 910 f = CUTEST_problem_global%f RETURN diff --git a/src/directsearch/directsearch_test.f90 b/src/directsearch/directsearch_test.F90 similarity index 56% rename from src/directsearch/directsearch_test.f90 rename to src/directsearch/directsearch_test.F90 index ffdd957..d4e373c 100644 --- a/src/directsearch/directsearch_test.f90 +++ b/src/directsearch/directsearch_test.F90 @@ -1,22 +1,24 @@ -! ( Last modified on 16 Feb 2013 at 15:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-22 AT 12:45 GMT. + +#include "cutest_modules.h" ! Dummy DIRECT SEARCH codes for testing directsearch_main interface to CUTEst ! Nick Gould, 16th February 2013 SUBROUTINE pattrn( type, evalf, n, X, stepi, stepf, maxf, istat, & AUX, iaux ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) + USE CUTEST_KINDS_precision ! dummy arguments - INTEGER :: type, n, maxf, iaux, istat + INTEGER ( KIND = ip_ ) :: type, n, maxf, iaux, istat LOGICAL :: right, stddev - REAL( KIND = wp ) :: stepi, stepf - REAL( KIND = wp ) :: X( n ), AUX( n + 2 ) + REAL( KIND = rp_ ) :: stepi, stepf + REAL( KIND = rp_ ) :: X( n ), AUX( n + 2 ) EXTERNAL :: evalf AUX( 1 ) = stepi - CALL DIRECTSEARCH_evalf( X, AUX( 2 ), n ) + CALL evalf( X, AUX( 2 ), n ) AUX( 3 : n + 2 ) = X( : n ) istat = 1 @@ -25,18 +27,18 @@ SUBROUTINE pattrn( type, evalf, n, X, stepi, stepf, maxf, istat, & SUBROUTINE shh( evalf, n, X, right, SSTEPI, stepf, maxf, stddev, istat, & AUX, iaux ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) + USE CUTEST_KINDS_precision ! dummy arguments - INTEGER :: type, n, maxf, iaux, istat + INTEGER ( KIND = ip_ ) :: type, n, maxf, iaux, istat LOGICAL :: right, stddev - REAL( KIND = wp ) :: stepf - REAL( KIND = wp ) :: X( n ), SSTEPI( n ), AUX( n + 2 ) + REAL( KIND = rp_ ) :: stepf + REAL( KIND = rp_ ) :: X( n ), SSTEPI( n ), AUX( n + 2 ) EXTERNAL :: evalf AUX( 1 ) = SSTEPI( 1 ) - CALL DIRECTSEARCH_evalf( X, AUX( 2 ), n ) + CALL evalf( X, AUX( 2 ), n ) AUX( 3 : n + 2 ) = X( : n ) istat = 1 @@ -45,18 +47,18 @@ SUBROUTINE shh( evalf, n, X, right, SSTEPI, stepf, maxf, stddev, istat, & SUBROUTINE nm( evalf, n, X, right, sigma, alpha, beta, gamma, SSTEPI, & stepf, maxf, stddev, istat, AUX, iaux ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) + USE CUTEST_KINDS_precision ! dummy arguments - INTEGER :: type, n, maxf, iaux, istat + INTEGER ( KIND = ip_ ) :: type, n, maxf, iaux, istat LOGICAL :: right, stddev - REAL( KIND = wp ) :: sigma, alpha, beta, gamma, stepf - REAL( KIND = wp ) :: X( n ), SSTEPI( n ), AUX( n + 2 ) + REAL( KIND = rp_ ) :: sigma, alpha, beta, gamma, stepf + REAL( KIND = rp_ ) :: X( n ), SSTEPI( n ), AUX( n + 2 ) EXTERNAL :: evalf AUX( 1 ) = SSTEPI( 1 ) - CALL DIRECTSEARCH_evalf( X, AUX( 2 ), n ) + CALL evalf( X, AUX( 2 ), n ) AUX( 3 : n + 2 ) = X( : n ) istat = 1 @@ -65,18 +67,18 @@ SUBROUTINE nm( evalf, n, X, right, sigma, alpha, beta, gamma, SSTEPI, & SUBROUTINE smd( evalf, n, X, right, SSTEPI, stepf, maxf, stddev, istat, & AUX, iaux ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) + USE CUTEST_KINDS_precision ! dummy arguments - INTEGER :: type, n, maxf, iaux, istat + INTEGER ( KIND = ip_ ) :: type, n, maxf, iaux, istat LOGICAL :: right, stddev - REAL( KIND = wp ) :: stepf - REAL( KIND = wp ) :: X( n ), SSTEPI( n ), AUX( n + 2 ) + REAL( KIND = rp_ ) :: stepf + REAL( KIND = rp_ ) :: X( n ), SSTEPI( n ), AUX( n + 2 ) EXTERNAL :: evalf AUX( 1 ) = SSTEPI( 1 ) - CALL DIRECTSEARCH_evalf( X, AUX( 2 ), n ) + CALL evalf( X, AUX( 2 ), n ) AUX( 3 : n + 2 ) = X( : n ) istat = 1 diff --git a/src/directsearch/makemaster b/src/directsearch/makemaster index 4e8902d..a6812e3 100644 --- a/src/directsearch/makemaster +++ b/src/directsearch/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst DIRECTSEARCH interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 16 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = DIRECTSEARCH -package = directsearch - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = DIRECTSEARCH +package = directsearch -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/directsearch/u_test.output b/src/directsearch/u_test.output index 38dd51e..afd8798 100644 --- a/src/directsearch/u_test.output +++ b/src/directsearch/u_test.output @@ -2,8 +2,8 @@ ************************ CUTEst statistics ************************ Package used : DIRECTSEARCH - Problem : ALLINITU - # variables = 4 + Problem : ALLINITU3 + # variables = 5 # objective functions = 1.00 Exit code = 1 Final f = 0.1300000E+02 diff --git a/src/e04nqf/e04nqf_dummy.f90 b/src/e04nqf/e04nqf_dummy.f90 deleted file mode 100644 index e69de29..0000000 diff --git a/src/e04nqf/e04nqf_main.f90 b/src/e04nqf/e04nqf_main.F90 similarity index 78% rename from src/e04nqf/e04nqf_main.f90 rename to src/e04nqf/e04nqf_main.F90 index 0c027e5..ee50c57 100644 --- a/src/e04nqf/e04nqf_main.f90 +++ b/src/e04nqf/e04nqf_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 10 Mar 2021 at 14:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-25 AT 15:30 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM E04NQF_main @@ -6,46 +9,47 @@ PROGRAM E04NQF_main ! Nick Gould, March 2021 - USE CUTEst_interface_double - USE CUTEST_LQP_double + USE CUTEST_KINDS_precision + USE CUTEST_INTERFACE_precision + USE CUTEST_LQP_precision IMPLICIT NONE ! Parameters - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, PARAMETER :: input = 55 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER, PARAMETER :: out = 6 - INTEGER, PARAMETER :: input_specfile = 34 - INTEGER, PARAMETER :: spec = 29 - INTEGER, PARAMETER :: len_c_w = 600 - INTEGER, PARAMETER :: len_r_w = 600 - INTEGER, PARAMETER :: len_i_w = 600 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: input_specfile = 34 + INTEGER ( KIND = ip_ ), PARAMETER :: spec = 29 + INTEGER ( KIND = ip_ ), PARAMETER :: len_c_w = 600 + INTEGER ( KIND = ip_ ), PARAMETER :: len_r_w = 600 + INTEGER ( KIND = ip_ ), PARAMETER :: len_i_w = 600 ! local variables - INTEGER :: status, n, m, nea, neh, nname, lenc, ncolh, iobj, ns, ninf, ifail - INTEGER :: i, j, l, iter - REAL ( KIND = wp ) :: f, sinf, obj, val, res_p, res_d, TIMES( 4 ), CALLS( 7 ) + INTEGER ( KIND = ip_ ) :: status, n, m, nea, neh, nname, lenc, ncolh, iobj + INTEGER ( KIND = ip_ ) :: i, j, l, iter, ns, ninf, ifail + REAL ( KIND = rp_ ) :: f, sinf, obj, res_p, res_d, TIMES( 4 ), CALLS( 7 ) LOGICAL :: filexst - CHARACTER ( LEN = 1 ) :: start, c_dummy( 1 ) - CHARACTER ( LEN = 8 ) :: prob + CHARACTER ( LEN = 1 ) :: start + CHARACTER ( LEN = 8 ) :: prob, c_dummy( 1 ) CHARACTER ( LEN = 10 ) :: p_name - INTEGER, ALLOCATABLE, DIMENSION( : ) :: HELAST, HS, I_w, I_user - INTEGER, ALLOCATABLE, DIMENSION( : ) :: A_ptr, A_row, H_ptr, H_row - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: G, X_0, X, X_l, X_u - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: Z, Y, C_l, C_u, C, G_l - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: B_l, B_u, R_w, R_user - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: A_val, H_val + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: HELAST, HS, I_w, I_user + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: A_ptr, A_row + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_ptr, H_row + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: G, X_0, X, X_l, X_u + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Z, Y, C_l, C_u, C, G_l + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: B_l, B_u, R_w, R_user + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: A_val, H_val CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: X_names, C_names CHARACTER ( LEN = 8 ), ALLOCATABLE, DIMENSION( : ) :: C_w, C_user EXTERNAL :: E04NQF_QPHX ! results summary output if required (set output_summary > 10) -! INTEGER :: output_summary = 0 - INTEGER :: output_summary = 47 +! INTEGER ( KIND = ip_ ) :: output_summary = 0 + INTEGER ( KIND = ip_ ) :: output_summary = 47 CHARACTER ( LEN = 10 ) :: summary_filename = 'E04NQF.res' ! build the QP using column storage @@ -114,7 +118,7 @@ PROGRAM E04NQF_main STAT = status ) IF ( status /= 0 ) GO TO 990 HELAST( : n + m ) = 3 ; HS( : n + m ) = 0 - X( : n ) = X_0( : n ) ; X( n + 1 : n + m ) = 0.0_wp + X( : n ) = X_0( : n ) ; X( n + 1 : n + m ) = 0.0_rp_ DEALLOCATE( X_0, STAT = status ) ! record the sparse matrix H in E04NQF's user data structure @@ -161,7 +165,7 @@ PROGRAM E04NQF_main ! WRITE( out, "(' Final objective value = ', ES11.3 )" ) obj ! WRITE( out, "(' Optimal X = ', 7F9.2 )" ) X( : n ) - CALL CUTEST_creport( status, CALLS, TIMES ) + CALL CUTEST_creport_r( status, CALLS, TIMES ) WRITE( out, "( /, 24('*'), ' CUTEst statistics ', 24('*') // & & ,' Package used : E04NQF', / & & ,' Problem : ', A10, / & @@ -173,14 +177,13 @@ PROGRAM E04NQF_main & ,' Solve time = ', 0P, F10.2, ' seconds' // & & 66('*') / )" ) p_name, n, m, ifail, obj, TIMES( 1 ), TIMES( 2 ) - ! compute the primal and dual residuals if necessary IF ( output_summary > 10 ) THEN ALLOCATE( C( m ), G_l( n ), STAT = status ) CALL E04NQF_QPHX( n, X, G_l, 0, C_user, I_user, R_user ) G_l( : n ) = G_l( : n ) + G( : n ) - Z( : n ) - C( : m ) = 0.0_wp + C( : m ) = 0.0_rp_ DO j = 1, n DO l = A_ptr( j ), A_ptr( j + 1 ) - 1 i = A_row( l ) @@ -216,6 +219,7 @@ PROGRAM E04NQF_main DEALLOCATE( A_val, A_row, A_ptr, B_l, B_u, G, HELAST, HS, X, Y, Z, & C_w, I_w, R_w, C_user, I_user, R_user, STAT = status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -234,27 +238,27 @@ PROGRAM E04NQF_main END PROGRAM E04NQF_main SUBROUTINE E04NQF_QPHX( ncolh, X, HX, nstate, C_user, I_user, R_user ) + USE CUTEST_KINDS_precision ! given x, compute hx = H*x ! dummy arguments - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT ( IN ) :: ncolh, nstate - INTEGER, INTENT ( INOUT ) :: I_user( * ) - REAL ( KIND = wp ), INTENT( IN ) :: X( ncolh ) - REAL ( KIND = wp ), INTENT( INOUT ) :: R_user( * ) - REAL ( KIND = wp ), INTENT( OUT ) :: HX( ncolh ) + INTEGER ( KIND = ip_ ), INTENT ( IN ) :: ncolh, nstate + INTEGER ( KIND = ip_ ), INTENT ( INOUT ) :: I_user( * ) + REAL ( KIND = rp_ ), INTENT( IN ) :: X( ncolh ) + REAL ( KIND = rp_ ), INTENT( INOUT ) :: R_user( * ) + REAL ( KIND = rp_ ), INTENT( OUT ) :: HX( ncolh ) CHARACTER ( len = 8 ), INTENT( INOUT ) :: C_user( * ) ! local variables - INTEGER :: i, j, l, n_row + INTEGER ( KIND = ip_ ) :: i, j, l, n_row ! initialize n_row = ncolh + 1 - HX = 0.0_wp + HX = 0.0_rp_ ! loop over the columns of H, remembering that only one triangle of H is stored diff --git a/src/e04nqf/e04nqf_test.F90 b/src/e04nqf/e04nqf_test.F90 new file mode 100644 index 0000000..2c4c3b8 --- /dev/null +++ b/src/e04nqf/e04nqf_test.F90 @@ -0,0 +1,73 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-25 AT 15:30 GMT. + +#include "cutest_modules.h" + +! slimline CUTEst interface E04NQF +! Nick Gould, March 2021 + +!============================================================================= +! abreviated header from +! https://www.nag.com/numeric/fl/nagdoc_latest/html/e04/e04nqf.html +! 12 Mar 2021 +!============================================================================= + +SUBROUTINE E04NQF( start, qphx, m, n, ne, nname, lenc, ncolh, iobj, objadd, & + prob, acol, inda, loca, bl, bu, c, names, helast, hs, & + x, pi, rc, ns, ninf, sinf, obj, cw, lencw, iw, leniw, & + rw, lenrw, cuser, iuser, ruser, ifail ) + USE CUTEST_KINDS_precision + IMPLICIT NONE + INTEGER ( KIND = ip_ ), INTENT( IN ) :: m, n, ne, nname, lenc, ncolh, iobj + INTEGER ( KIND = ip_ ), INTENT( IN ) :: inda( ne ), loca( n + 1 ) + INTEGER ( KIND = ip_ ), INTENT( IN ) :: helast( n + m ), lencw, leniw, lenrw + INTEGER ( KIND = ip_ ), INTENT( INOUT ) :: hs( n + m ), ns, iw( leniw ) + INTEGER ( KIND = ip_ ), INTENT( INOUT ) :: iuser( * ), ifail + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: ninf + REAL ( KIND = rp_ ), INTENT( IN ) :: objadd + REAL ( KIND = rp_ ), INTENT( INOUT ) :: acol( ne ), bl( n + m ), bu( n + m ) + REAL ( KIND = rp_ ), INTENT( INOUT ) :: c(max(1,lenc)), x( n + m ) + REAL ( KIND = rp_ ), INTENT( INOUT ) :: rw( lenrw ), ruser( * ) + REAL ( KIND = rp_ ), INTENT( OUT ) :: pi( m ), rc( n + m ), sinf, obj + CHARACTER ( LEN = 1 ), INTENT ( IN ) :: start + CHARACTER ( LEN = 8 ), INTENT ( IN ) :: prob, names( nname ) + CHARACTER ( LEN = 8 ), INTENT ( INOUT ) :: cw( lencw ), cuser( * ) + EXTERNAL :: qphx + pi( : m ) = 0.0_rp_ + rc( : n + m ) = 0.0_rp_ + sinf = 0.0_rp_ + obj = 0.0_rp_ + ninf = 0 + ifail = 0 +END SUBROUTINE E04NQF + +SUBROUTINE qphx( ncolh, x, hx, nstate, cuser, iuser, ruser ) + USE CUTEST_KINDS_precision + IMPLICIT NONE + INTEGER ( KIND = ip_ ), INTENT( IN ) :: ncolh, nstate + INTEGER ( KIND = ip_ ), INTENT( INOUT ) :: iuser(*) + REAL ( KIND = rp_ ), INTENT( IN ) :: x(ncolh) + REAL ( KIND = rp_ ), INTENT( INOUT ) :: ruser( * ) + REAL ( KIND = rp_ ), INTENT( OUT ) :: hx(ncolh) + CHARACTER ( LEN = 8 ), INTENT( INOUT) :: cuser(*) +END SUBROUTINE qphx + +SUBROUTINE E04NPF( cw, lencw, iw, leniw, rw, lenrw, ifail ) + USE CUTEST_KINDS_precision + IMPLICIT NONE + INTEGER ( KIND = ip_ ), INTENT ( IN ) :: lencw, leniw, lenrw + INTEGER ( KIND = ip_ ), INTENT ( INOUT ) :: ifail + INTEGER ( KIND = ip_ ), INTENT ( OUT ) :: iw( leniw ) + REAL ( KIND = rp_ ), INTENT (OUT) :: rw( lenrw ) + CHARACTER ( LEN = 8 ), INTENT (OUT) :: cw( lencw ) + ifail = 0 +END SUBROUTINE E04NPF + +SUBROUTINE E04NRF( ispecs, cw, iw, rw, ifail ) + USE CUTEST_KINDS_precision + IMPLICIT NONE + INTEGER ( KIND = ip_ ), INTENT ( IN ) :: ispecs + INTEGER ( KIND = ip_ ), INTENT ( INOUT ) :: iw( * ), ifail + REAL ( KIND = rp_ ), INTENT ( INOUT ) :: rw( * ) + CHARACTER ( LEN = 8 ), INTENT ( INOUT ) :: cw( * ) + ifail = 0 +END SUBROUTINE E04NRF diff --git a/src/e04nqf/e04nqf_test.f90 b/src/e04nqf/e04nqf_test.f90 deleted file mode 100644 index 1b2bf82..0000000 --- a/src/e04nqf/e04nqf_test.f90 +++ /dev/null @@ -1,40 +0,0 @@ -! ( Last modified on 12 Mar 2021 at 15:50:00 ) - -! slimline CUTEst interface E04NQF -! Nick Gould, March 2021 - -!============================================================================= -! abreviated header from -! https://www.nag.com/numeric/fl/nagdoc_latest/html/e04/e04nqf.html -! 12 Mar 2021 -!============================================================================= - -SUBROUTINE E04NQF( start, qphx, m, n, ne, nname, lenc, ncolh, iobj, objadd, & - prob, acol, inda, loca, bl, bu, c, names, helast, hs, & - x, pi, rc, ns, ninf, sinf, obj, cw, lencw, iw, leniw, & - rw, lenrw, cuser, iuser, ruser, ifail ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: m, n, ne, nname, lenc, ncolh, iobj, inda( ne ), & - loca( n + 1 ), helast( n + m ), lencw, leniw, lenrw - INTEGER, INTENT( INOUT ) :: hs(n+m), ns, iw(leniw), iuser(*), ifail - INTEGER, INTENT( OUT ) :: ninf - REAL ( KIND = wp ), INTENT( IN ) :: objadd - REAL ( KIND = wp ), INTENT( INOUT ) :: acol( ne ), bl( n + m ), bu( n + m ), & - c(max(1,lenc)), x( n + m ), & - rw( lenrw ), ruser( * ) - REAL ( KIND = wp ), INTENT( OUT ) :: pi( m ), rc( n + m ), sinf, obj - CHARACTER (1), INTENT ( IN ) :: start - CHARACTER (8), INTENT ( IN ) :: prob, names( nname ) - CHARACTER (8), INTENT ( INOUT ) :: cw( lencw ), cuser( * ) - EXTERNAL :: qphx -END SUBROUTINE E04NQF - -SUBROUTINE qphx( ncolh, x, hx, nstate, cuser, iuser, ruser ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: ncolh, nstate - INTEGER, INTENT( INOUT ) :: iuser(*) - REAL ( KIND = wp ), INTENT( IN ) :: x(ncolh) - REAL ( KIND = wp ), INTENT( INOUT ) :: ruser( * ) - REAL ( KIND = wp ), INTENT( OUT ) :: hx(ncolh) - CHARACTER (8), INTENT( INOUT) :: cuser(*) -END SUBROUTINE qphx diff --git a/src/e04nqf/makemaster b/src/e04nqf/makemaster index cb40ff3..6968c1d 100644 --- a/src/e04nqf/makemaster +++ b/src/e04nqf/makemaster @@ -1,171 +1,37 @@ # Main body of the installation makefile for CUTEst E04NQF interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 26 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-25 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = E04NQF -package = e04nqf - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -#FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) \ -# -I$(E04NQF)/mod $(F90) $(USUAL) -#FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) \ -# -I$(E04NQF)/mod $(F90) $(SPECIAL) -#FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) -I$(E04NQF)/mod $(F90) -#FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(E04NQF)/mod \ -# $(F77) $(USUAL) -#FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(E04NQF)/mod \ -# $(F77) $(SPECIAL) -#FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) -I$(E04NQF)/mod \ -# $(F77) $(USUAL) -#RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(E04NQF)/mod - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -#$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -#$(package)_single: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -#$(package)_double: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -$(package)_single: $(OBJ)/$(package)_main.o -$(package)_double: $(OBJ)/$(package)_main.o - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - echo "$(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +PACKAGE = E04NQF +package = e04nqf -# individual compilations +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +# include standard CUTEst makefile definitions -# CUTEst interface main programs +include $(CUTEST)/src/makedefs/definitions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 $(OBJ)/*.mod - @printf '[ OK ]\n' +# include compilation and run instructions -$(OBJ)/$(package)_dummy.o: ../$(package)/$(package)_dummy.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_dummy" - $(SED) -f $(SEDS) ../$(package)/$(package)_dummy.f90 > \ - $(OBJ)/$(package)_dummy.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_dummy.o $(FFLAGS) \ - $(package)_dummy.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_dummy.o $(FFLAGS77N) \ - $(package)_dummy.f90 ) - $(RM) $(OBJ)/$(package)_dummy.f90 $(OBJ)/$(package)_dummy.o - $(RMOBFILE) $(package)_main.o - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_qp_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/filtersd/filtersd_main.f b/src/filtersd/filtersd_main.F similarity index 77% rename from src/filtersd/filtersd_main.f rename to src/filtersd/filtersd_main.F index 8d7e43e..b08f684 100644 --- a/src/filtersd/filtersd_main.f +++ b/src/filtersd/filtersd_main.F @@ -1,6 +1,10 @@ -C ( Last modified on 30 Jan 2013 at 10:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" C this is based on an amalgam of driver.f and user.f from the + C filterSD source distribution PROGRAM filtersd_main @@ -18,23 +22,27 @@ PROGRAM filtersd_main C CUTEr interface by Roger Fletcher (U. Dundee) C Revised for CUTEst, Nick Gould, January 2013 - IMPLICIT DOUBLE PRECISION ( a-h, o-z ) - - INTEGER :: status, m, n, mxm1, mxmc, mxgr, mxf, mxiws, mxws, nout - INTEGER :: iprint, kmax, maxf, max_iter, mlp, len_iws, len_ws, mc - INTEGER :: maxgr, maxsc, maxu, maxiu, maxla, maxg, maxa, nv, ipeq - INTEGER :: nnzj, ifail, nout1, itn, nft, ngt, kk, ll, kkk, lll - INTEGER :: iter, npv, ngr, ninf, k - INTEGER, PARAMETER :: input = 7 - INTEGER, PARAMETER :: mbar = 5 - INTEGER, ALLOCATABLE, DIMENSION( : ) :: iws - DOUBLE PRECISION :: rho, htol, rgtol, ainfty, fmin, f, h, ubd - DOUBLE PRECISION :: dnorm, rgnorm, hJt, eps, tol, emin, hJ, vstep - DOUBLE PRECISION :: v( mbar ) - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: x, bl, bu, al - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: ws - CHARACTER, allocatable, dimension( : ) :: cstype + USE CUTEST_KINDS_precision + IMPLICIT REAL ( KIND = rp_ ) ( a-h, o-z ) + + INTEGER ( KIND = ip_ ) :: status, m, n, mxm1, mxmc, mxgr, mxf + INTEGER ( KIND = ip_ ) :: mxiws, mxws, nout, len_iws, len_ws, mc + INTEGER ( KIND = ip_ ) :: iprint, kmax, maxf, max_iter, mlp + INTEGER ( KIND = ip_ ) :: maxgr, maxsc, maxu, maxiu, maxla, maxg + INTEGER ( KIND = ip_ ) :: maxa, nv, ipeq, ll, kkk, lll + INTEGER ( KIND = ip_ ) :: nnzj, ifail, nout1, itn, nft, ngt, kk + INTEGER ( KIND = ip_ ) :: iter, npv, ngr, ninf, k + INTEGER ( KIND = ip_ ), PARAMETER :: input = 7 + INTEGER ( KIND = ip_ ), PARAMETER :: mbar = 5 + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: iws + REAL ( KIND = rp_ ) :: rho, htol, rgtol, ainfty, fmin, f, h, ubd + REAL ( KIND = rp_ ) :: dnorm, rgnorm, hJt, eps, tol, emin + REAL ( KIND = rp_ ) :: hJ, vstep + REAL ( KIND = rp_ ) :: v( mbar ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: x, bl, bu, al + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: ws + CHARACTER, ALLOCATABLE, DIMENSION( : ) :: cstype CHARACTER ( len = 10 ) :: pname C CHARACTER :: ch @@ -57,7 +65,7 @@ PROGRAM filtersd_main C compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 mxm1 = min( m + 1, n ) @@ -104,11 +112,11 @@ PROGRAM filtersd_main & htol, rgtol, max_iter, iprint, nout, ifail ) IF ( ifail .eq. 4 .AND. h .gt. ubd ) THEN - ubd = 11.D-1 * h + ubd = 11.0E-1_rp_ * h GO TO 10 END IF - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) C OPEN( 99, STATUS = 'old', ERR = 998 ) C 997 CONTINUE @@ -143,7 +151,7 @@ PROGRAM filtersd_main & CALLS( 5 ), CALLS( 6 ), ifail, f, CPU( 1 ), CPU( 2 ) DEALLOCATE( x, bl, bu, al, CSTYPE, iws, ws, STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -181,30 +189,31 @@ PROGRAM filtersd_main C initialization subroutine SUBROUTINE INITIALIZE( n, m, nnzj, x, bl, bu, ws, iws, len_iws ) - IMPLICIT DOUBLE PRECISION (a-h, o-z) - INTEGER :: n, m, nnzj, len_iws - INTEGER :: iws(len_iws) - DOUBLE PRECISION :: x(*), bl(*), bu(*), ws(*) + USE CUTEST_KINDS_precision + IMPLICIT REAL ( KIND = rp_ ) (a-h, o-z) + INTEGER ( KIND = ip_ ) :: n, m, nnzj, len_iws + INTEGER ( KIND = ip_ ) :: iws(len_iws) + REAL ( KIND = rp_ ) :: x(*), bl(*), bu(*), ws(*) CHARACTER ( len = 10 ) pname LOGICAL :: equatn(m), linear(m) - INTEGER, PARAMETER :: input = 7 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: status, maxa, ip, i, j, k, lj - INTEGER, ALLOCATABLE, DIMENSION( : ) :: iuser + INTEGER ( KIND = ip_ ), PARAMETER :: input = 7 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: status, maxa, ip, i, j, k, lj + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: iuser COMMON / pnamec / pname COMMON / maxac / maxa - CALL CUTEST_csetup(status, input, 6, io_buffer, n, m, x, bl, bu, + CALL CUTEST_csetup_r(status, input, 6, io_buffer, n, m, x, bl, bu, & ws,bl(n+1), bu(n+1), equatn, linear, & 0, 0, 0 ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) IF ( status /= 0 ) GO TO 910 C compute the numbers of nonzeros in the constraint Jacobian - CALL CUTEST_cdimsj( status, lj ) + CALL CUTEST_cdimsj_r( status, lj ) IF ( status /= 0 ) GO TO 910 ALLOCATE( iuser( lj ), STAT = status ) @@ -214,7 +223,7 @@ SUBROUTINE INITIALIZE( n, m, nnzj, x, bl, bu, ws, iws, len_iws ) C Note nonzero column indices are in ascending order C followed by n zero column indices (objective function) - CALL CUTEST_csgr( status, n, m, x, x(n+1), .FALSE., + CALL CUTEST_csgr_r( status, n, m, x, x(n+1), .FALSE., & nnzj, lj, ws, iuser, iws( 1 ) ) IF ( status /= 0 ) GO TO 910 @@ -273,14 +282,15 @@ SUBROUTINE INITIALIZE( n, m, nnzj, x, bl, bu, ws, iws, len_iws ) C function and constraint evaluation routine SUBROUTINE FUNCTIONS( n, m, x, f, c, user, iuser ) - IMPLICIT DOUBLE PRECISION (a-h, o-z) - INTEGER :: n, m - DOUBLE PRECISION :: f - INTEGER :: iuser(*) - DOUBLE PRECISION :: x(*), c(*), user(*) - INTEGER :: status - - CALL CUTEST_cfn(status, n, m, x, f, c) + USE CUTEST_KINDS_precision + IMPLICIT REAL ( KIND = rp_ ) (a-h, o-z) + INTEGER ( KIND = ip_ ) :: n, m + REAL ( KIND = rp_ ) :: f + INTEGER ( KIND = ip_ ) :: iuser(*) + REAL ( KIND = rp_ ) :: x(*), c(*), user(*) + INTEGER ( KIND = ip_ ) :: status + + CALL CUTEST_cfn_r(status, n, m, x, f, c) IF ( status /= 0 ) THEN write( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") & status @@ -292,14 +302,15 @@ SUBROUTINE FUNCTIONS( n, m, x, f, c, user, iuser ) C function and constraint gradients evaluation routine SUBROUTINE GRADIENTS( n, m, x, a, user, iuser ) - IMPLICIT DOUBLE PRECISION( a-h, o-z ) - INTEGER :: n, m - INTEGER :: iuser(*) - DOUBLE PRECISION :: x(*), a(*), user(*) - INTEGER :: status, i, nnzj, maxa + USE CUTEST_KINDS_precision + IMPLICIT REAL ( KIND = rp_ )( a-h, o-z ) + INTEGER ( KIND = ip_ ) :: n, m + INTEGER ( KIND = ip_ ) :: iuser(*) + REAL ( KIND = rp_ ) :: x(*), a(*), user(*) + INTEGER ( KIND = ip_ ) :: status, i, nnzj, maxa COMMON / maxac / maxa - CALL CUTEST_csgr( status, n, m, x, x( n + 1 ), .false., + CALL CUTEST_csgr_r( status, n, m, x, x( n + 1 ), .false., & nnzj, maxa, a, iuser, iuser( maxa + 1 ) ) IF ( status /= 0 ) THEN write( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") @@ -326,16 +337,17 @@ SUBROUTINE GRADIENTS( n, m, x, a, user, iuser ) SUBROUTINE READPAR_SD( iprint, kmax, maxf, maxiter, mlp, mxiws, & mxws, nout, rho, htol, rgtol, maxgr, maxsc, ainfty ) + USE CUTEST_KINDS_precision IMPLICIT NONE C ... declaration of passed parameters - INTEGER :: iprint, kmax, maxf, maxiter, mlp, mxiws, mxws, nout - INTEGER :: maxgr, maxsc - DOUBLE PRECISION :: rho, htol, rgtol, ainfty + INTEGER ( KIND = ip_ ) :: iprint, kmax, maxf, maxiter, mlp, mxiws + INTEGER ( KIND = ip_ ) :: maxgr, maxsc, mxws, nout + REAL ( KIND = rp_ ) :: rho, htol, rgtol, ainfty C ... declaration of internal variables - INTEGER, parameter :: nin = 29 - DOUBLE PRECISION :: value + INTEGER ( KIND = ip_ ), parameter :: nin = 29 + REAL ( KIND = rp_ ) :: value CHARACTER ( len = 8 ) :: option C ======================== procedure body ========================= diff --git a/src/filtersd/filtersd_test.F b/src/filtersd/filtersd_test.F new file mode 100644 index 0000000..d8ffb21 --- /dev/null +++ b/src/filtersd/filtersd_test.F @@ -0,0 +1,43 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy FILTERSD for testing filtersd_main interface to CUTEst + +C Nick Gould, 30th January 2013 + + SUBROUTINE filterSD(n, m, x, al, f, fmin, cstype, bl, bu, ws, lws, + * v, nv, maxa, maxla, maxu, maxiu, kmax, maxg, rho, htol, rgtol, + * maxit, iprint, nout, ifail) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, m, nv ,maxa, maxla, maxu, maxiu, kmax + INTEGER ( KIND = ip_ ) :: maxg, maxit, iprint, nout, ifail + REAL ( KIND = rp_ ) :: f, fmin, rho, htol, rgtol + INTEGER ( KIND = ip_ ) :: lws( * ) + REAL ( KIND = rp_ ) :: x( * ), al( * ), bl( * ), bu( * ) + REAL ( KIND = rp_ ) :: ws( * ), v( * ) + CHARACTER :: cstype( * ) + + INTEGER ( KIND = ip_ ) :: last1, ncx1, npv, ngr, ninf + INTEGER ( KIND = ip_ ) :: mlp, mxf, ipeq, k, itn, nft, ngt, iter + REAL ( KIND = rp_ ) :: ainfty, ubd, dnorm, h, hJt, hJ + REAL ( KIND = rp_ ) :: rgnorm, vstep + + COMMON / defaultc / ainfty, ubd, mlp, mxf + COMMON / statsc / dnorm, h, hJt, hJ, ipeq, k, itn, nft, ngt + COMMON / infoc / rgnorm, vstep, iter, npv, ngr, ninf + + last1 = maxu + 1 + ncx1 = last1 + 2 * maxa + CALL FUNCTIONS( n, m, x, f, ws( ncx1 ),ws, lws ) + CALL GRADIENTS( n, m, x, ws( last1 ), ws, lws ) + h = 1.0_rp_ + ubd = 1.0_rp_ + rgnorm = 1.0_rp_ + k = n + itn = 0 + nft = 1 + ngt = 2 + ifail = 5 + RETURN + END diff --git a/src/filtersd/filtersd_test.f b/src/filtersd/filtersd_test.f deleted file mode 100644 index 56f2cf7..0000000 --- a/src/filtersd/filtersd_test.f +++ /dev/null @@ -1,38 +0,0 @@ -C ( Last modified on 35 Jan 2016 at 14:40:00 ) - -C Dummy FILTERSD for testing filtersd_main interface to CUTEst -C Nick Gould, 30th January 2013 - - SUBROUTINE filterSD(n, m, x, al, f, fmin, cstype, bl, bu, ws, lws, - * v, nv, maxa, maxla, maxu, maxiu, kmax, maxg, rho, htol, rgtol, - * maxit, iprint, nout, ifail) - INTEGER :: n, m, nv ,maxa, maxla, maxu, maxiu, kmax - INTEGER :: maxg, maxit, iprint, nout, ifail - DOUBLE PRECISION :: f, fmin, rho, htol, rgtol - INTEGER :: lws( * ) - DOUBLE PRECISION :: x( * ), al( * ), bl( * ), bu( * ) - DOUBLE PRECISION :: ws( * ), v( * ) - CHARACTER :: cstype( * ) - - INTEGER :: last1, ncx1 - INTEGER :: mlp, mxf, ipeq, k, itn, nft, ngt, iter, npv, ngr, ninf - DOUBLE PRECISION :: ainfty, ubd, dnorm, h, hJt, hJ, rgnorm, vstep - - COMMON / defaultc / ainfty, ubd, mlp, mxf - COMMON / statsc / dnorm, h, hJt, hJ, ipeq, k, itn, nft, ngt - COMMON / infoc / rgnorm, vstep, iter, npv, ngr, ninf - - last1 = maxu + 1 - ncx1 = last1 + 2 * maxa - CALL FUNCTIONS( n, m, x, f, ws( ncx1 ),ws, lws ) - CALL GRADIENTS( n, m, x, ws( last1 ), ws, lws ) - h = 1.0D0 - ubd = 1.0D0 - rgnorm = 1.0D0 - k = n - itn = 0 - nft = 1 - ngt = 2 - ifail = 5 - RETURN - END diff --git a/src/filtersd/makemaster b/src/filtersd/makemaster index c0daab9..c1f28b1 100644 --- a/src/filtersd/makemaster +++ b/src/filtersd/makemaster @@ -1,141 +1,37 @@ -# Main body of the installation makefile for CUTEst filterSD interface +# Main body of the installation makefile for CUTEst FILTERSD interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 30 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = FILTERSD -package = filtersd - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = FILTERSD +package = filtersd -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/filtersqp/filtersqp_main.f b/src/filtersqp/filtersqp_main.F similarity index 82% rename from src/filtersqp/filtersqp_main.f rename to src/filtersqp/filtersqp_main.F index 566e4fe..5d5b5f9 100644 --- a/src/filtersqp/filtersqp_main.f +++ b/src/filtersqp/filtersqp_main.F @@ -1,4 +1,7 @@ -c ( Last modified on 9 Jan 2013 at 09:15:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" c this is an amalgam of CUTEdriver.f and CUTEuser.f from the c filterSQP source distribution @@ -20,57 +23,61 @@ program filter_driver c CUTEr interface by Roger Fletcher and Sven Leyffer (U. Dundee) c Revised for CUTEst, Nick Gould, January 2013 + use CUTEST_KINDS_precision implicit none - integer kmax, maxa, maxf, mlp, mxwk, mxiwk, nnzh, nnzj, status - integer len_lws,len_ws, luser, liuser + integer ( kind = ip_ ) kmax, maxa, maxf, mxwk, mxiwk, nnzh, nnzj + integer ( kind = ip_ ) len_lws,len_ws, luser, liuser, status, mlp c CUTEst input unit - integer, parameter :: input = 7 + integer ( kind = ip_ ), parameter :: input = 7 c ... internal variables -- scalars - integer n, m, iprint, i, j, idummy, m_nln, ifail, nout, max_iter - double precision rho, f, fmin, CPU_start, CPU_end, CPU_total - integer istat(14) - double precision rstat(7) + integer ( kind = ip_ ) n, m, iprint, i, j, idummy, m_nln, ifail + integer ( kind = ip_ ) nout, max_iter + real ( kind = rp_ ) rho, f, fmin, CPU_start, CPU_end, CPU_total + integer ( kind = ip_ ) istat(14) + real ( kind = rp_ ) rstat(7) c ... internal variables -- allocatable arrays - integer, allocatable, dimension( : ) :: la, iuser, lws - double precision, allocatable, dimension( : ) :: a, x, blo, bup, s - double precision, allocatable, dimension( : ) :: c, ws, user, lam + integer ( kind = ip_ ), allocatable, dimension( : ) :: la + integer ( kind = ip_ ), allocatable, dimension( : ) :: iuser, lws + real ( kind = rp_ ), allocatable, dimension( : ) :: a, x, blo, bup + real ( kind = rp_ ), allocatable, dimension( : ) :: s, c, ws + real ( kind = rp_ ), allocatable, dimension( : ) :: user, lam character ( len = 1 ), allocatable, dimension( : ) :: cstype character ( len = 10 ), allocatable, dimension( : ) :: xnames character ( len = 10 ), allocatable, dimension( : ) :: gnames logical, allocatable, dimension( : ) :: equatn, linear c ... common statements - double precision infty, eps + real ( kind = rp_ ) infty, eps common /NLP_eps_inf/ infty, eps c ... common to indicate initial penalty parameter & updating or not - double precision given_mu + real ( kind = rp_ ) given_mu logical update_mu common /penalty_c/ given_mu, update_mu c ... upper bound on filter - double precision ubd, tt + real ( kind = rp_ ) ubd, tt common /ubdc/ ubd, tt c ... problem name (& length) - integer char_l + integer ( kind = ip_ ) char_l character*10 pname common /cpname/ char_l, pname c ... trap IEEE exceptions c external abort,ieee_handler -c integer ieee_handler, abort +c integer ( kind = ip_ ) ieee_handler, abort c ... default options set here -c data iprint, max_iter, nout, rho, idummy /1, 1000, 6, 1.D1, 0/ +c data iprint, max_iter, nout, rho, idummy /1, 1000, 6, 10.0_rp_, 0/ iprint = 1 max_iter = 1000 nout = 6 - rho = 1.0D1 + rho = 10.0_rp_ idummy = 0 c ... trap IEEE exceptions @@ -90,7 +97,7 @@ program filter_driver c compute problem dimensions - call CUTEST_cdimen( status, input, n, m ) + call CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 c allocate space @@ -110,9 +117,9 @@ program filter_driver c compute the numbers of nonzeros in the constraint Jacobian and Hessian - call CUTEST_cdimsj( status, nnzj ) + call CUTEST_cdimsj_r( status, nnzj ) IF ( status /= 0 ) GO TO 910 - call CUTEST_cdimsh( status, nnzh ) + call CUTEST_cdimsh_r( status, nnzh ) IF ( status /= 0 ) GO TO 910 c allocate further space @@ -145,7 +152,8 @@ program filter_driver CALL CPU_time( CPU_end ) CPU_total = CPU_end - CPU_start if (iprint.ge.1) then - write(nout,*)' CPU time for this solve.............',CPU_total + write(nout,"( ' CPU time for this solve.............', + . F6.2 )" ) CPU_total endif c ... count number of nonlinear c/s (for output) @@ -223,39 +231,40 @@ program filter_driver subroutine initialize_NLP (n, m, blo, bup, x, lam, equatn, . linear, cstype, xnames, gnames ) + use CUTEST_KINDS_precision implicit none - integer, parameter :: io_buffer = 11 + integer ( kind = ip_ ), parameter :: io_buffer = 11 c ... decalartion of passed parameters -- scalars - integer n, m + integer ( kind = ip_ ) n, m c ... decalartion of passed parameters -- arrays - double precision blo(n+m), bup(n+m), x(n), lam(n+m) + real ( kind = rp_ ) blo(n+m), bup(n+m), x(n), lam(n+m) logical equatn(m), linear(m) character*10 xnames(n), gnames(m) character cstype(m) c ... declaration of common blocks - integer char_l + integer ( kind = ip_ ) char_l character*10 pname common /cpname/ char_l, pname c ... declaration of internal parameters - integer input + integer ( kind = ip_ ) input parameter (input=7) c ... declaration of internal variables -- scalars - integer i, status + integer ( kind = ip_ ) i, status c ======================= procedure body ========================= c ... open SIF output file c open (file='OUTSDIF.d', unit=input) c ... read SIF output file and set up the constraints - call CUTEST_csetup(status,input, 6, io_buffer, n, m, x, blo, bup, - . lam(n+1), blo(n+1), bup(n+1), - . equatn, linear, 0, 1, 0) + call CUTEST_csetup_r(status,input, 6, io_buffer, n, m, x, + . blo, bup, lam(n+1), blo(n+1), bup(n+1), + . equatn, linear, 0, 1, 0) if ( status /= 0 ) GO TO 910 c ... shift bounds to be consecutive & find indices of nonlin. c/s @@ -269,7 +278,7 @@ subroutine initialize_NLP (n, m, blo, bup, x, lam, equatn, c print *, 'WARNING: ALL CONSTAINTS TREATED AS NONLINEAR' c ... obtain names of problem, variables and constraints - call CUTEST_cnames(status, n, m, pname, xnames, gnames) + call CUTEST_cnames_r(status, n, m, pname, xnames, gnames) if ( status /= 0 ) GO TO 910 c ... truncate pname if necessary and open main output file @@ -289,28 +298,28 @@ subroutine initialize_NLP (n, m, blo, bup, x, lam, equatn, end - c ****************************************************************** subroutine confun(x, n, m, c, a, la, user, iuser, flag) + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters -- scalars - integer n, m, flag + integer ( kind = ip_ ) n, m, flag c ... declaration of passed parameters -- arrays - double precision x(n), c(m), a(*), user(*) - integer la(0:*), iuser(*) + real ( kind = rp_ ) x(n), c(m), a(*), user(*) + integer ( kind = ip_ ) la(0:*), iuser(*) c ... declaration of internal variables logical jtrans, grad - integer lcjac1, lcjac2, status + integer ( kind = ip_ ) lcjac1, lcjac2, status c ... IEEE floatig point exception handling c external ieee_handler, abort -c integer ieee_flags, ieeer, ieee_handler +c integer ( kind = ip_ ) ieee_flags, ieeer, ieee_handler c external ieee_flags character out*16 @@ -331,8 +340,8 @@ subroutine confun(x, n, m, c, a, la, user, iuser, flag) c ieeer=ieee_handler('clear','overflow',abort) c ... call CUTE's constraint function - call CUTEST_ccfg (status, n, m, x, c, jtrans, lcjac1, lcjac2, a, - . grad) + call CUTEST_ccfg_r(status, n, m, x, c, jtrans, lcjac1, lcjac2, + . a, grad) if ( status /= 0 ) GO TO 910 c ... switch IEEE trapping back on @@ -364,23 +373,24 @@ subroutine confun(x, n, m, c, a, la, user, iuser, flag) subroutine objfun(x, n, f, user, iuser, flag) + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters -- scalars - integer n, flag - double precision f + integer ( kind = ip_ ) n, flag + real ( kind = rp_ ) f c ... declaration of passed parameters -- arrays - double precision x(n), user(*) - integer iuser(*) + real ( kind = rp_ ) x(n), user(*) + integer ( kind = ip_ ) iuser(*) c ... declaration of internal variables - integer status + integer ( kind = ip_ ) status logical grad c ... IEEE floatig point exception handling c external ieee_handler, abort -c integer ieee_flags, ieeer, ieee_handler +c integer ( kind = ip_ ) ieee_flags, ieeer, ieee_handler c external ieee_flags character out*16 @@ -398,7 +408,7 @@ subroutine objfun(x, n, f, user, iuser, flag) c ieeer=ieee_handler('clear','overflow',abort) c ... call CUTE's objective function - call CUTEST_cofg ( status, n, x, f, user, grad) + call CUTEST_cofg_r( status, n, x, f, user, grad) if ( status /= 0 ) GO TO 910 c ... switch IEEE trapping back on @@ -424,28 +434,27 @@ subroutine objfun(x, n, f, user, iuser, flag) end - c ****************************************************************** - subroutine gradient(n,m,mxa,x,a,la,maxa,user,iuser,flag) + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters -- scalars - integer n, m, mxa, maxa, flag + integer ( kind = ip_ ) n, m, mxa, maxa, flag c ... declaration of passed parameters -- arrays - integer la(0:*), iuser(*) - double precision x(n), a(maxa), user(*) + integer ( kind = ip_ ) la(0:*), iuser(*) + real ( kind = rp_ ) x(n), a(maxa), user(*) c ... declaration of internal variables logical grlagf - integer i, ii, j, jj, pjp, status + integer ( kind = ip_ ) i, ii, j, jj, pjp, status c ... IEEE floatig point exception handling c external ieee_handler, abort -c integer ieee_flags, ieeer, ieee_handler +c integer ( kind = ip_ ) ieee_flags, ieeer, ieee_handler c external ieee_flags character out*16 @@ -463,7 +472,7 @@ subroutine gradient(n,m,mxa,x,a,la,maxa,user,iuser,flag) c ieeer=ieee_handler('clear','overflow',abort) c ... call CUTE's sparse Jacobian evaluation (shift to allow for objective) - call CUTEST_csgr(status,n,m,x,user,grlagf,mxa,maxa-n,a(n+1), + call CUTEST_csgr_r(status,n,m,x,user,grlagf,mxa,maxa-n,a(n+1), . la(n+1),iuser) if ( status /= 0 ) GO TO 910 @@ -527,7 +536,7 @@ subroutine gradient(n,m,mxa,x,a,la,maxa,user,iuser,flag) c ... find objective columns do i=1,n - user(i) = 0.D0 + user(i) = 0.0_rp_ enddo ii = max( 1 , ii-n ) do i=ii,mxa @@ -567,25 +576,26 @@ subroutine gradient(n,m,mxa,x,a,la,maxa,user,iuser,flag) subroutine hessian (x,n,m,phase,lam,ws,lws,user,iuser,l_hess, . li_hess,flag) + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters -- scalars - integer n, m, phase, flag, l_hess, li_hess + integer ( kind = ip_ ) n, m, phase, flag, l_hess, li_hess c ... declaration of passed parameters -- arrays - double precision x(n), lam(n+m), ws(*), user(*) - integer lws(*), iuser(*) + real ( kind = rp_ ) x(n), lam(n+m), ws(*), user(*) + integer ( kind = ip_ ) lws(*), iuser(*) c ... declaration of internal variables - integer hess_length, i, maxhess, n1, status + integer ( kind = ip_ ) hess_length, i, maxhess, n1, status c ... user's common with Hessian storage map, used in Wdotd - integer phl, phr, phc + integer ( kind = ip_ ) phl, phr, phc common /hessc/ phl, phr, phc c ... IEEE floatig point exception handling c external ieee_handler, abort -c integer ieee_flags, ieeer, ieee_handler +c integer ( kind = ip_ ) ieee_flags, ieeer, ieee_handler c external ieee_flags character out*16 @@ -620,12 +630,12 @@ subroutine hessian (x,n,m,phase,lam,ws,lws,user,iuser,l_hess, endif if (phase.eq.1) then c ... call CUTE's Hessian WITHOUT f(x) contribution - call CUTEST_cshc( status, n, m, x, lam(n1), hess_length, + call CUTEST_cshc_r( status, n, m, x, lam(n1), hess_length, . maxhess, ws, lws(2), lws(2+maxhess)) else c ... call CUTE's normal Hessian routine - call CUTEST_csh (status, n, m, x, lam(n1), hess_length, - . maxhess, ws, lws(2), lws(2+maxhess)) + call CUTEST_csh_r(status, n, m, x, lam(n1), hess_length, + . maxhess, ws, lws(2), lws(2+maxhess)) endif if ( status /= 0 ) GO TO 910 @@ -690,17 +700,18 @@ subroutine hessian (x,n,m,phase,lam,ws,lws,user,iuser,l_hess, subroutine Wdotd (n, d, ws, lws, v) + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters - integer n, lws(*) - double precision d(n), v(n), ws(*) + integer ( kind = ip_ ) n, lws(*) + real ( kind = rp_ ) d(n), v(n), ws(*) c ... declaration of internal variables - integer i, hl, row, col + integer ( kind = ip_ ) i, hl, row, col c ... storage map for hessian - integer phl, phr, phc + integer ( kind = ip_ ) phl, phr, phc common /hessc/ phl, phr, phc c ======================== procedure body ========================= @@ -731,18 +742,19 @@ subroutine ident_Hessian (n,lws,ws,a) c Set initial Hessian = I and gradient = 0, to get l_2 closest feas. point c ======================================================================== + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters - integer n, lws(*) - double precision ws(*), a(*) + integer ( kind = ip_ ) n, lws(*) + real ( kind = rp_ ) ws(*), a(*) c ... storage map for hessian - integer phl, phr, phc + integer ( kind = ip_ ) phl, phr, phc common /hessc/ phl, phr, phc c ... declaration of internal variables - integer i + integer ( kind = ip_ ) i c ======================== procedure body ========================= @@ -756,8 +768,8 @@ subroutine ident_Hessian (n,lws,ws,a) do i=1,n lws(phr+i) = i lws(phc+i) = i - ws ( i) = 1.D0 - a ( i) = 0.D0 + ws ( i) = 1.0_rp_ + a ( i) = 0.0_rp_ enddo return diff --git a/src/filtersqp/filtersqp_test.f b/src/filtersqp/filtersqp_test.F similarity index 64% rename from src/filtersqp/filtersqp_test.f rename to src/filtersqp/filtersqp_test.F index 379eb7a..ed2a6a3 100644 --- a/src/filtersqp/filtersqp_test.f +++ b/src/filtersqp/filtersqp_test.F @@ -1,16 +1,21 @@ -C ( Last modified on 9 Jan 2013 at 12:40:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" C Dummy FILTERSQP for testing filtersqp_main interface to CUTEst + C Nick Gould, 9th January 2013 subroutine readpar (iprint, kmax, maxf, maxiter, mlp, mxiwk, . mxwk, nobj, nout, rho, stackmax) + use CUTEST_KINDS_precision implicit none c ... declaration of passed parameters - integer iprint, kmax, maxf, maxiter, mlp, mxiwk, mxwk, nobj, nout, + integer ( kind = ip_ ) iprint, kmax, maxf, maxiter, mlp + integer ( kind = ip_ ) mxiwk, mxwk, nobj, nout, . stackmax - double precision rho - double precision infty, eps + real ( kind = rp_ ) rho + real ( kind = rp_ ) infty, eps common /NLP_eps_inf/ infty, eps c print flag iprint = 1 @@ -26,19 +31,20 @@ subroutine readpar (iprint, kmax, maxf, maxiter, mlp, mxiwk, mlp = 200 c length of non-cutest real workspace required by filterSQP mxwk = 10000000 -c length of non-cutest integer workspace required by filterSQP +c length of non-cutest integer ( kind = ip_ ) workspace required by filterSQP mxiwk = 500000 c initial trust region radius rho = 10.0 - infty = HUGE( 1.0D+0 ) - eps = EPSILON( 1.0D+0 ) + infty = HUGE( 1.0_rp_ ) + eps = EPSILON( 1.0_rp_ ) return end subroutine readscale (n,m,vname,cname,fname,flen,scale,ifail) - integer n, m, ifail, flen - double precision scale(n+m) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) n, m, ifail, flen + real ( kind = rp_ ) scale(n+m) character*10 vname(n), cname(m) character*10 fname return @@ -48,14 +54,16 @@ subroutine filterSQP (n,m,kmax,maxa,maxf,mlp,mxwk,mxiwk,iprint, . nout,ifail,rho,x,c,f,fmin,blo,bup,s,a,la,ws, . lws,lam,cstype,user,iuser,max_iter,istat, . rstat) - integer n, m, kmax, maxa, maxf, mlp, mxwk, mxiwk, + use CUTEST_KINDS_precision + integer ( kind = ip_ ) n, m, kmax, maxa, maxf, mlp, mxwk, mxiwk, . iprint, nout, ifail, max_iter - double precision rho, f, fmin - integer la(0:maxa+m+2), lws(mxiwk), iuser(*), istat(14) - double precision a(maxa), blo(n+m), bup(n+m), x(n), c(m), + real ( kind = rp_ ) rho, f, fmin + integer ( kind = ip_ ) la(0:maxa+m+2), lws(mxiwk) + integer ( kind = ip_ ) iuser(*), istat(14) + real ( kind = rp_ ) a(maxa), blo(n+m), bup(n+m), x(n), c(m), . lam(n+m), ws(mxwk), user(*), rstat(7), s(n+m) character cstype(m) - integer flag, l_hess, li_hess, i, mxa + integer ( kind = ip_ ) flag, l_hess, li_hess, i, mxa l_hess = mxwk li_hess = mxiwk @@ -82,16 +90,16 @@ subroutine filterSQP (n,m,kmax,maxa,maxf,mlp,mxwk,mxiwk,iprint, istat(12) = 0 istat(13) = 0 istat(14) = 0 - rstat(1) = 0.0 - rstat(2) = 0.0 - rstat(3) = 0.0 - rstat(4) = 0.0 - rstat(5) = 0.0 - rstat(6) = 0.0 - rstat(7) = 0.0 + rstat(1) = 0.0_rp_ + rstat(2) = 0.0_rp_ + rstat(3) = 0.0_rp_ + rstat(4) = 0.0_rp_ + rstat(5) = 0.0_rp_ + rstat(6) = 0.0_rp_ + rstat(7) = 0.0_rp_ DO 10 i = 1, m + n - lam( i ) = 0.0D0 - s( i ) = 1.0D0 + lam( i ) = 0.0_rp_ + s( i ) = 1.0_rp_ 10 Continue ifail = 6 return diff --git a/src/filtersqp/makemaster b/src/filtersqp/makemaster index 39bf679..e0fa908 100644 --- a/src/filtersqp/makemaster +++ b/src/filtersqp/makemaster @@ -1,141 +1,37 @@ -# Main body of the installation makefile for CUTEst filterSQP interface +# Main body of the installation makefile for CUTEst FILTERSQP interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 9 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = FILTERSQP -package = filtersqp - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = FILTERSQP +package = filtersqp -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/gen/GEN.SPC b/src/gen/GEN.SPC deleted file mode 100644 index 8b13789..0000000 --- a/src/gen/GEN.SPC +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/gen/gen77.f b/src/gen/gen77.f deleted file mode 100644 index aeb19bf..0000000 --- a/src/gen/gen77.f +++ /dev/null @@ -1,70 +0,0 @@ -C ( Last modified on 23 Dec 2000 at 22:01:38 ) - SUBROUTINE GEN( DUMMY ) -C -C THIS IS THE DOUBLE PRECISION VERSION OF THE GENERIC PACKAGE -C - DOUBLE PRECISION DUMMY - WRITE(*,*)' ********************************' - WRITE(*,*)' * *' - WRITE(*,*)' * HELLO FROM GEN! *' - WRITE(*,*)' * (DOUBLE PRECISION) *' - WRITE(*,*)' * *' - WRITE(*,*)' ********************************' - WRITE(*,*)' ' - DUMMY = 41.9999999999999D0 - WRITE( *, * ) ' OPTIMAL SOLUTION FOUND' - WRITE( *, * ) ' THE ANSWER IS ', DUMMY - RETURN - END - - SUBROUTINE GENSPC( FUNIT, FNAME ) - -C THIS IS A DUMMY ROUTINE TO READ A SPEC FILE -C POSSIBLY, THIS ROUTINE CONTAINS PRECISION-DEPENDENT DIRECTIVES - - INTEGER FUNIT, FERROR - PARAMETER( FERROR = 6 ) - CHARACTER*7 FNAME - - OPEN( UNIT=FUNIT, FILE=FNAME, STATUS='UNKNOWN', ERR=100 ) - REWIND( FUNIT ) - -C READ COMMANDS... - - CLOSE( FUNIT ) - RETURN - - 100 WRITE( FERROR, '(A,A7)' ) 'Failure while reading ', FNAME - RETURN - - END - - SUBROUTINE GETINFO(N, M, BL, BU, EQUATN, LINEAR, NLIN, NEQ, NBNDS) -C -C Input/Output variables -C - INTEGER N, M, NLIN, NEQ, NBNDS - DOUBLE PRECISION BL( N ), BU( N ) - DOUBLE PRECISION INFTY - PARAMETER ( INFTY = 1.0D+20 ) - LOGICAL EQUATN( M ), LINEAR( M ) -C -C Local variables -C - INTEGER I - - NLIN = 0 - NEQ = 0 - NBNDS = 0 - - DO 200 I = 1, M - IF( EQUATN( I ) ) NEQ = NEQ + 1 - IF( LINEAR( I ) ) NLIN = NLIN + 1 - 200 CONTINUE - - DO 300 I = 1, N - IF( BL( I ) .GT. -INFTY .OR. BU( I ) .LT. INFTY ) - * NBNDS = NBNDS + 1 - 300 CONTINUE - - END diff --git a/src/gen/gen77_main.f b/src/gen/gen77_main.f deleted file mode 100644 index aef8b38..0000000 --- a/src/gen/gen77_main.f +++ /dev/null @@ -1,175 +0,0 @@ -C ( Last modified on 3 Jan 2013 at 16:20:00 ) - - PROGRAM GENMA -C -C Generic package driver (example) for applying package GEN to problems -C from SIF files. -C -C Ph. Toint, December 2000 / D. Orban, August 2002 / Nick Gould January 2013 -C - IMPLICIT NONE - INTEGER :: n, m, status - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: inspec = 46, input = 47, iout = 6 - INTEGER :: nlin, neq, nbnds, exitcode - LOGICAL :: constrained - CHARACTER ( LEN = 10 ) :: PNAME - DOUBLE PRECISION dummy, CPU( 4 ), CALLS( 7 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: V, CL, CU - CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAMES - CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: GNAMES - LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR -C -C Open the Spec file for the method (typically called METHOD.SPC) -C - CALL GENSPC( INSPEC, 'GEN.SPC' ) -C -C Open the relevant problem file. -C - OPEN ( INPUT, FILE = 'OUTSDIF.d', FORM = 'FORMATTED', - * STATUS = 'OLD' ) - REWIND INPUT -C -C Get problem dimensions and determine which tools to use -C - CALL CUTEST_cdimen( status, input, n, m ) - IF ( status /= 0 ) GO TO 910 - - ALLOCATE( X( n ), BL( n ), BU( n ), V( m ), CL( m ), - * CU( m ), EQUATN( m ), LINEAR( m ), VNAMES( n ), - * GNAMES( m ), STAT = status ) - IF ( status /= 0 ) GO TO 990 - - IF ( m == 0 ) THEN - constrained = .FALSE. - ELSE IF ( m > 0 ) THEN - constrained = .TRUE. - ELSE - WRITE( 6, '(A)' ) 'Error reading OUTSDIF.d' - STOP - END IF -C -C Set up SIF data from the problem file -C - IF ( constrained ) THEN - CALL CUTEST_csetup( status, input, iout, io_buffer, n, m, X, BL, - * BU, V, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) - ELSE - CALL CUTEST_usetup( status, input, iout, io_buffer, n, X, BL, - * BU ) - ENDIF - IF ( status /= 0 ) GO TO 910 -C -C Obtain problem/variables/constraints names. -C - IF ( constrained ) THEN - CALL CUTEST_cnames( status, n, m, pname, VNAMES, GNAMES ) - ELSE - CALL CUTEST_unames( status, n, pname, VNAMES ) - ENDIF - IF ( status /= 0 ) GO TO 910 -C -C Obtain info on the problem -C - nlin = 0 - neq = 0 - nbnds = 0 - IF ( constrained ) THEN - CALL GETINFO( n, m, BL, BU, EQUATN, LINEAR, nlin, neq, nbnds ) - ELSE -C EQUATN( 1 ) = .FALSE. -C LINEAR( 1 ) = .FALSE. - CALL GETINFO( n, 0, BL, BU, EQUATN, LINEAR, nlin, neq, nbnds ) - ENDIF -C -C Call the optimizer. -C - CALL GEN( dummy ) - exitcode = 0 -C -C Close the problem file -C - CLOSE( input ) -C -C Write the standard statistics (of which some may be irrelevant) -C -C CALLS( 1 ): number of calls to the objective function -C CALLS( 2 ): number of calls to the objective gradient -C CALLS( 3 ): number of calls to the objective Hessian -C CALLS( 4 ): number of Hessian times vector products -C --constrained problems only-- -C CALLS( 5 ): number of calls to the constraint functions -C CALLS( 6 ): number of calls to the constraint gradients -C CALLS( 7 ): number of calls to the constraint Hessians -C ----------------------------- -C -C CPU( 1 ) : CPU time (in seconds) for USETUP or CSETUP -C CPU( 2 ) : CPU time ( in seconds) since the end of USETUP or CSETUP -C -C Note that each constraint function is counted separately. -C Evaluating all the constraints thus results in PNC evaluations, where -C PNC is the number of constraints in the problem. Note that PNC does not -C include repetitions for constraints having full ranges. - -C (N, is the dimension of the problem, M is the number of constraints, -C DUMMY is the final value of the objective function) -C - IF ( constrained ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) - ELSE - CALL CUTEST_ureport( status, CALLS, CPU ) - ENDIF - IF ( status /= 0 ) GO TO 910 - WRITE ( iout, 2000 ) pname, n, m, nlin, neq, m-neq, nbnds, - * CALLS( 1 ), CALLS( 2 ), CALLS( 3 ) - IF ( constrained ) WRITE( iout, 2010 ) - * CALLS( 5 ), CALLS( 6 ), CALLS( 7 ) - WRITE ( iout, 2020 ) exitcode, dummy, CPU( 1 ), CPU( 2 ) -C -C Exit -C - STOP - - 910 CONTINUE - WRITE( iout, "( ' CUTEst error, status = ', i0, ', stopping' )") - * status - STOP - - 990 CONTINUE - WRITE( iout, "( ' Allocation error, status = ', I0 )" ) status - STOP -C -C Non-executable statements. -C -C The following is the complete standard statistics output format: select -C the items that are relevant to the type of problems solved and adapt the -C name of the code. -C -C The only reason for breaking the format in two is for compilers -C which do not accept more than 19 continuation lines. -C - 2000 FORMAT( /, 24('*'), ' CUTEst statistics ', 24('*') // - * ,' Package used : GEN', / - * ,' Variant : name of a variant, if needed',/ - * ,' Problem : ', A10, / - * ,' # variables = ', I10 / - * ,' # constraints = ', I10 / - * ,' # linear constraints = ', I10 / - * ,' # equality constraints = ', I10 / - * ,' # inequality constraints = ', I10 / - * ,' # bounds = ', I10 / - * ,' # objective functions = ', F8.2 / - * ,' # objective gradients = ', F8.2 / - * ,' # objective Hessians = ', F8.2 ) - 2010 FORMAT( ' # constraints functions = ', F8.2 / - * ,' # constraints gradients = ', F8.2 / - * ,' # constraints Hessians = ', F8.2 ) - 2020 FORMAT( - * ' Exit code = ', I10 / - * ,' Final f = ', E15.7 / - * ,' Set up time = ', 0P, F10.2, ' seconds'/ - * ' Solve time = ', 0P, F10.2, ' seconds'// - * 66('*') / ) - END - diff --git a/src/gen/gen90_main.f90 b/src/gen/gen90_main.f90 deleted file mode 100644 index 181886c..0000000 --- a/src/gen/gen90_main.f90 +++ /dev/null @@ -1,185 +0,0 @@ -! ( Last modified on 3 Jan 2013 at 16:20:00 ) - -PROGRAM GEN90_main - - USE Generic_Driver - -! Generic package driver (example) for applying package GEN90 to problems -! from SIF files. This driver also demonstrates how to dynamically -! allocate arrays to be used with CUTEst. -! -! D. Orban, August 2002, strongly inspired by Philippe's original driver. -! CUTEst evolution, Nick Gould January 2013 - Implicit None - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: n, m, nlin, neq, nbnds, exitcode, status - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: inspec = 46, input = 47, out = 6 - REAL ( KIND = wp ) :: DUMMY - REAL ( KIND = wp ), Dimension( : ), Allocatable :: X, BL, BU, V, CL, CU, C - REAL ( KIND = wp ), DIMENSION( 2 ) :: CPU( 4 ) - REAL ( KIND = wp ), DIMENSION( 7 ) :: CALLS( 7 ) - CHARACTER( LEN = 10 ) :: PNAME - CHARACTER( LEN = 10 ), Dimension( : ), Allocatable :: VNAMES, GNAMES - LOGICAL, DIMENSION( : ), ALLOCATABLE :: EQUATN, LINEAR - LOGICAL :: constrained -! -! Open the Spec file for the method (typically called METHOD.SPC) -! - Call GENSPC( inspec, 'GEN.SPC' ) -! -! Open the relevant problem file. -! - OPEN( input, FILE = 'OUTSDIF.d', FORM = 'FORMATTED', STATUS = 'OLD' ) - REWIND input -! -! Get problem dimensions and determine which tools to use -! - constrained = .FALSE. - CALL CUTEST_cdimen( status, input, n, m ) - IF ( status /= 0 ) GO TO 910 - If ( m > 0 ) Then - constrained = .TRUE. - ELSE IF ( m < 0 ) THEN - Write( 6, '(A)' ) 'Error reading OUTSDIF.d' - Stop - END IF - -! Set up SIF data from the problem file - - ALLOCATE( X( n ), BL( n ), BU( n ) ) - If( CONSTRAINED ) Then - ALLOCATE( V( m+1 ), CL( m+1 ), CU( m+1 ), EQUATN( m+1 ), LINEAR( m+1 ) ) - Call CUTEST_csetup( status, input, out, io_buffer, n, m, X, BL, BU, & - V, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) - Else - ALLOCATE( EQUATN( 0 ), LINEAR( 0 ) ) - Call CUTEST_usetup( status, input, out, io_buffer, n, X, BL, BU ) - Endif - IF ( status /= 0 ) GO TO 910 - -! Obtain problem/variables/constraints names. - - ALLOCATE( VNAMES( n ) ) - IF ( constrained ) THEN - Allocate( GNAMES( m ) ) - CALL CUTEST_cnames( status, n, m, pname, VNAMES, GNAMES ) - ELSE - CALL CUTEST_unames( status, n, pname, VNAMES ) - END IF - IF ( status /= 0 ) GO TO 910 - -! Obtain info on the problem - - nlin = 0 ; neq = 0 ; nbnds = 0 - If ( constrained ) Then - CALL GETINFO( n, m, BL, BU, EQUATN, LINEAR, nlin, neq, nbnds ) - Else -! EQUATN( 1 ) = .False. -! LINEAR( 1 ) = .False. - CALL GETINFO( n, 0, BL, BU, EQUATN, LINEAR, nlin, neq, nbnds ) - Endif - -! Call the "optimizer". - - CALL GEN( dummy ) - exitcode = 0 - -! Get the function value at a trial point - - X = 0.0_wp ; x( 1 ) = 1.0_wp - dummy = 0.0D+0 - If ( constrained ) Then - ALLOCATE( C( m ) ) - CALL CUTEST_cfn( status, n, m, X, dummy, C ) - Write(6,*) ' CUTEST_cfn: F(x0) = ', dummy - Write(6,*) ' CUTEST_cfn: C(x0) = ', C - DEALLOCATE( C ) - ELSE - CALL CUTEST_ufn( status, n, X, dummy ) - Write(6,*) ' CUTEST_ufn: F(x0) = ', dummy - END IF - IF ( status /= 0 ) GO TO 910 - -! Close the problem file - - Close( INPUT ) - -! Write the standard statistics (of which some may be irrelevant) - -! CALLS( 1 ): number of calls to the objective function -! CALLS( 2 ): number of calls to the objective gradient -! CALLS( 3 ): number of calls to the objective Hessian -! CALLS( 4 ): number of Hessian times vector products -! --constrained problems only-- -! CALLS( 5 ): number of calls to the constraint functions -! CALLS( 6 ): number of calls to the constraint gradients -! CALLS( 7 ): number of calls to the constraint Hessians -! ----------------------------- - -! CPU( 1 ) : CPU time (in seconds) for USETUP or CSETUP -! CPU( 2 ) : CPU time ( in seconds) since the end of USETUP or CSETUP - -! Note that each constraint function is counted separately. -! Evaluating all the constraints thus results in PNC evaluations, where -! PNC is the number of constraints in the problem. Note that PNC does not -! include repetitions for constraints having full ranges. - -! (N, is the dimension of the problem, M is the number of constraints, -! DUMMY is the final value of the objective function) - - IF ( constrained ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) - ELSE - CALL CUTEST_ureport( status, CALLS, CPU ) - ENDIF - IF ( status /= 0 ) GO TO 910 - WRITE ( out, 2000 ) pname, n, m, nlin, neq, m-neq, nbnds, & - CALLS( 1 ), CALLS( 2 ), CALLS( 3 ) - IF ( constrained ) WRITE( out, 2010 ) CALLS( 5 ), CALLS( 6 ), CALLS( 7 ) - WRITE ( out, 2020 ) exitcode, dummy, CPU( 1 ), CPU( 2 ) -! -! Free allocated memory -! - Deallocate( X, BU, BL, VNAMES, EQUATN, LINEAR ) - If( CONSTRAINED ) Deallocate( V, CL, CU, GNAMES ) -! -! Exit -! - CALL CUTEST_uterminate( status ) - STOP - - 910 CONTINUE - WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) status - STOP -! -! Non-executable statements. -! -! The following is the complete standard statistics output format: select -! the items that are relevant to the type of problems solved and adapt the -! name of the code. It is broken in two to comply with compilers -! which want to see no more than 19 continuation lines. -! -2000 FORMAT( /, 24('*'), ' CUTEst statistics ', 24('*') //, & - ' Package used : GEN90', /, & - ' Variant : name of a variant, if needed',/, & - ' Problem : ', A10, /, & - ' # variables = ', I10 /, & - ' # constraints = ', I10 /, & - ' # linear constraints = ', I10 /, & - ' # equality constraints = ', I10 /, & - ' # inequality constraints = ', I10 /, & - ' # bounds = ', I10 /, & - ' # objective functions = ', F8.2 /, & - ' # objective gradients = ', F8.2 /, & - ' # objective Hessians = ', F8.2 ) -2010 FORMAT( ' # constraints functions = ', F8.2 / & - ,' # constraints gradients = ', F8.2 / & - ,' # constraints Hessians = ', F8.2 ) -2020 FORMAT( ' Exit code = ', I10 /, & - ' Final f = ', E15.7 /, & - ' Set up time = ', 0P, F10.2, ' seconds'/ & - ' Solve time = ', 0P, F10.2, ' seconds'// & - 66('*') / ) -END PROGRAM GEN90_main - diff --git a/src/gen/genc.c b/src/gen/genc.c deleted file mode 100644 index e49b4b3..0000000 --- a/src/gen/genc.c +++ /dev/null @@ -1,90 +0,0 @@ - -/* Generic C solver, to be used with - * generic C driver, gencma.c - */ - -#include "stdio.h" - -#ifdef __cplusplus -extern "C" { /* To prevent C++ compilers from mangling symbols */ -#endif - -#include "cutest.h" - - doublereal genc( doublereal dummy ) { - - printf( "\n\tThis is the generic C solver" ); - printf( "\n\thooked to CUTEst." ); - printf( "\n\tThe magic number is 41.9999995555555\n" ); - return 41.9999995555555; - - } - - void genspc( integer funit, char *fname ) { - - integer ierr; - - /* This is a dummy routine to read a spec file. - Possibly, this routine contains precision-dependent directives */ - - /* Open relevant file */ - FORTRAN_open( &funit, fname, &ierr ); - if( ierr ) { - printf( "Error opening spec file %s.\nAborting.\n", fname ); - exit(1); - } - - /* ... Do something ... */ - - FORTRAN_close( &funit, &ierr ); - return; - - } - - void getinfo( integer n, integer m, doublereal *bl, doublereal *bu, - doublereal *cl, doublereal *cu, logical *equatn, - logical *linear, VarTypes *vartypes ) { - - int i; - - vartypes->nlin = 0; vartypes->neq = 0; vartypes->nbnds = 0; - vartypes->nrange = 0; - vartypes->nlower = 0; vartypes->nupper = 0; vartypes->nineq = 0; - vartypes->nineq_lin = 0; vartypes->nineq_nlin = 0; - vartypes->neq_lin = 0; vartypes->neq_nlin = 0; - - for( i = 0; i < n; i++ ) - if( bl[i] > -CUTE_INF || bu[i] < CUTE_INF ) vartypes->nbnds++; - for( i = 0; i < m; i++ ) { - if( linear[i] ) vartypes->nlin++; - if( equatn[i] ) { - vartypes->neq++; - if( linear[i] ) - vartypes->neq_lin++; - else - vartypes->neq_nlin++; - } else { - if( cl[i] > -CUTE_INF ) { - if( cu[i] < CUTE_INF ) - vartypes->nrange++; - else { - vartypes->nlower++; vartypes->nineq++; - } - } else { - if( cu[i] < CUTE_INF ) { - vartypes->nupper++; vartypes->nineq++; - } - } - if( !equatn[i] && linear[i] ) { - vartypes->nineq_lin++; - } else { - vartypes->nineq_nlin++; - } - } - } - return; - } - -#ifdef __cplusplus -} /* Closing brace for extern "C" block */ -#endif diff --git a/src/gen/genc_main.c b/src/gen/genc_main.c deleted file mode 100644 index 4c92ebe..0000000 --- a/src/gen/genc_main.c +++ /dev/null @@ -1,251 +0,0 @@ - -/* ============================================ - * CUTEst interface for generic package - * - * D. Orban Feb. 3, 2003 - * CUTEst evolution, Nick Gould Jan 4 2013 - * - * Take a look at $CUTEST/include/cutest.h and - * $CUTEST/src/loqo/loqoma.c for more examples. - * ============================================ - */ - -#include -#include -#include - -#define GENCMA - -#ifdef __cplusplus -extern "C" { /* To prevent C++ compilers from mangling symbols */ -#endif - -#include "cutest.h" - -#define GENC genc -#define GENSPC genspc -#define GETINFO getinfo - - doublereal GENC( doublereal ); - void GENSPC( integer, char* ); - void GETINFO( integer, integer, doublereal*, doublereal*, - doublereal*, doublereal*, logical*, logical*, - VarTypes* ); - - - integer CUTEst_nvar; /* number of variables */ - integer CUTEst_ncon; /* number of constraints */ - integer CUTEst_nnzj; /* number of nonzeros in Jacobian */ - integer CUTEst_nnzh; /* number of nonzeros in upper triangular - part of the Hessian of the Lagrangian */ - - int MAINENTRY( void ) { - - char *fname = "OUTSDIF.d"; /* CUTEst data file */ - integer funit = 42; /* FORTRAN unit number for OUTSDIF.d */ - integer iout = 6; /* FORTRAN unit number for error output */ - integer io_buffer = 11; /* FORTRAN unit internal input/output */ - integer ierr; /* Exit flag from OPEN and CLOSE */ - integer status; /* Exit flag from CUTEst tools */ - - VarTypes vtypes; - - integer ncon_dummy; - doublereal *x, *bl, *bu, *dummy1, *dummy2; - doublereal *v = NULL, *cl = NULL, *cu = NULL; - logical *equatn = NULL, *linear = NULL; - char *pname, *vnames, *gnames, *cptr; - char **Vnames, **Gnames; /* vnames and gnames as arrays of strings */ - logical grad; - integer e_order = 0, l_order = 0, v_order = 0; - logical constrained = FALSE_; - - doublereal calls[7], cpu[4]; - integer nlin = 0, nbnds = 0, neq = 0; - doublereal dummy; - integer ExitCode; - int i, j; - - /* Open problem description file OUTSDIF.d */ - ierr = 0; - FORTRAN_open( &funit, fname, &ierr ); - if( ierr ) { - printf("Error opening file OUTSDIF.d.\nAborting.\n"); - exit(1); - } - - /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); - - if( status ) { - printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - /* Determine whether to call constrained or unconstrained tools */ - if( CUTEst_ncon ) constrained = TRUE_; - - /* Seems to be needed for some Solaris C compilers */ - ncon_dummy = CUTEst_ncon + 1; - - /* Reserve memory for variables, bounds, and multipliers */ - /* and call appropriate initialization routine for CUTEst */ - MALLOC( x, CUTEst_nvar, doublereal ); - MALLOC( bl, CUTEst_nvar, doublereal ); - MALLOC( bu, CUTEst_nvar, doublereal ); - if( constrained ) { - MALLOC( equatn, CUTEst_ncon+1, logical ); - MALLOC( linear, CUTEst_ncon+1, logical ); - MALLOC( v, CUTEst_ncon+1, doublereal ); - MALLOC( cl, CUTEst_ncon+1, doublereal ); - MALLOC( cu, CUTEst_ncon+1, doublereal ); - CUTEST_csetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, - v, cl, cu, equatn, linear, - &e_order, &l_order, &v_order ); - } else { - MALLOC( equatn, 1, logical ); - MALLOC( linear, 1, logical ); - MALLOC( cl, 1, doublereal ); - MALLOC( cu, 1, doublereal ); - CUTEST_usetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, x, bl, bu ); - } - - if( status ) { - printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - /* Get problem, variables and constraints names */ - MALLOC(pname, FSTRING_LEN+1, char); - MALLOC(vnames, CUTEst_nvar * FSTRING_LEN, char); /* For Fortran */ - MALLOC(Vnames, CUTEst_nvar, char*); /* Array of strings */ - for(i = 0; i < CUTEst_nvar; i++) - MALLOC(Vnames[i], FSTRING_LEN+1, char); - - if( constrained ) { - MALLOC(gnames, CUTEst_ncon * FSTRING_LEN, char); /* For Fortran */ - MALLOC(Gnames, CUTEst_ncon, char*); /* Array of strings */ - for(i = 0; i < CUTEst_ncon; i++) - MALLOC(Gnames[i], FSTRING_LEN+1, char); - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, - pname, vnames, gnames ); - } else { - CUTEST_unames( &status, &CUTEst_nvar, pname, vnames ); - } - - if( status ) { - printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - /* Make sure to null-terminate problem name */ - pname[FSTRING_LEN] = '\0'; - - /* Transfer variables and constraint names into arrays of - * null-terminated strings. - * If you know of a simpler way to do this portably, let me know! - */ - for(i = 0; i < CUTEst_nvar; i++) { - cptr = vnames + i * FSTRING_LEN; - for(j = 0; j < FSTRING_LEN; j++) { - Vnames[i][j] = *cptr; - cptr++; - } - Vnames[i][FSTRING_LEN] = '\0'; - } - - for(i = 0; i < CUTEst_ncon; i++) { - cptr = vnames + i * FSTRING_LEN; - for(j = 0; j < FSTRING_LEN; j++) { - Gnames[i][j] = *cptr; - cptr++; - } - Gnames[i][FSTRING_LEN] = '\0'; - } - - /* Fortran strings no longer needed */ - FREE(vnames); - if(constrained) FREE(gnames); - - printf("Variable names:\n"); - for(i = 0; i < CUTEst_nvar; i++) - printf(" %s\n", Vnames[i]); - - /* Free memory for variable names */ - for(i = 0; i < CUTEst_nvar; i++) FREE(Vnames[i]); - FREE(Vnames); - - if( constrained ) printf("Constraint names:\n"); - for(i = 0; i < CUTEst_ncon; i++) - printf(" %s\n", Gnames[i]); - - /* Free memory for constraint names */ - for(i = 0; i < CUTEst_ncon; i++) FREE(Gnames[i]); - if(constrained) FREE(Gnames); - - /* Obtain basic info on problem */ - if (!constrained) { - equatn[0] = FALSE_; - linear[0] = FALSE_; - } - GETINFO(CUTEst_nvar, CUTEst_ncon, bl, bu, cl, cu, - equatn, linear, &vtypes); - - /* Call the optimizer */ - dummy = GENC( ONE ); - ExitCode = 0; - - /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu ); - - if( status ) { - printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - printf("\n\n ************************ CUTEst statistics ************************\n\n"); - printf(" Code used : GENC\n"); - printf(" Problem : %-s\n", pname); - printf(" # variables = %-10d\n", (int)CUTEst_nvar); - printf(" # constraints = %-10d\n", (int)CUTEst_ncon); - printf(" # linear constraints = %-10d\n", vtypes.nlin); - printf(" # equality constraints = %-10d\n", vtypes.neq); - printf(" # inequality constraints= %-10d\n", vtypes.nineq); - printf(" # bound constraints = %-10d\n", vtypes.nbnds); - printf(" # objective functions = %-15.7g\n", calls[0]); - printf(" # objective gradients = %-15.7g\n", calls[1]); - printf(" # objective Hessians = %-15.7g\n", calls[2]); - printf(" # Hessian-vector prdct = %-15.7g\n", calls[3]); - if(constrained) printf(" # constraints functions = %-15.7g\n", calls[4]); - if(constrained) printf(" # constraints gradients = %-15.7g\n", calls[5]); - if(constrained) printf(" # constraints Hessians = %-15.7g\n", calls[6]); - printf(" Exit code = %-10d\n", (int)ExitCode); - printf(" Final f = %-15.7g\n",dummy); - printf(" Set up time = %-10.2f seconds\n", cpu[0]); - printf(" Solve time = %-10.2f seconds\n", cpu[1]); - printf(" ******************************************************************\n\n"); - - ierr = 0; - FORTRAN_close( &funit, &ierr ); - if( ierr ) { - printf( "Error closing %s on unit %d.\n", fname, (int)funit ); - printf( "Trying not to abort.\n" ); - } - - /* Free workspace */ - FREE( pname ); - FREE( x ); FREE( bl ); FREE( bu ); - FREE( v ); FREE( cl ); FREE( cu ); - FREE( equatn ); - FREE( linear ); - - - return 0; - - } - -#ifdef __cplusplus -} /* Closing brace for extern "C" block */ -#endif diff --git a/src/gen/makemaster b/src/gen/makemaster deleted file mode 100644 index 9b3ed3d..0000000 --- a/src/gen/makemaster +++ /dev/null @@ -1,250 +0,0 @@ -# Main body of the installation makefile for CUTEst GEN programs - -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 3 I 2013 - -# package - -PACKAGE = GEN -package = gen - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/gen77.o $(OBJ)/gen90.o $(OBJ)/genc.o - -GEN77 = $(OBJ)/gen77.o $(OBJ)/gen77_main.o -GEN90 = $(OBJ)/gen90.o $(OBJ)/gen90_main.o -GENC = $(OBJ)/genc.o $(OBJ)/genc_main.o - -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# basic packages - -test: test77 test90 tesc - -test77: test77_$(PRECIS) - @printf ' %-21s\n' "CUTEst: gen77 ($(PRECIS) $(SUCC)" -test77_single: $(GEN77) -test77_double: $(GEN77) - -test90: test90_$(PRECIS) - @printf ' %-21s\n' "CUTEst: gen90 ($(PRECIS) $(SUCC)" -test90_single: $(GEN90) -test90_double: $(GEN90) - -testc: testc_$(PRECIS) - @printf ' %-21s\n' "CUTEst: genc ($(PRECIS) $(SUCC)" -testc_single: $(GENC) -testc_double: $(GENC) - -# run example tests - -run_test: run_test77 run_test90 run_testc - -run_test77: tools test_cutest test77 - echo " Test of unconstrained gen77" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test77 \ - gen77_main.o gen77.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../gen/OUTSDIF.d - - $(OBJ)/run_test77 >& ../gen/u_test77.output - cat ../gen/u_test77.output - rm $(OBJ)/run_test77 ../gen/OUTSDIF.d - echo " Test of constrained gen77" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test77 \ - gen77_main.o gen77.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../gen/OUTSDIF.d - - $(OBJ)/run_test77 >& ../gen/c_test77.output - cat ../gen/c_test77.output - rm $(OBJ)/run_test77 ../gen/OUTSDIF.d - -run_test90: tools test_cutest test90 - echo " Test of unconstrained gen90" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test90 \ - gen90_main.o gen90.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../gen/OUTSDIF.d - - $(OBJ)/run_test90 >& ../gen/u_test90.output - cat ../gen/u_test90.output - rm $(OBJ)/run_test90 ../gen/OUTSDIF.d - echo " Test of constrained gen90" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test90 \ - gen90_main.o gen90.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../gen/OUTSDIF.d - - $(OBJ)/run_test90 >& ../gen/c_test90.output - cat ../gen/c_test90.output - rm $(OBJ)/run_test90 ../gen/OUTSDIF.d - -run_testc: tools test_cutest testc - echo " Test of unconstrained genc" - cd $(OBJ) ; $(CC) -o run_testc \ - genc_main.o genc.o $(U_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../gen/OUTSDIF.d - - $(OBJ)/run_testc >& ../gen/u_testc.output - cat ../gen/u_testc.output - rm $(OBJ)/run_testc ../gen/OUTSDIF.d - echo " Test of constrained genc" - echo " $(CRUNFFLAGS)" - cd $(OBJ) ; $(CC) -o run_testc \ - genc_main.o genc.o $(C_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../gen/OUTSDIF.d - - $(OBJ)/run_testc >& ../gen/c_testc.output - cat ../gen/c_testc.output - rm $(OBJ)/run_testc ../gen/OUTSDIF.d - -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations - -$(OBJ)/gen77.o: ../gen/gen77.f - @printf ' %-9s %-15s\t\t' "Compiling" "gen77" - $(SED) -f $(SEDS) ../gen/gen77.f > $(OBJ)/gen77.f - cd $(OBJ); $(FORTRAN) -o gen77.o $(FFLAGS77) gen77.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen77.o $(FFLAGS77N) gen77.f ) - $(RM) $(OBJ)/gen77.f - @printf '[ OK ]\n' - -$(OBJ)/gen90.o: ../gen/gen90.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "gen90" - $(SED) -f $(SEDS) ../gen/gen90.f90 > $(OBJ)/gen90.f90 - cd $(OBJ); $(FORTRAN) -o gen90.o $(FFLAGS) gen90.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen90.o $(FFLAGSN) gen90.f90 ) - $(RM) $(OBJ)/gen90.f90 - @printf '[ OK ]\n' - -$(OBJ)/genc.o: ../gen/genc.c - @printf ' %-9s %-15s\t\t' "Compiling" "genc" - $(SED) -f $(SEDS) ../gen/genc.c > $(OBJ)/genc.c - cd $(OBJ); $(CC) -o genc.o $(CFLAGS) genc.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o genc.o $(CFLAGSN) genc.c ) - $(RM) $(OBJ)/genc.c - @printf '[ OK ]\n' - -# CUTEst interface main programs - -$(OBJ)/gen77_main.o: ../gen/gen77_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "gen77_main" - $(SED) -f $(SEDS) ../gen/gen77_main.f > $(OBJ)/gen77_main.f - cd $(OBJ); $(FORTRAN) -o gen77_main.o $(FFLAGS77) gen77_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen77_main.o $(FFLAGS77N) gen77_main.f ) - $(RM) $(OBJ)/gen77_main.f - @printf '[ OK ]\n' - -$(OBJ)/gen90_main.o: ../gen/gen90_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "gen90_main" - $(SED) -f $(SEDS) ../gen/gen90_main.f90 > $(OBJ)/gen90_main.f90 - cd $(OBJ); $(FORTRAN) -o gen90_main.o $(FFLAGS) gen90_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen90_main.o $(FFLAGSN) gen90_main.f90 ) - $(RM) $(OBJ)/gen90_main.f90 - @printf '[ OK ]\n' - -$(OBJ)/genc_main.o: ../gen/genc_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "genc_main" - $(SED) -f $(SEDS) ../gen/genc_main.c > $(OBJ)/genc_main.c - cd $(OBJ); $(CC) -o genc_main.o $(CFLAGS) genc_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o genc_main.o $(CFLAGSN) genc_main.c ) - $(RM) $(OBJ)/genc_main.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' - diff --git a/src/gen77/gen77.f b/src/gen77/gen77.F similarity index 74% rename from src/gen77/gen77.f rename to src/gen77/gen77.F index aeb19bf..415b23f 100644 --- a/src/gen77/gen77.f +++ b/src/gen77/gen77.F @@ -1,9 +1,15 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-23 AT 11:45 GMT. + +#include "cutest_modules.h" + C ( Last modified on 23 Dec 2000 at 22:01:38 ) SUBROUTINE GEN( DUMMY ) + + USE CUTEST_KINDS_precision C C THIS IS THE DOUBLE PRECISION VERSION OF THE GENERIC PACKAGE C - DOUBLE PRECISION DUMMY + REAL ( KIND = rp_ ) DUMMY WRITE(*,*)' ********************************' WRITE(*,*)' * *' WRITE(*,*)' * HELLO FROM GEN! *' @@ -11,7 +17,7 @@ SUBROUTINE GEN( DUMMY ) WRITE(*,*)' * *' WRITE(*,*)' ********************************' WRITE(*,*)' ' - DUMMY = 41.9999999999999D0 + DUMMY = REAL( 41.9999999999999D0, KIND = rp_ ) WRITE( *, * ) ' OPTIMAL SOLUTION FOUND' WRITE( *, * ) ' THE ANSWER IS ', DUMMY RETURN @@ -19,10 +25,12 @@ SUBROUTINE GEN( DUMMY ) SUBROUTINE GENSPC( FUNIT, FNAME ) + USE CUTEST_KINDS_precision + C THIS IS A DUMMY ROUTINE TO READ A SPEC FILE C POSSIBLY, THIS ROUTINE CONTAINS PRECISION-DEPENDENT DIRECTIVES - INTEGER FUNIT, FERROR + INTEGER ( KIND = ip_ ) FUNIT, FERROR PARAMETER( FERROR = 6 ) CHARACTER*7 FNAME @@ -40,18 +48,21 @@ SUBROUTINE GENSPC( FUNIT, FNAME ) END SUBROUTINE GETINFO(N, M, BL, BU, EQUATN, LINEAR, NLIN, NEQ, NBNDS) + + USE CUTEST_KINDS_precision + C C Input/Output variables C - INTEGER N, M, NLIN, NEQ, NBNDS - DOUBLE PRECISION BL( N ), BU( N ) - DOUBLE PRECISION INFTY - PARAMETER ( INFTY = 1.0D+20 ) + INTEGER ( KIND = ip_ ) N, M, NLIN, NEQ, NBNDS + REAL ( KIND = rp_ ) BL( N ), BU( N ) + REAL ( KIND = rp_ ) INFTY + PARAMETER ( INFTY = REAL( 1.0D+20, KIND = rp_ ) ) LOGICAL EQUATN( M ), LINEAR( M ) C C Local variables C - INTEGER I + INTEGER ( KIND = ip_ ) I NLIN = 0 NEQ = 0 diff --git a/src/gen77/gen77_main.f b/src/gen77/gen77_main.F similarity index 82% rename from src/gen77/gen77_main.f rename to src/gen77/gen77_main.F index 8e9f5ea..6c3a52c 100644 --- a/src/gen77/gen77_main.f +++ b/src/gen77/gen77_main.F @@ -1,22 +1,28 @@ -C ( Last modified on 3 Jan 2013 at 16:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-23 AT 10:15 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM GENMA -C + + USE CUTEST_KINDS_precision +C C Generic package driver (example) for applying package GEN to problems C from SIF files. C C Ph. Toint, December 2000 / D. Orban, August 2002 / Nick Gould January 2013 C IMPLICIT NONE - INTEGER :: n, m, status - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: inspec = 46, input = 47, iout = 6 - INTEGER :: nlin, neq, nbnds, exitcode + INTEGER ( KIND = ip_ ) :: n, m, status + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: inspec = 46, input = 47 + INTEGER ( KIND = ip_ ), PARAMETER :: iout = 6 + INTEGER ( KIND = ip_ ) :: nlin, neq, nbnds, exitcode LOGICAL :: constrained CHARACTER ( LEN = 10 ) :: PNAME - DOUBLE PRECISION dummy, CPU( 4 ), CALLS( 7 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: V, CL, CU + REAL ( KIND = rp_ ) dummy, CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: V, CL, CU CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAMES CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: GNAMES LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR @@ -33,7 +39,7 @@ PROGRAM GENMA C C Get problem dimensions and determine which tools to use C - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 ALLOCATE( X( n ), BL( n ), BU( n ), V( m ), CL( m ), @@ -53,20 +59,20 @@ PROGRAM GENMA C Set up SIF data from the problem file C IF ( constrained ) THEN - CALL CUTEST_csetup( status, input, iout, io_buffer, n, m, X, - * BL, BU, V, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) + CALL CUTEST_csetup_r( status, input, iout, io_buffer, n, m, + * X, BL, BU, V, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) ELSE - CALL CUTEST_usetup( status, input, iout, io_buffer, n, X, BL, - * BU ) + CALL CUTEST_usetup_r( status, input, iout, io_buffer, n, + * X, BL, BU ) ENDIF IF ( status /= 0 ) GO TO 910 C C Obtain problem/variables/constraints names. C IF ( constrained ) THEN - CALL CUTEST_cnames( status, n, m, pname, VNAMES, GNAMES ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAMES, GNAMES ) ELSE - CALL CUTEST_unames( status, n, pname, VNAMES ) + CALL CUTEST_unames_r( status, n, pname, VNAMES ) ENDIF IF ( status /= 0 ) GO TO 910 C @@ -116,9 +122,9 @@ PROGRAM GENMA C DUMMY is the final value of the objective function) C IF ( constrained ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) ELSE - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) ENDIF IF ( status /= 0 ) GO TO 910 WRITE ( iout, 2000 ) pname, n, m, nlin, neq, m-neq, nbnds, diff --git a/src/gen77/makemaster b/src/gen77/makemaster index 3b9f678..a59057d 100644 --- a/src/gen77/makemaster +++ b/src/gen77/makemaster @@ -1,169 +1,54 @@ # Main body of the installation makefile for CUTEst GEN programs -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 3 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-23 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = GEN77 -package = gen77 - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/gen77.o - -GEN77 = $(OBJ)/gen77.o $(OBJ)/gen77_main.o - -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs +PACKAGE = GEN77 +package = gen77 -all: $(package) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# basic packages +# include standard CUTEst makefile definitions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +include $(CUTEST)/src/makedefs/definitions -# basic packages +# include compilation and run instructions -test: test77 +include $(CUTEST)/src/makedefs/instructions -test77: test77_$(PRECIS) - @printf ' %-21s\n' "CUTEst: gen77 ($(PRECIS) $(SUCC)" -test77_single: $(GEN77) -test77_double: $(GEN77) +# select specific run test # run example tests -run_test: run_test77 - -run_test77: tools test_cutest test77 - echo " Test of unconstrained gen77" +run_test: tools test_cutest $(OBJ)/$(package)_main.o $(OBJ)/$(package).o + echo " Test of unconstrained $(package)" cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test77 \ - gen77_main.o gen77.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../gen77/OUTSDIF.d - - $(OBJ)/run_test77 >& ../gen77/u_test77.output - cat ../gen77/u_test77.output - rm $(OBJ)/run_test77 ../gen77/OUTSDIF.d - echo " Test of constrained gen77" + $(package)_main.o $(package).o $(U_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test77 >& ../$(package)/u_test77.output + cat ../$(package)/u_test77.output + rm $(OBJ)/run_test77 ../$(package)/OUTSDIF.d + echo " Test of constrained $(package)" cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test77 \ - gen77_main.o gen77.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../gen77/OUTSDIF.d - - $(OBJ)/run_test77 >& ../gen77/c_test77.output - cat ../gen77/c_test77.output - rm $(OBJ)/run_test77 ../gen77/OUTSDIF.d - -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations - -$(OBJ)/gen77.o: ../gen77/gen77.f - @printf ' %-9s %-15s\t\t' "Compiling" "gen77" - $(SED) -f $(SEDS) ../gen77/gen77.f > $(OBJ)/gen77.f - cd $(OBJ); $(FORTRAN) -o gen77.o $(FFLAGS77) gen77.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen77.o $(FFLAGS77N) gen77.f ) - $(RM) $(OBJ)/gen77.f - @printf '[ OK ]\n' - -# CUTEst interface main programs - -$(OBJ)/gen77_main.o: ../gen77/gen77_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "gen77_main" - $(SED) -f $(SEDS) ../gen77/gen77_main.f > $(OBJ)/gen77_main.f - cd $(OBJ); $(FORTRAN) -o gen77_main.o $(FFLAGS77) gen77_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen77_main.o $(FFLAGS77N) gen77_main.f ) - $(RM) $(OBJ)/gen77_main.f - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' + $(package)_main.o $(package).o $(C_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test77 >& ../$(package)/c_test77.output + cat ../$(package)/c_test77.output + rm $(OBJ)/run_test77 ../$(package)/OUTSDIF.d + +# include standard package compilation instructions + +include $(CUTEST)/src/makedefs/compile diff --git a/src/gen/gen90.f90 b/src/gen90/gen90.F90 similarity index 68% rename from src/gen/gen90.f90 rename to src/gen90/gen90.F90 index 2b71716..6484d24 100644 --- a/src/gen/gen90.f90 +++ b/src/gen90/gen90.F90 @@ -1,17 +1,18 @@ -! ( Last modified on 23 Dec 2000 at 22:01:38 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-23 AT 12:45 GMT. -MODULE Generic_Driver +#include "cutest_modules.h" +MODULE Generic_Driver + USE CUTEST_KINDS_precision IMPLICIT NONE PRIVATE PUBLIC :: GEN, GENSPC, GETINFO - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) -Contains +CONTAINS SUBROUTINE GEN( dummy ) - REAL( KIND = wp ) :: dummy + REAL( KIND = rp_ ) :: dummy WRITE( *, * ) ' ********************************' WRITE( *, * )' * *' @@ -20,7 +21,7 @@ SUBROUTINE GEN( dummy ) WRITE( *, * )' * *' WRITE( *, * )' ********************************' WRITE( *, * )' ' - dummy = REAL( 41.9999999999999D0, wp ) + dummy = REAL( 41.9999999999999D0, KIND = rp_ ) WRITE( *, * ) ' Optimal solution found' WRITE( *, * ) ' The answer is ', dummy RETURN @@ -31,11 +32,11 @@ SUBROUTINE GENSPC( funit, fname ) ! This is a dummy routine to read a spec file ! possibly, this routine contains precision-dependent directives - INTEGER :: funit - INTEGER, PARAMETER :: ferror = 6 + INTEGER ( KIND = ip_ ) :: funit + INTEGER ( KIND = ip_ ), PARAMETER :: ferror = 6 CHARACTER( LEN = 7 ) :: FNAME - OPEN( UNIT=funit, FILE=fname, STATUS='UNKNOWN', ERR=100 ) + OPEN( UNIT = funit, FILE = fname, STATUS = 'UNKNOWN', ERR = 100 ) REWIND( funit ) ! READ COMMANDS... @@ -48,17 +49,17 @@ SUBROUTINE GENSPC( funit, fname ) END SUBROUTINE GENSPC SUBROUTINE GETINFO( n, m, BL, BU, EQUATN, LINEAR, nlin, neq, nbnds ) - ! - ! Input/Output variables - ! - INTEGER, INTENT( IN ) :: n, m - INTEGER, INTENT( OUT ) :: nlin, neq, nbnds - REAL( KIND = wp ), DIMENSION( n ), INTENT( IN ) :: BL, BU + +! Input/Output variables + + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n, m + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: nlin, neq, nbnds + REAL( KIND = rp_ ), DIMENSION( n ), INTENT( IN ) :: BL, BU LOGICAL, DIMENSION( m ), INTENT( IN ) :: EQUATN, LINEAR -! + ! Local variables -! - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+20 + + REAL( KIND = rp_ ), PARAMETER :: infty = REAL( 1.0D+20, KIND = rp_ ) INTEGER :: i nlin = 0 ; neq = 0 ; nbnds = 0 diff --git a/src/gen90/gen90.f90 b/src/gen90/gen90.f90 deleted file mode 100644 index 5f760c6..0000000 --- a/src/gen90/gen90.f90 +++ /dev/null @@ -1,76 +0,0 @@ -! ( Last modified on 23 Dec 2000 at 22:01:39 ) - -MODULE Generic_Driver - - IMPLICIT NONE - PRIVATE - PUBLIC :: GEN, GENSPC, GETINFO - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - -Contains - - SUBROUTINE GEN( dummy ) - - REAL( KIND = wp ) :: dummy - - WRITE( *, * ) ' ********************************' - WRITE( *, * )' * *' - WRITE( *, * )' * Hello from GEN90! *' - WRITE( *, * )' * (Working precision) *' - WRITE( *, * )' * *' - WRITE( *, * )' ********************************' - WRITE( *, * )' ' - dummy = REAL( 41.9999999999999D0, wp ) - WRITE( *, * ) ' Optimal solution found' - WRITE( *, * ) ' The answer is ', dummy - RETURN - END SUBROUTINE GEN - - SUBROUTINE GENSPC( funit, fname ) - -! This is a dummy routine to read a spec file -! possibly, this routine contains precision-dependent directives - - INTEGER :: funit - INTEGER, PARAMETER :: ferror = 6 - CHARACTER( LEN = 7 ) :: FNAME - - OPEN( UNIT=funit, FILE=fname, STATUS='UNKNOWN', ERR=100 ) - REWIND( funit ) - -! READ COMMANDS... - - CLOSE( funit ) - RETURN - -100 WRITE( FERROR, '(A,A7)' ) 'Failure while reading ', FNAME - RETURN - END SUBROUTINE GENSPC - - SUBROUTINE GETINFO( n, m, BL, BU, EQUATN, LINEAR, nlin, neq, nbnds ) - ! - ! Input/Output variables - ! - INTEGER, INTENT( IN ) :: n, m - INTEGER, INTENT( OUT ) :: nlin, neq, nbnds - REAL( KIND = wp ), DIMENSION( n ), INTENT( IN ) :: BL, BU - LOGICAL, DIMENSION( m ), INTENT( IN ) :: EQUATN, LINEAR -! -! Local variables -! - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+20 - INTEGER :: i - - nlin = 0 ; neq = 0 ; nbnds = 0 - - DO i = 1, m - IF ( EQUATN( i ) ) neq = neq + 1 - IF ( LINEAR( i ) ) nlin = nlin + 1 - End Do - - DO i = 1, n - IF ( BL( i ) > - infty .OR. BU( i ) < infty ) nbnds = nbnds + 1 - END DO - END SUBROUTINE GETINFO - -END MODULE Generic_Driver diff --git a/src/gen90/gen90_main.f90 b/src/gen90/gen90_main.F90 similarity index 80% rename from src/gen90/gen90_main.f90 rename to src/gen90/gen90_main.F90 index 99e87f9..a779923 100644 --- a/src/gen90/gen90_main.f90 +++ b/src/gen90/gen90_main.F90 @@ -1,42 +1,47 @@ -! ( Last modified on 3 Jan 2013 at 16:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-23 AT 12:45 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM GEN90_main USE Generic_Driver + USE CUTEST_KINDS_precision ! Generic package driver (example) for applying package GEN90 to problems ! from SIF files. This driver also demonstrates how to dynamically ! allocate arrays to be used with CUTEst. -! -! D. Orban, August 2002, strongly inspired by Philippe's original driver. + +! D. Orban, August 2002, strongly inspired by Philippe Toint's original driver ! CUTEst evolution, Nick Gould January 2013 - Implicit None - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: n, m, nlin, neq, nbnds, exitcode, status - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: inspec = 46, input = 47, out = 6 - REAL ( KIND = wp ) :: DUMMY - REAL ( KIND = wp ), Dimension( : ), Allocatable :: X, BL, BU, V, CL, CU, C - REAL ( KIND = wp ), DIMENSION( 2 ) :: CPU( 4 ) - REAL ( KIND = wp ), DIMENSION( 7 ) :: CALLS( 7 ) + + IMPLICIT NONE + + INTEGER ( Kind = ip_ ) :: n, m, nlin, neq, nbnds, exitcode, status + INTEGER ( Kind = ip_ ) :: io_buffer = 11 + INTEGER ( Kind = ip_ ), PARAMETER :: inspec = 46, input = 47, out = 6 + REAL ( KIND = rp_ ) :: DUMMY + REAL ( KIND = rp_ ), Dimension( : ), Allocatable :: X, BL, BU, V, CL, CU, C + REAL ( KIND = rp_ ), DIMENSION( 2 ) :: CPU( 4 ) + REAL ( KIND = rp_ ), DIMENSION( 7 ) :: CALLS( 7 ) CHARACTER( LEN = 10 ) :: PNAME CHARACTER( LEN = 10 ), Dimension( : ), Allocatable :: VNAMES, GNAMES LOGICAL, DIMENSION( : ), ALLOCATABLE :: EQUATN, LINEAR LOGICAL :: constrained -! + ! Open the Spec file for the method (typically called METHOD.SPC) -! + Call GENSPC( inspec, 'GEN.SPC' ) -! + ! Open the relevant problem file. -! + OPEN( input, FILE = 'OUTSDIF.d', FORM = 'FORMATTED', STATUS = 'OLD' ) REWIND input -! + ! Get problem dimensions and determine which tools to use -! + constrained = .FALSE. - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 If ( m > 0 ) Then constrained = .TRUE. @@ -50,11 +55,11 @@ PROGRAM GEN90_main ALLOCATE( X( n ), BL( n ), BU( n ) ) If( CONSTRAINED ) Then ALLOCATE( V( m+1 ), CL( m+1 ), CU( m+1 ), EQUATN( m+1 ), LINEAR( m+1 ) ) - Call CUTEST_csetup( status, input, out, io_buffer, n, m, X, BL, BU, & - V, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) + Call CUTEST_csetup_r( status, input, out, io_buffer, n, m, X, BL, BU, & + V, CL, CU, EQUATN, LINEAR, 1, 0, 0 ) Else ALLOCATE( EQUATN( 0 ), LINEAR( 0 ) ) - Call CUTEST_usetup( status, input, out, io_buffer, n, X, BL, BU ) + Call CUTEST_usetup_r( status, input, out, io_buffer, n, X, BL, BU ) Endif IF ( status /= 0 ) GO TO 910 @@ -63,9 +68,9 @@ PROGRAM GEN90_main ALLOCATE( VNAMES( n ) ) IF ( constrained ) THEN Allocate( GNAMES( m ) ) - CALL CUTEST_cnames( status, n, m, pname, VNAMES, GNAMES ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAMES, GNAMES ) ELSE - CALL CUTEST_unames( status, n, pname, VNAMES ) + CALL CUTEST_unames_r( status, n, pname, VNAMES ) END IF IF ( status /= 0 ) GO TO 910 @@ -87,17 +92,17 @@ PROGRAM GEN90_main ! Get the function value at a trial point - X = 0.0_wp ; x( 1 ) = 1.0_wp + X = 0.0_rp_ ; x( 1 ) = 1.0_rp_ dummy = 0.0D+0 ! Write(6,*) ' CUTEST_cfn: x0 = ', X If ( constrained ) Then ALLOCATE( C( m ) ) - CALL CUTEST_cfn( status, n, m, X, dummy, C ) + CALL CUTEST_cfn_r( status, n, m, X, dummy, C ) ! Write(6,*) ' CUTEST_cfn: F(x0) = ', dummy ! Write(6,*) ' CUTEST_cfn: C(x0) = ', C DEALLOCATE( C ) ELSE - CALL CUTEST_ufn( status, n, X, dummy ) + CALL CUTEST_ufn_r( status, n, X, dummy ) ! Write(6,*) ' CUTEST_ufn: F(x0) = ', dummy END IF IF ( status /= 0 ) GO TO 910 @@ -130,38 +135,42 @@ PROGRAM GEN90_main ! DUMMY is the final value of the objective function) IF ( constrained ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) ELSE - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) ENDIF IF ( status /= 0 ) GO TO 910 WRITE ( out, 2000 ) pname, n, m, nlin, neq, m-neq, nbnds, & CALLS( 1 ), CALLS( 2 ), CALLS( 3 ) IF ( constrained ) WRITE( out, 2010 ) CALLS( 5 ), CALLS( 6 ), CALLS( 7 ) WRITE ( out, 2020 ) exitcode, dummy, CPU( 1 ), CPU( 2 ) -! + ! Free allocated memory -! + Deallocate( X, BU, BL, VNAMES, EQUATN, LINEAR ) If( CONSTRAINED ) Deallocate( V, CL, CU, GNAMES ) -! + ! Exit -! - CALL CUTEST_uterminate( status ) + + IF ( constrained ) THEN + CALL CUTEST_cterminate_r( status ) + ELSE + CALL CUTEST_uterminate_r( status ) + END IF STOP 910 CONTINUE WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) status STOP -! + ! Non-executable statements. ! ! The following is the complete standard statistics output format: select ! the items that are relevant to the type of problems solved and adapt the ! name of the code. It is broken in two to comply with compilers ! which want to see no more than 19 continuation lines. -! + 2000 FORMAT( /, 24('*'), ' CUTEst statistics ', 24('*') //, & ' Package used : GEN90', /, & ' Variant : name of a variant, if needed',/, & diff --git a/src/gen90/makemaster b/src/gen90/makemaster index 493b440..42c5566 100644 --- a/src/gen90/makemaster +++ b/src/gen90/makemaster @@ -1,102 +1,39 @@ -# Main body of the installation makefile for CUTEst GEN programs +# Main body of the installation makefile for CUTEst generic GEN90 program -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 3 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-23 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = gen90 -package = gen90 - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used +include $(CUTEST)/src/makedefs/defaults -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# Archive manipulation strings +# package name -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +PACKAGE = GEN90 +package = gen90 -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) +# include standard CUTEst makefile definitions -# compilation agenda +include $(CUTEST)/src/makedefs/definitions $(PACKAGE) = $(OBJ)/$(package).o $(OBJ)/$(package)_main.o -gen90 = $(OBJ)/gen90.o $(OBJ)/gen90_main.o - -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# basic packages - -test: test90 +gen90 = $(OBJ)/gen90.o $(OBJ)/gen90_main.o -test90: test90_$(PRECIS) - @printf ' %-21s\n' "CUTEst: gen90 ($(PRECIS) $(SUCC)" -test90_single: $(gen90) -test90_double: $(gen90) +# include compilation and run instructions -# run example tests +include $(CUTEST)/src/makedefs/instructions -run_test: run_test90 +# run example tests -run_test90: tools test_cutest $(package) test90 +run_test: tools test_cutest $(OBJ)/gen90.o $(OBJ)/gen90_main.o echo " Test of unconstrained gen90" cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test90 \ gen90_main.o gen90.o $(U_TEST) -L$(OBJ) $(LIBS) @@ -112,57 +49,6 @@ run_test90: tools test_cutest $(package) test90 cat ../gen90/c_test90.output rm $(OBJ)/run_test90 ../gen90/OUTSDIF.d -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations - -$(OBJ)/gen90.o: ../gen90/gen90.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "gen90" - $(SED) -f $(SEDS) ../gen90/gen90.f90 > $(OBJ)/gen90.f90 - cd $(OBJ); $(FORTRAN) -o gen90.o $(FFLAGS) gen90.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen90.o $(FFLAGSN) gen90.f90 ) - $(RM) $(OBJ)/gen90.f90 - @printf '[ OK ]\n' - -# CUTEst interface main programs - -$(OBJ)/gen90_main.o: ../gen90/gen90_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "gen90_main" - $(SED) -f $(SEDS) ../gen90/gen90_main.f90 > $(OBJ)/gen90_main.f90 - cd $(OBJ); $(FORTRAN) -o gen90_main.o $(FFLAGS) gen90_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o gen90_main.o $(FFLAGSN) gen90_main.f90 ) - $(RM) $(OBJ)/gen90_main.f90 - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/genc/genc.c b/src/genc/genc.C similarity index 92% rename from src/genc/genc.c rename to src/genc/genc.C index 17a10dd..efad0c6 100644 --- a/src/genc/genc.c +++ b/src/genc/genc.C @@ -1,3 +1,4 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-02 AT 14:30 GMT */ /* Generic C solver, to be used with * generic C driver, gencma.c @@ -11,7 +12,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #include "cutest.h" -doublereal genc( doublereal dummy ) +rp_ genc( rp_ dummy ) { printf( "\n\tThis is the generic C solver" ); @@ -44,8 +45,8 @@ void genspc( integer funit, char *fname ) } -void getinfo( integer n, integer m, doublereal *bl, doublereal *bu, - doublereal *cl, doublereal *cu, logical *equatn, +void getinfo( integer n, integer m, rp_ *bl, rp_ *bu, + rp_ *cl, rp_ *cu, logical *equatn, logical *linear, VarTypes *vartypes ) { diff --git a/src/genc/genc_main.c b/src/genc/genc_main.c index d869ee9..a825db6 100644 --- a/src/genc/genc_main.c +++ b/src/genc/genc_main.c @@ -1,3 +1,4 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-02 AT 14:30 GMT */ /* ============================================ * CUTEst interface for generic package @@ -14,6 +15,8 @@ #include #include +#include + #define GENCMA #ifdef __cplusplus @@ -21,15 +24,16 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #endif #include "cutest.h" +#include "cutest_routines.h" #define GENC genc #define GENSPC genspc #define GETINFO getinfo -doublereal GENC( doublereal ); +rp_ GENC( rp_ ); void GENSPC( integer, char * ); -void GETINFO( integer, integer, doublereal *, doublereal *, - doublereal *, doublereal *, logical *, logical *, +void GETINFO( integer, integer, rp_ *, rp_ *, + rp_ *, rp_ *, logical *, logical *, VarTypes * ); @@ -50,8 +54,8 @@ int MAINENTRY( void ){ VarTypes vtypes; - doublereal *x, *bl, *bu, *dummy1, *dummy2; - doublereal *v = NULL, *cl = NULL, *cu = NULL; + rp_ *x, *bl, *bu, *dummy1, *dummy2; + rp_ *v = NULL, *cl = NULL, *cu = NULL; logical *equatn = NULL, *linear = NULL; char *pname, *vnames, *gnames, *cptr; char **Vnames, **Gnames; /* vnames and gnames as arrays of strings */ @@ -59,9 +63,9 @@ int MAINENTRY( void ){ integer e_order = 1, l_order = 0, v_order = 0; logical constrained = FALSE_; - doublereal calls[7], cpu[4]; + rp_ calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; - doublereal dummy; + rp_ dummy; integer ExitCode; int i, j; @@ -75,7 +79,7 @@ int MAINENTRY( void ){ } /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); if ( status ) { @@ -88,21 +92,21 @@ int MAINENTRY( void ){ /* Reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC( x, CUTEst_nvar, doublereal ); - MALLOC( bl, CUTEst_nvar, doublereal ); - MALLOC( bu, CUTEst_nvar, doublereal ); + MALLOC( x, CUTEst_nvar, rp_ ); + MALLOC( bl, CUTEst_nvar, rp_ ); + MALLOC( bu, CUTEst_nvar, rp_ ); if ( constrained ) { MALLOC( equatn, CUTEst_ncon, logical ); MALLOC( linear, CUTEst_ncon, logical ); - MALLOC( v, CUTEst_ncon, doublereal ); - MALLOC( cl, CUTEst_ncon, doublereal ); - MALLOC( cu, CUTEst_ncon, doublereal ); - CUTEST_csetup( &status, &funit, &iout, &io_buffer, + MALLOC( v, CUTEst_ncon, rp_ ); + MALLOC( cl, CUTEst_ncon, rp_ ); + MALLOC( cu, CUTEst_ncon, rp_ ); + CUTEST_csetup_r( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, v, cl, cu, equatn, linear, &e_order, &l_order, &v_order ); - /* printf("CUTEst_nvar = %d\n", CUTEst_nvar); + /*printf("CUTEst_nvar = %d\n", CUTEst_nvar); printf("CUTEst_ncon = %d\n", CUTEst_ncon); printf("x = "); for (i = 0; i < CUTEst_nvar ; i++) @@ -138,9 +142,10 @@ int MAINENTRY( void ){ printf("\n"); */ } else - CUTEST_usetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, x, bl, bu ); - + { CUTEST_usetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, x, bl, bu ); + /* printf("CUTEst_nvar = %d\n", CUTEst_nvar); */ + } if ( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -160,12 +165,12 @@ int MAINENTRY( void ){ MALLOC(Gnames, CUTEst_ncon, char *); /* Array of strings */ for (i = 0; i < CUTEst_ncon; i++) MALLOC(Gnames[i], FSTRING_LEN + 1, char); - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, + CUTEST_cnames_r( &status, &CUTEst_nvar, &CUTEst_ncon, pname, vnames, gnames ); } else { - CUTEST_unames( &status, &CUTEst_nvar, pname, vnames ); + CUTEST_unames_r( &status, &CUTEst_nvar, pname, vnames ); } if ( status ) @@ -177,6 +182,8 @@ int MAINENTRY( void ){ /* Make sure to null-terminate problem name */ pname[FSTRING_LEN] = '\0'; + printf(" Problem : %-s\n", pname); + /* Transfer variables and constraint names into arrays of * null-terminated strings. * If you know of a simpler way to do this portably, let me know! @@ -232,7 +239,7 @@ int MAINENTRY( void ){ ExitCode = 0; /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu ); + CUTEST_creport_r( &status, calls, cpu ); if ( status ) { @@ -278,9 +285,9 @@ int MAINENTRY( void ){ FREE( linear ); if ( constrained ) - CUTEST_cterminate( &status ); + CUTEST_cterminate_r( &status ); else - CUTEST_uterminate( &status ); + CUTEST_uterminate_r( &status ); return 0; diff --git a/src/genc/makemaster b/src/genc/makemaster index 6929fe8..ad15297 100644 --- a/src/genc/makemaster +++ b/src/genc/makemaster @@ -1,169 +1,54 @@ -# Main body of the installation makefile for CUTEst GEN programs +# Main body of the installation makefile for CUTEst generic GENC program -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 3 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-23 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = genc -package = genc - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/genc.o - -genc = $(OBJ)/genc.o $(OBJ)/genc_main.o - -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) +PACKAGE = genc +package = genc -# basic packages +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +# include standard CUTEst makefile definitions -# basic packages +include $(CUTEST)/src/makedefs/definitions -test: testc +$(PACKAGE) = $(OBJ)/$(package).o $(OBJ)/$(package)_main.o +$(package) = $(OBJ)/$(package).o $(OBJ)/$(package)_main.o -testc: testc_$(PRECIS) - @printf ' %-21s\n' "CUTEst: genc ($(PRECIS) $(SUCC)" -testc_single: $(genc) -testc_double: $(genc) +# include compilation and run instructions -# run example tests +include $(CUTEST)/src/makedefs/instructions -run_test: run_testc +# run example tests -run_testc: tools test_cutest testc - echo " Test of unconstrained genc" +run_test: tools test_cutest $(OBJ)/$(package).o $(OBJ)/$(package)_main.o + echo " Test of unconstrained $(package)" cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_testc \ - genc_main.o genc.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../genc/OUTSDIF.d - - $(OBJ)/run_testc >& ../genc/u_testc.output - cat ../genc/u_testc.output - rm $(OBJ)/run_testc ../genc/OUTSDIF.d - echo " Test of constrained genc" + $(package)_main.o $(package).o $(U_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_testc >& ../$(package)/u_testc.output + cat ../$(package)/u_testc.output + rm $(OBJ)/run_testc ../$(package)/OUTSDIF.d + echo " Test of constrained $(package)" cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_testc \ - genc_main.o genc.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../genc/OUTSDIF.d - - $(OBJ)/run_testc >& ../genc/c_testc.output - cat ../genc/c_testc.output - rm $(OBJ)/run_testc ../genc/OUTSDIF.d - -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations - -$(OBJ)/genc.o: ../genc/genc.c - @printf ' %-9s %-15s\t\t' "Compiling" "genc" - $(SED) -f $(SEDS) ../genc/genc.c > $(OBJ)/genc.c - cd $(OBJ); $(CC) -o genc.o -g $(CFLAGS) genc.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o genc.o $(CFLAGSN) genc.c ) - $(RM) $(OBJ)/genc.c - @printf '[ OK ]\n' - -# CUTEst interface main programs - -$(OBJ)/genc_main.o: ../genc/genc_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "genc_main" - $(SED) -f $(SEDS) ../genc/genc_main.c > $(OBJ)/genc_main.c - cd $(OBJ); $(CC) -o genc_main.o $(CFLAGS) genc_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o genc_main.o $(CFLAGSN) genc_main.c ) - $(RM) $(OBJ)/genc_main.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' + $(package)_main.o $(package).o $(C_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_testc >& ../$(package)/c_testc.output + cat ../$(package)/c_testc.output + rm $(OBJ)/run_testc ../$(package)/OUTSDIF.d + +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/gsl/gsl_main.c b/src/gsl/gsl_main.c index 4d613a0..68eb5aa 100644 --- a/src/gsl/gsl_main.c +++ b/src/gsl/gsl_main.c @@ -1,9 +1,11 @@ -/* ============================================ +/* THIS VERSION: CUTEST 2.2 - 2023-12-05 AT 13:20 GMT */ + +/* ================================================= * CUTEst interface for GNU Scientific Library (GSL) * * J. Hogg 2015 * Based on GENC interface - * ============================================ + * ================================================= */ #include @@ -23,16 +25,17 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #endif #include "cutest.h" +#include "cutest_routines.h" #define GENC genc #define GENSPC genspc #define GETINFO getinfo #define DEBUG -double GENC( doublereal ); +rp_ GENC( rp_ ); void GENSPC( integer, char * ); -void GETINFO( integer, integer, doublereal *, doublereal *, - doublereal *, doublereal *, logical *, logical *, +void GETINFO( integer, integer, rp_ *, rp_ *, + rp_ *, rp_ *, logical *, logical *, VarTypes * ); integer CUTEst_nvar; /* number of variables */ @@ -46,54 +49,87 @@ struct param_data { int n; }; +#ifdef CUTEST_SINGLE +int eval_fn( const gsl_vector_float *x, void *params, gsl_vector_float *f ) { +#else int eval_fn( const gsl_vector *x, void *params, gsl_vector *f ) { +#endif struct param_data *data = (struct param_data*) params; int status; - double obj, i; - const double *xptr = gsl_vector_const_ptr(x, 0); - double *fptr = gsl_vector_ptr(f, 0); - CUTEST_cfn( &status, &data->n, &data->m, xptr, &obj, fptr); + rp_ obj, i; +#ifdef CUTEST_SINGLE + const rp_ *xptr = gsl_vector_float_const_ptr(x, 0); + rp_ *fptr = gsl_vector_float_ptr(f, 0); +#else + const rp_ *xptr = gsl_vector_const_ptr(x, 0); + rp_ *fptr = gsl_vector_ptr(f, 0); +#endif + CUTEST_cfn_r( &status, &data->n, &data->m, xptr, &obj, fptr); return GSL_SUCCESS; } -int eval_jacobian( const gsl_vector *x, void *params, gsl_matrix *J ) { + +#ifdef CUTEST_SINGLE +int eval_jacobian( const gsl_vector_float *x, void *params, + gsl_matrix_float *J ) { +#else +int eval_jacobian( const gsl_vector *x, void *params, + gsl_matrix *J ) { +#endif struct param_data *data = (struct param_data*) params; - double *y = (double *) malloc(data->m*sizeof(double)); - double *g = (double *) malloc(data->n*sizeof(double)); + rp_ *y = (rp_ *) malloc(data->m*sizeof(rp_)); + rp_ *g = (rp_ *) malloc(data->n*sizeof(rp_)); bool grlagf; bool jtrans; - const double *xptr; - double *Jptr; + const rp_ *xptr; + rp_ *Jptr; int status, ldJ; grlagf = false; jtrans = true; /* GSL uses row major */ +#ifdef CUTEST_SINGLE + xptr = gsl_vector_float_const_ptr(x, 0); + Jptr = gsl_matrix_float_ptr(J, 0, 0); +#else xptr = gsl_vector_const_ptr(x, 0); Jptr = gsl_matrix_ptr(J, 0, 0); +#endif ldJ = J->tda; - CUTEST_cgr( &status, &data->n, &data->m, xptr, y, &grlagf, g, &jtrans, + CUTEST_cgr_r( &status, &data->n, &data->m, xptr, y, &grlagf, g, &jtrans, &ldJ, &data->m, Jptr ); free(y); free(g); /* Values ignored */ return GSL_SUCCESS; } -int eval_fn_jacobian( const gsl_vector *x, void *params, gsl_vector *f, - gsl_matrix *J ) { + +#ifdef CUTEST_SINGLE +int eval_fn_jacobian( const gsl_vector_float *x, void *params, + gsl_vector_float *f, gsl_matrix_float *J ) { +#else +int eval_fn_jacobian( const gsl_vector *x, void *params, + gsl_vector *f, gsl_matrix *J ) { +#endif struct param_data *data = (struct param_data*) params; - double *y = (double *) malloc(data->m*sizeof(double)); - double *g = (double *) malloc(data->n*sizeof(double)); + rp_ *y = (rp_ *) malloc(data->m*sizeof(rp_)); + rp_ *g = (rp_ *) malloc(data->n*sizeof(rp_)); bool grlagf; bool jtrans; - const double *xptr; - double *fptr, *Jptr; + const rp_ *xptr; + rp_ *fptr, *Jptr; int status, ldJ; - double obj; + rp_ obj; grlagf = false; jtrans = true; /* GSL uses row major */ +#ifdef CUTEST_SINGLE + xptr = gsl_vector_float_const_ptr(x, 0); + Jptr = gsl_matrix_float_ptr(J, 0, 0); + fptr = gsl_vector_float_ptr(f, 0); +#else xptr = gsl_vector_const_ptr(x, 0); Jptr = gsl_matrix_ptr(J, 0, 0); fptr = gsl_vector_ptr(f, 0); - CUTEST_cfn( &status, &data->n, &data->m, xptr, &obj, fptr); +#endif + CUTEST_cfn_r( &status, &data->n, &data->m, xptr, &obj, fptr); ldJ = J->tda; - CUTEST_cgr( &status, &data->n, &data->m, xptr, y, &grlagf, g, &jtrans, - &ldJ, &data->m, Jptr ); + CUTEST_cgr_r( &status, &data->n, &data->m, xptr, y, &grlagf, g, &jtrans, + &ldJ, &data->m, Jptr ); free(y); free(g); /* Values ignored */ return GSL_SUCCESS; } @@ -114,8 +150,8 @@ int MAINENTRY( void ){ VarTypes vtypes; - doublereal *x, *bl, *bu, *dummy1, *dummy2; - doublereal *v = NULL, *cl = NULL, *cu = NULL; + rp_ *x, *bl, *bu, *dummy1, *dummy2; + rp_ *v = NULL, *cl = NULL, *cu = NULL; logical *equatn = NULL, *linear = NULL; char *pname, *vnames, *gnames, *cptr; char **Vnames; /* vnames and gnames as arrays of strings */ @@ -123,25 +159,30 @@ int MAINENTRY( void ){ integer e_order = 1, l_order = 0, v_order = 0; logical constrained = FALSE_; - doublereal calls[7], cpu[4]; + rp_ calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; integer ExitCode; int i, j; int maxiter, iter; - double epsabs, epsrel; + rp_ epsabs, epsrel; struct param_data params; + +#ifdef CUTEST_SINGLE + gsl_vector_float_view xview; +#else gsl_vector_view xview; +#endif gsl_vector *gradient; gsl_multifit_function_fdf fdf; gsl_multifit_fdfsolver *gsl; int info; - double fnval; + rp_ fnval; int write_summary, summary_size, write_iter_summary; int stopping_test; - double normJf, normf; - double tol_gradient, tol_func; + rp_ normJf, normf; + rp_ tol_gradient, tol_func; char summary_file[20], iter_summary_file[20]; int fnevals, jacevals, hessevals; @@ -155,7 +196,7 @@ int MAINENTRY( void ){ } /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); if ( status ) { @@ -168,20 +209,20 @@ int MAINENTRY( void ){ /* Reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC( x, CUTEst_nvar, doublereal ); - MALLOC( bl, CUTEst_nvar, doublereal ); - MALLOC( bu, CUTEst_nvar, doublereal ); + MALLOC( x, CUTEst_nvar, rp_ ); + MALLOC( bl, CUTEst_nvar, rp_ ); + MALLOC( bu, CUTEst_nvar, rp_ ); if ( constrained ) { MALLOC( equatn, CUTEst_ncon, logical ); MALLOC( linear, CUTEst_ncon, logical ); - MALLOC( v, CUTEst_ncon, doublereal ); - MALLOC( cl, CUTEst_ncon, doublereal ); - MALLOC( cu, CUTEst_ncon, doublereal ); - CUTEST_csetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, - v, cl, cu, equatn, linear, - &e_order, &l_order, &v_order ); + MALLOC( v, CUTEst_ncon, rp_ ); + MALLOC( cl, CUTEst_ncon, rp_ ); + MALLOC( cu, CUTEst_ncon, rp_ ); + CUTEST_csetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, + v, cl, cu, equatn, linear, + &e_order, &l_order, &v_order ); /* printf("CUTEst_nvar = %d\n", CUTEst_nvar); printf("CUTEst_ncon = %d\n", CUTEst_ncon); printf("x = "); @@ -218,8 +259,8 @@ int MAINENTRY( void ){ printf("\n"); */ } else - CUTEST_usetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, x, bl, bu ); + CUTEST_usetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, x, bl, bu ); if ( status ) { @@ -237,12 +278,12 @@ int MAINENTRY( void ){ if ( constrained ) { MALLOC(gnames, CUTEst_ncon * FSTRING_LEN, char); /* For Fortran */ - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, - pname, vnames, gnames ); + CUTEST_cnames_r( &status, &CUTEst_nvar, &CUTEst_ncon, + pname, vnames, gnames ); } else { - CUTEST_unames( &status, &CUTEst_nvar, pname, vnames ); + CUTEST_unames_r( &status, &CUTEst_nvar, pname, vnames ); } if ( status ) @@ -296,7 +337,11 @@ int MAINENTRY( void ){ fdf.p = CUTEst_nvar; fdf.params = ¶ms; /* Set up optimizer with function and initial guess */ +#ifdef CUTEST_SINGLE + xview = gsl_vector_float_view_array(x, CUTEst_nvar); +#else xview = gsl_vector_view_array(x, CUTEst_nvar); +#endif gsl_multifit_fdfsolver_set(gsl, &fdf, &xview.vector); /* Convergence parameters */ @@ -313,18 +358,24 @@ int MAINENTRY( void ){ } rewind( indr ); +#ifdef CUTEST_SINGLE + char pf[ ]="%f%*[^\n]\n"; +#else + char pf[ ]="%lf%*[^\n]\n"; +#endif + ierr = fscanf( indr, "%i%*[^\n]\n", &maxiter); if (ierr != 1) { printf("Error: failed to read max iterations from GSL.SPC; using default (1000). \n"); maxiter = 1000; } - ierr = fscanf( indr, "%lf%*[^\n]\n", &epsabs); + ierr = fscanf( indr, pf, &epsabs); if (ierr != 1) { printf("ierr = %i",ierr); printf("Error: failed to read abs tolerance from GSL.SPC; using default (1e-6). \n"); epsabs = 1e-6; } - ierr = fscanf( indr, "%lf%*[^\n]\n", &epsrel); + ierr = fscanf( indr, pf, &epsrel); if (ierr != 1) { printf("Error: failed to read abs tolerance from GSL.SPC; using default (1e-6). \n"); epsrel = 1e-6; @@ -508,7 +559,7 @@ int MAINENTRY( void ){ fnval = 0.5*normf*normf;*/ /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu ); + CUTEST_creport_r( &status, calls, cpu ); if ( status ) { @@ -596,16 +647,16 @@ int MAINENTRY( void ){ FREE(Vnames); if ( constrained ) - CUTEST_cterminate( &status ); + CUTEST_cterminate_r( &status ); else - CUTEST_uterminate( &status ); + CUTEST_uterminate_r( &status ); return 0; } -void getinfo( integer n, integer m, doublereal *bl, doublereal *bu, - doublereal *cl, doublereal *cu, logical *equatn, +void getinfo( integer n, integer m, rp_ *bl, rp_ *bu, + rp_ *cl, rp_ *cu, logical *equatn, logical *linear, VarTypes *vartypes ) { diff --git a/src/gsl/makemaster b/src/gsl/makemaster index 0741b7a..2b2b41e 100644 --- a/src/gsl/makemaster +++ b/src/gsl/makemaster @@ -1,170 +1,38 @@ -# Main body of the installation makefile for CUTEst GEN programs +# Main body of the installation makefile for CUTEst GSL interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 3 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = gsl -package = gsl - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +include $(CUTEST)/src/makedefs/defaults -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) +# package name -# compilation agenda - -#$(PACKAGE) = $(OBJ)/gsl.o - -#gsl = $(OBJ)/gsl.o $(OBJ)/gsl_main.o -gsl = $(OBJ)/gsl_main.o - -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# basic packages - -test: testc - -testc: testc_$(PRECIS) - @printf ' %-21s\n' "CUTEst: gsl ($(PRECIS) $(SUCC)" -testc_single: $(gsl) -testc_double: $(gsl) - -# run example tests - -run_test: run_testc - -run_testc: tools test_cutest testc - echo " Test of unconstrained gsl" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_testc \ - gsl_main.o gsl.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../gsl/OUTSDIF.d - - $(OBJ)/run_testc >& ../gsl/u_testc.output - cat ../gsl/u_testc.output - rm $(OBJ)/run_testc ../gsl/OUTSDIF.d - echo " Test of constrained gsl" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_testc \ - gsl_main.o gsl.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../gsl/OUTSDIF.d - - $(OBJ)/run_testc >& ../gsl/c_testc.output - cat ../gsl/c_testc.output - rm $(OBJ)/run_testc ../gsl/OUTSDIF.d +PACKAGE = GSL +package = gsl -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/gsl.o: ../gsl/gsl.c - @printf ' %-9s %-15s\t\t' "Compiling" "gsl" - $(SED) -f $(SEDS) ../gsl/gsl.c > $(OBJ)/gsl.c - cd $(OBJ); $(CC) -o gsl.o $(CFLAGS) gsl.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o gsl.o $(CFLAGSN) gsl.c ) - $(RM) $(OBJ)/gsl.c - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/gsl_main.o: ../gsl/gsl_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "gsl_main" - $(SED) -f $(SEDS) ../gsl/gsl_main.c > $(OBJ)/gsl_main.c - cd $(OBJ); $(CC) -o gsl_main.o $(CFLAGS) gsl_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o gsl_main.o $(CFLAGSN) gsl_main.c ) - $(RM) $(OBJ)/gsl_main.c - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: + echo " No $(PACKAGE) test program at the moment" -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/highs/HiGHS.SPC b/src/highs/HiGHS.SPC index 2e59312..1f8e98e 100644 --- a/src/highs/HiGHS.SPC +++ b/src/highs/HiGHS.SPC @@ -3,15 +3,15 @@ # Each option must be specified on a new line # Empty lines are ignored. - time_limit = 1e70 + time_limit = 1e35 infinite_cost = 1e20 infinite_bound = 1e20 small_matrix_value = 1e-9 large_matrix_value = 1e15 primal_feasibility_tolerance = 1e-7 dual_feasibility_tolerance = 1e-7 - objective_bound = 1e70 - objective_target = -1e70 + objective_bound = 1e35 + objective_target = -1e35 highs_random_seed = 0 highs_debug_level = 0 highs_analysis_level = 0 diff --git a/src/highs/highs_dummy.f90 b/src/highs/highs_dummy.f90 deleted file mode 100644 index e69de29..0000000 diff --git a/src/highs/highs_main.f90 b/src/highs/highs_main.F90 similarity index 82% rename from src/highs/highs_main.f90 rename to src/highs/highs_main.F90 index 230f91d..140739b 100644 --- a/src/highs/highs_main.f90 +++ b/src/highs/highs_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 15 Jul 2021 at 12:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-28 AT 16:30 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM HiGHS_main @@ -7,97 +10,94 @@ PROGRAM HiGHS_main ! Nick Gould, July 2021 USE, INTRINSIC :: iso_c_binding + USE CUTEST_KINDS_precision + USE CUTEST_INTERFACE_precision + USE CUTEST_LQP_precision USE highs_fortran_api - USE CUTEst_interface_double - USE CUTEST_LQP_double IMPLICIT NONE ! Parameters - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, PARAMETER :: input = 55 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER, PARAMETER :: out = 6 - INTEGER, PARAMETER :: input_specfile = 34 - INTEGER, PARAMETER :: spec = 29 - REAL ( KIND = wp ), PARAMETER :: ten = 10.0_wp - REAL ( KIND = wp ), PARAMETER :: ac_tol = ten ** ( - 6 ) - REAL ( KIND = wp ), PARAMETER :: eq_tol = ten ** ( - 10 ) + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: input_specfile = 34 + INTEGER ( KIND = ip_ ), PARAMETER :: spec = 29 + REAL ( KIND = rp_ ), PARAMETER :: ten = 10.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: ac_tol = ten ** ( - 6 ) + REAL ( KIND = rp_ ), PARAMETER :: eq_tol = ten ** ( - 10 ) ! Highs parameters - INTEGER ( KIND = c_int ), PARAMETER :: sense = 1 - INTEGER ( KIND = c_int ), PARAMETER :: aformat_colwise = 1 - INTEGER ( KIND = c_int ), PARAMETER :: qformat_triangular = 1 - INTEGER ( KIND = c_int ), PARAMETER :: modelstatus_optimal = 7 - INTEGER ( KIND = c_int ), PARAMETER :: runstatus_error = - 1 - INTEGER ( KIND = c_int ), PARAMETER :: runstatus_ok = 0 - INTEGER ( KIND = c_int ), PARAMETER :: runstatus_warning = - 1 - REAL ( KIND = c_double ), PARAMETER :: offset = 0 + INTEGER ( KIND = ipc_ ), PARAMETER :: sense = 1 + INTEGER ( KIND = ipc_ ), PARAMETER :: aformat_colwise = 1 + INTEGER ( KIND = ipc_ ), PARAMETER :: qformat_triangular = 1 + INTEGER ( KIND = ipc_ ), PARAMETER :: modelstatus_optimal = 7 + INTEGER ( KIND = ipc_ ), PARAMETER :: runstatus_error = - 1 + INTEGER ( KIND = ipc_ ), PARAMETER :: runstatus_ok = 0 + INTEGER ( KIND = ipc_ ), PARAMETER :: runstatus_warning = - 1 + REAL ( KIND = rpc_ ), PARAMETER :: offset = 0 LOGICAL, PARAMETER :: no_highs_logging = .TRUE. LOGICAL ( KIND = c_bool ), PARAMETER :: logical_false = .false. LOGICAL ( KIND = c_bool ), PARAMETER :: logical_true = .true. - INTEGER ( KIND = c_int ) :: iteration_count - REAL ( KIND = c_double ) :: objective_function_value + INTEGER ( KIND = ipc_ ) :: iteration_count + REAL ( KIND = rpc_ ) :: objective_function_value TYPE ( c_ptr ) :: highs ! local variables - INTEGER :: status, n, m, nea, neh, nname, lenc, ncolh, iobj, ns, ninf - INTEGER :: i, ir, ic, iter, j, k, l, l1, l2, row, col - INTEGER :: mfixed, mdegen, nfixed, ndegen, mequal, mredun - REAL ( KIND = wp ) :: f, sinf, obj, val, res_p, res_d, TIMES( 4 ), CALLS( 7 ) - REAL ( KIND = wp ) :: gcol, max_d + INTEGER ( KIND = ip_ ) :: status, n, m + INTEGER ( KIND = ip_ ) :: i, ir, ic, iter, j, l, l1, l2, row, col + INTEGER ( KIND = ip_ ) :: mfixed, mdegen, nfixed, ndegen, mequal, mredun + REAL ( KIND = rp_ ) :: f, obj, res_p, res_d, TIMES( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ) :: gcol, max_d LOGICAL :: qp, filexst, fulsol = .FALSE. - CHARACTER ( LEN = 1 ) :: equal, start, c_dummy( 1 ) - CHARACTER ( LEN = 8 ) :: prob + CHARACTER ( LEN = 1 ) :: equal CHARACTER ( LEN = 10 ) :: p_name CHARACTER ( LEN = 80 ) :: option_name, option_value - INTEGER, ALLOCATABLE, DIMENSION( : ) :: HELAST, HS, I_w, I_user - INTEGER, ALLOCATABLE, DIMENSION( : ) :: A_ptr, A_row, H_ptr, H_row - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: G, X_0, X, X_l, X_u - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: Z, Y, C_l, C_u, C, G_l - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: B_l, B_u, R_w, R_user - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: A_val, H_val + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: A_ptr, A_row + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_ptr, H_row + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: G, X_0, X_l, X_u + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Z, Y, C_l, C_u, C, G_l + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: A_val, H_val CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: X_names, C_names CHARACTER ( LEN = 5 ) :: state - CHARACTER ( LEN = 8 ), ALLOCATABLE, DIMENSION( : ) :: C_w, C_user ! local C variables - INTEGER :: modelstatus, runstatus - INTEGER ( KIND = c_int ) :: i_value, num_primal_infeasibilities - INTEGER ( KIND = c_int ) :: num_dual_infeasibilities - REAL ( KIND = c_double ) :: r_value, max_primal_infeasibility - REAL ( KIND = c_double ) :: max_dual_infeasibility + INTEGER ( KIND = ip_ ) :: modelstatus, runstatus + INTEGER ( KIND = ipc_ ) :: i_value, num_primal_infeasibilities + INTEGER ( KIND = ipc_ ) :: num_dual_infeasibilities + REAL ( KIND = rpc_ ) :: r_value, max_primal_infeasibility + REAL ( KIND = rpc_ ) :: max_dual_infeasibility LOGICAL ( KIND = c_bool ) :: b_value CHARACTER ( KIND = c_char, LEN = 80 ) :: s_value - INTEGER ( KIND = c_int ) :: numcol, numrow, numnz, hessian_numnz - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: astart - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: aindex - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: qstart - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: qindex - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: integrality - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: colbasisstatus - INTEGER ( KIND = c_int ), ALLOCATABLE, DIMENSION( : ) :: rowbasisstatus - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: colcost - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: collower - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: colupper - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: rowlower - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: rowupper - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: avalue - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: qvalue - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: sol - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: colvalue - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: coldual - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: rowvalue - REAL ( KIND = c_double ), ALLOCATABLE, DIMENSION( : ) :: rowdual + INTEGER ( KIND = ipc_ ) :: numcol, numrow, numnz, hessian_numnz + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: astart + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: aindex + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: qstart + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: qindex + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: integrality + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: colbasisstatus + INTEGER ( KIND = ipc_ ), ALLOCATABLE, DIMENSION( : ) :: rowbasisstatus + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: colcost + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: collower + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: colupper + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: rowlower + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: rowupper + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: avalue + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: qvalue + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: sol + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: colvalue + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: coldual + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: rowvalue + REAL ( KIND = rpc_ ), ALLOCATABLE, DIMENSION( : ) :: rowdual ! results summary output if required (set output_summary > 10) -! INTEGER :: output_summary = 0 - INTEGER :: output_summary = 47 +! INTEGER ( KIND = ip_ ) :: output_summary = 0 + INTEGER ( KIND = ip_ ) :: output_summary = 47 CHARACTER ( LEN = 10 ) :: summary_filename = 'HIGHS.res' ! build the QP using column storage @@ -230,22 +230,25 @@ PROGRAM HiGHS_main ALLOCATE( sol( numcol ), STAT = status ) IF ( status /= 0 ) GO TO 990 + sol = 0.0_rpc_ ALLOCATE( colvalue( numcol ), STAT = status ) IF ( status /= 0 ) GO TO 990 - colvalue = 0.0_wp + colvalue = 0.0_rpc_ ALLOCATE( coldual( numcol ), STAT = status ) IF ( status /= 0 ) GO TO 990 - coldual = 0.0_wp + coldual = 0.0_rpc_ ALLOCATE( rowvalue( numrow ), STAT = status ) IF ( status /= 0 ) GO TO 990 - rowvalue = 0.0_wp + rowvalue = 0.0_rpc_ ALLOCATE( rowdual( numrow ), STAT = status ) IF ( status /= 0 ) GO TO 990 - rowdual = 0.0_wp + rowdual = 0.0_rpc_ ALLOCATE( colbasisstatus( numcol ), STAT = status ) IF ( status /= 0 ) GO TO 990 + colbasisstatus = 0 ALLOCATE( rowbasisstatus( numrow ), STAT = status ) IF ( status /= 0 ) GO TO 990 + rowbasisstatus = 0 ! create the HiGHS environment @@ -359,7 +362,7 @@ PROGRAM HiGHS_main ! get the primal and dual solution ... - runstatus = Highs_getSolution( highs, colvalue, coldual, rowvalue, rowdual ) + runstatus = Highs_getSolution( highs, colvalue( : numcol), coldual( : numrow), rowvalue, rowdual ) ! ... and the basis @@ -414,7 +417,7 @@ PROGRAM HiGHS_main ELSE l2 = hessian_numnz END IF - obj = obj + 0.5_wp * colvalue( col ) * qvalue( l1 ) * colvalue( col ) + obj = obj + 0.5_rp_ * colvalue( col ) * qvalue( l1 ) * colvalue( col ) DO l = l1 + 1, l2 row = qindex( l ) + 1 obj = obj + colvalue( col ) * qvalue( l ) * colvalue( row ) @@ -447,7 +450,7 @@ PROGRAM HiGHS_main END DO END DO END IF - G_l( : n ) = G_l( : n ) - coldual( : n ) ; C( : m ) = 0.0_wp + G_l( : n ) = G_l( : n ) - coldual( : n ) ; C( : m ) = 0.0_rp_ DO col = 1, n gcol = G_l( col) + coldual( col ) l1 = astart( col ) + 1 @@ -485,11 +488,13 @@ PROGRAM HiGHS_main CASE ( runstatus_ok ) WRITE( output_summary, & "( A10, 1X, I8, 1X, I8, ES16.8, 2ES9.1, bn, I9, F12.2, I6 )" ) & - p_name, n, m, obj, res_p, res_d, iter, TIMES( 4 ), runstatus + p_name, n, m, objective_function_value, res_p, res_d, iter, & + TIMES( 4 ), runstatus CASE DEFAULT WRITE( output_summary, & "( A10, 1X, I8, 1X, I8, ES16.8, 2ES9.1, bn, I9, F12.2, I6 )" ) & - p_name, n, m, obj, res_p, res_d, -iter, -TIMES( 4 ), runstatus + p_name, n, m, objective_function_value, res_p, res_d, -iter, & + -TIMES( 4 ), runstatus END SELECT CLOSE( output_summary ) END IF @@ -499,7 +504,7 @@ PROGRAM HiGHS_main ! WRITE( out, "(' Final objective value = ', ES11.3 )" ) obj ! WRITE( out, "(' Optimal X = ', 7F9.2 )" ) X( : n ) - CALL CUTEST_creport( status, CALLS, TIMES ) + CALL CUTEST_creport_r( status, CALLS, TIMES ) WRITE( out, "( /, 24('*'), ' CUTEst statistics ', 24('*') // & & ,' Package used : HiGHS', / & & ,' Problem : ', A10, / & @@ -509,8 +514,8 @@ PROGRAM HiGHS_main & ,' Final f = ', ES15.7 / & & ,' Set up time = ', 0P, F10.2, ' seconds' / & & ,' Solve time = ', 0P, F10.2, ' seconds' // & - & 66('*') / )" ) p_name, n, m, runstatus, obj, & - TIMES( 1 ), TIMES( 2 ) + & 66('*') / )" ) p_name, n, m, runstatus, & + objective_function_value, TIMES( 1 ), TIMES( 2 ) l = 4 ; IF ( fulsol ) l = n @@ -597,7 +602,7 @@ PROGRAM HiGHS_main max_d = MAX( MAXVAL( ABS( rowdual( : m ) ) ), & MAXVAL( ABS( coldual( : n ) ) ) ) WRITE( out, "( /, ' Of the ', I0, ' variables, ', I0, & - ' are on bounds & ', I0, ' are dual degenerate' )" ) n, nfixed, ndegen + & ' are on bounds & ', I0, ' are dual degenerate' )" ) n, nfixed, ndegen IF ( m > 0 ) THEN WRITE( out, "( ' Of the ', I0, ' constraints, ', I0, & & ' are equations, & ', I0, ' are redundant' )" ) m, mequal, mredun @@ -610,7 +615,7 @@ PROGRAM HiGHS_main & ' Maximum constraint violation ', ES22.14, /, & & ' Maximum dual infeasibility ', ES22.14, /, & & ' Number of HiGHS iterations = ', I0 )" ) & - obj, max_d, res_p, res_d, iter + objective_function_value, max_d, res_p, res_d, iter ! destroy the HiGHS environment @@ -623,7 +628,7 @@ PROGRAM HiGHS_main colbasisstatus, rowbasisstatus, STAT = status ) DEALLOCATE( X_names, C_names, STAT = status ) IF ( qp ) DEALLOCATE( qstart, qindex, qvalue, STAT = status ) - + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE diff --git a/src/highs/highs_test.F90 b/src/highs/highs_test.F90 new file mode 100644 index 0000000..b76c01d --- /dev/null +++ b/src/highs/highs_test.F90 @@ -0,0 +1,177 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 08:30 GMT. + +#include "cutest_modules.h" + +! slimline CUTEst interface HiGHS +! Nick Gould, November 2023 + +!============================================================================= +! abreviated header modified from +! github.com/ERGO-Code/HiGHS/blob/master/src/interfaces/highs_fortran_api.f90 +! 29 Nov 2023 +!============================================================================= + +MODULE highs_fortran_api + + USE, INTRINSIC :: iso_c_binding + USE CUTEST_KINDS_precision + +CONTAINS + + FUNCTION Highs_run ( h ) result ( s ) bind( c, name='Highs_run' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_run + + FUNCTION Highs_getModelStatus (h) & + result(model_status) bind(c, name='Highs_getModelStatus') + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + INTEGER ( ipc_ ) :: model_status + s = 0_ipc_ + END FUNCTION Highs_getModelStatus + + FUNCTION Highs_passLp ( h, numcol, numrow, numnz, aformat,& + sense, offset, colcost, collower, colupper, rowlower, rowupper, & + astart, aindex, avalue) result ( s ) bind ( c, name='Highs_passLp' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + INTEGER ( ipc_ ), VALUE :: numcol + INTEGER ( ipc_ ), VALUE :: numrow + INTEGER ( ipc_ ), VALUE :: numnz + INTEGER ( ipc_ ), VALUE :: aformat + INTEGER ( ipc_ ), VALUE :: sense + REAL ( rpc_ ), VALUE :: offset + REAL ( rpc_ ) :: colcost(*) + REAL ( rpc_ ) :: collower(*) + REAL ( rpc_ ) :: colupper(*) + REAL ( rpc_ ) :: rowlower(*) + REAL ( rpc_ ) :: rowupper(*) + INTEGER ( ipc_ ) :: astart(*) + INTEGER ( ipc_ ) :: aindex(*) + REAL ( rpc_ ) :: avalue(*) + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_passLp + + FUNCTION Highs_passHessian ( h, dim, numnz, qformat, qstart, & + qindex, qvalue) result ( s ) bind ( c, name='Highs_passHessian' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + INTEGER ( ipc_ ), VALUE :: dim + INTEGER ( ipc_ ), VALUE :: numnz + INTEGER ( ipc_ ), VALUE :: qformat + INTEGER ( ipc_ ) :: qstart(*) + INTEGER ( ipc_ ) :: qindex(*) + REAL ( rpc_ ) :: qvalue(*) + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_passHessian + + FUNCTION Highs_create () result ( h ) bind( c, name='Highs_create' ) + USE iso_c_binding + TYPE ( c_ptr ) :: h + END FUNCTION Highs_create + + SUBROUTINE Highs_destroy ( h ) bind( c, name='Highs_destroy' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + END SUBROUTINE Highs_destroy + + FUNCTION Highs_setBoolOptionValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_setBoolOptionValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + LOGICAL ( c_bool ), VALUE :: v + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_setBoolOptionValue + + FUNCTION Highs_setIntOptionValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_setIntOptionValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + INTEGER ( ipc_ ), VALUE :: v + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_setIntOptionValue + + FUNCTION Highs_setDoubleOptionValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_setDoubleOptionValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + REAL ( rpc_ ), VALUE :: v + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_setDoubleOptionValue + + FUNCTION Highs_setStringOptionValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_setStringOptionValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + CHARACTER ( c_char ) :: v(*) + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_setStringOptionValue + + FUNCTION Highs_setOptionValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_setOptionValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + CHARACTER ( c_char ) :: v(*) + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_setOptionValue + + FUNCTION Highs_getIntInfoValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_getIntInfoValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + INTEGER ( ipc_ ) :: v + INTEGER ( ipc_ ) :: s + v = 0_ipc_ + s = 0_ipc_ + END FUNCTION Highs_getIntInfoValue + + FUNCTION Highs_getDoubleInfoValue ( h, o, v ) & + result( s ) bind ( c, name='Highs_getDoubleInfoValue' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + CHARACTER ( c_char ) :: o(*) + REAL ( rpc_ ) :: v + INTEGER ( ipc_ ) :: s + v = 0.0_rpc_ + s = 0_ipc_ + END FUNCTION Highs_getDoubleInfoValue + + FUNCTION Highs_getSolution (h, cv, cd, rv, rd) & + result ( s ) bind ( c, name='Highs_getSolution' ) + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + REAL ( rpc_ ) :: cv(*) + REAL ( rpc_ ) :: cd(*) + REAL ( rpc_ ) :: rv(*) + REAL ( rpc_ ) :: rd(*) + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_getSolution + + FUNCTION Highs_getBasis (h, cbs, rbs) result( s ) & + bind (c, name='Highs_getBasis') + USE iso_c_binding + TYPE ( c_ptr ), VALUE :: h + INTEGER ( ipc_ ) :: cbs(*) + INTEGER ( ipc_ ) :: rbs(*) + INTEGER ( ipc_ ) :: s + s = 0_ipc_ + END FUNCTION Highs_getBasis + +END MODULE highs_fortran_api diff --git a/src/highs/highs_test.f90 b/src/highs/highs_test.f90 deleted file mode 100644 index 1b2bf82..0000000 --- a/src/highs/highs_test.f90 +++ /dev/null @@ -1,40 +0,0 @@ -! ( Last modified on 12 Mar 2021 at 15:50:00 ) - -! slimline CUTEst interface E04NQF -! Nick Gould, March 2021 - -!============================================================================= -! abreviated header from -! https://www.nag.com/numeric/fl/nagdoc_latest/html/e04/e04nqf.html -! 12 Mar 2021 -!============================================================================= - -SUBROUTINE E04NQF( start, qphx, m, n, ne, nname, lenc, ncolh, iobj, objadd, & - prob, acol, inda, loca, bl, bu, c, names, helast, hs, & - x, pi, rc, ns, ninf, sinf, obj, cw, lencw, iw, leniw, & - rw, lenrw, cuser, iuser, ruser, ifail ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: m, n, ne, nname, lenc, ncolh, iobj, inda( ne ), & - loca( n + 1 ), helast( n + m ), lencw, leniw, lenrw - INTEGER, INTENT( INOUT ) :: hs(n+m), ns, iw(leniw), iuser(*), ifail - INTEGER, INTENT( OUT ) :: ninf - REAL ( KIND = wp ), INTENT( IN ) :: objadd - REAL ( KIND = wp ), INTENT( INOUT ) :: acol( ne ), bl( n + m ), bu( n + m ), & - c(max(1,lenc)), x( n + m ), & - rw( lenrw ), ruser( * ) - REAL ( KIND = wp ), INTENT( OUT ) :: pi( m ), rc( n + m ), sinf, obj - CHARACTER (1), INTENT ( IN ) :: start - CHARACTER (8), INTENT ( IN ) :: prob, names( nname ) - CHARACTER (8), INTENT ( INOUT ) :: cw( lencw ), cuser( * ) - EXTERNAL :: qphx -END SUBROUTINE E04NQF - -SUBROUTINE qphx( ncolh, x, hx, nstate, cuser, iuser, ruser ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: ncolh, nstate - INTEGER, INTENT( INOUT ) :: iuser(*) - REAL ( KIND = wp ), INTENT( IN ) :: x(ncolh) - REAL ( KIND = wp ), INTENT( INOUT ) :: ruser( * ) - REAL ( KIND = wp ), INTENT( OUT ) :: hx(ncolh) - CHARACTER (8), INTENT( INOUT) :: cuser(*) -END SUBROUTINE qphx diff --git a/src/highs/makemaster b/src/highs/makemaster index 180df4a..33ce232 100644 --- a/src/highs/makemaster +++ b/src/highs/makemaster @@ -1,160 +1,60 @@ # Main body of the installation makefile for CUTEst HiGHS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 2021-07-15 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-29 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = HIGHS -package = highs - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -MODULESPLUS = $(MODULES) -I$(HIGHS_BUILD)/modules - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULESPLUS) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULESPLUS) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULESPLUS) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULESPLUS) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULESPLUS) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULESPLUS) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULESPLUS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +include $(CUTEST)/src/makedefs/defaults -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# package name -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -#$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs +PACKAGE = HIGHS +package = highs -all: $(package) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# basic packages +# include standard CUTEst makefile definitions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -#$(package)_single: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -#$(package)_double: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -$(package)_single: $(OBJ)/$(package)_main.o -$(package)_double: $(OBJ)/$(package)_main.o +include $(CUTEST)/src/makedefs/definitions -# run example tests +# include compilation and run instructions -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - echo "$(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +include $(CUTEST)/src/makedefs/instructions -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# select specific run test -# individual compilations +run_test: run_qp_test -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +# non-standard package compilation instructions -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 +$(OBJ)/$(package)_main.o: $(OBJ)/$(package)_test.o \ + ../$(package)/$(package)_main.F90 @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ + $(CP) ../$(package)/$(package)_main.F90 $(OBJ)/$(package)_main.F90 + cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(F90FLAGS) $(CPPFLAGS) \ + $(package)_main.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 $(OBJ)/*.mod + $(FORTRAN) -o $(package)_main.o $(F90FLAGSN) $(CPPFLAGS) \ + $(package)_main.F90 ) + $(RM) $(OBJ)/$(package)_main.F90 $(OBJ)/*.mod @printf '[ OK ]\n' -$(OBJ)/$(package)_dummy.o: ../$(package)/$(package)_dummy.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_dummy" - $(SED) -f $(SEDS) ../$(package)/$(package)_dummy.f90 > \ - $(OBJ)/$(package)_dummy.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_dummy.o $(FFLAGS) \ - $(package)_dummy.f90 \ +$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" + $(CP) ../$(package)/$(package)_test.F90 $(OBJ)/$(package)_test.F90 + cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(F90FLAGS) $(CPPFLAGS) \ + $(package)_test.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_dummy.o $(FFLAGS77N) \ - $(package)_dummy.f90 ) - $(RM) $(OBJ)/$(package)_dummy.f90 $(OBJ)/$(package)_dummy.o + $(FORTRAN) -o $(package)_test.o $(F90FLAGSN) $(CPPFLAGS) \ + $(package)_test.F90 ) + $(RM) $(OBJ)/$(package)_test.F90 $(RMOBFILE) $(package)_main.o @printf '[ OK ]\n' -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' - diff --git a/src/hrb/hrb_main.f90 b/src/hrb/hrb_main.F90 similarity index 89% rename from src/hrb/hrb_main.f90 rename to src/hrb/hrb_main.F90 index c431a01..355e913 100644 --- a/src/hrb/hrb_main.f90 +++ b/src/hrb/hrb_main.F90 @@ -1,7 +1,14 @@ -! ( Last modified on 7 Jan 2013 at 10:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-23 AT 09:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM HRB_main + USE CUTEST_KINDS_precision + + IMPLICIT NONE + ! ---------------------------------------------------------------- ! Write out SIF data in Harwell-Boeing or Rutherford-Boeing Format @@ -11,18 +18,17 @@ PROGRAM HRB_main ! ---------------------------------------------------------------- - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - ! scalar arguments - INTEGER :: n, m, matmax, i, j, k, ntotal, status - INTEGER :: na, ne, nh, nj, nv, plast, nrow, ncol, nnz, colmax - INTEGER, PARAMETER :: in = 5, out = 6, input = 55 - INTEGER, PARAMETER :: output = 56, outrhs = 57 - INTEGER, PARAMETER :: io_buffer = 11 - REAL ( KIND = wp ) :: f - REAL ( KIND = wp ), PARAMETER :: one = 1.0D+0, zero = 0.0D+0 - REAL ( KIND = wp ), PARAMETER :: biginf = 1.0D+19, penalty = 1.0D-1 + INTEGER ( KIND = ip_ ) :: n, m, matmax, i, j, k, ntotal, plast, status + INTEGER ( KIND = ip_ ) :: na, ne, nh, nj, nv, nrow, ncol, nnz, colmax + INTEGER ( KIND = ip_ ), PARAMETER :: in = 5, out = 6, input = 55 + INTEGER ( KIND = ip_ ), PARAMETER :: output = 56, outrhs = 57 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ), PARAMETER :: one = 1.0_rp_, zero = 0.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: biginf = 10.0_rp_ ** 19 + REAL ( KIND = rp_ ), PARAMETER :: penalty = 0.1_rp_ LOGICAL :: hb, rb CHARACTER ( LEN = 1 ) :: matype, maform, hrb CHARACTER ( LEN = 10 ) :: pname @@ -32,10 +38,10 @@ PROGRAM HRB_main CHARACTER ( LEN = 70 ) :: line2, line3 CHARACTER ( LEN = 72 ) :: line4 CHARACTER ( LEN = 42 ) :: line5 - INTEGER, ALLOCATABLE, DIMENSION( : ) :: ROW, COL, IP, IW - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, VAL - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: B, C, Y, CL, CU - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: SLACK + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: ROW, COL, IP, IW + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, VAL + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: B, C, Y, CL, CU + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: SLACK CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAMES CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: GNAMES LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR @@ -47,7 +53,7 @@ PROGRAM HRB_main ! compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 ! allocate space @@ -62,15 +68,15 @@ PROGRAM HRB_main ! Set up the data structures necessary to hold the group partially ! separable function - CALL CUTEST_csetup( status, input, out, io_buffer, N, M, X, BL, BU, Y, & - CL, CU, EQUATN, LINEAR, 0, 0, 0 ) + CALL CUTEST_csetup_r( status, input, out, io_buffer, N, M, X, BL, BU, Y, & + CL, CU, EQUATN, LINEAR, 0, 0, 0 ) IF ( status /= 0 ) GO TO 910 ! compute the numbers of nonzeros in the problem Jacobian and Hessian - CALL CUTEST_cdimsj( status, nj ) + CALL CUTEST_cdimsj_r( status, nj ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_cdimsh( status, nh ) + CALL CUTEST_cdimsh_r( status, nh ) IF ( status /= 0 ) GO TO 910 ! allocate more space @@ -130,7 +136,7 @@ PROGRAM HRB_main ! Determine the names of the problem, variables and constraints - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) IF ( status /= 0 ) GO TO 910 DO plast = 8, 1, - 1 IF ( pname( plast : plast ) /= ' ' ) EXIT @@ -190,7 +196,7 @@ PROGRAM HRB_main ! Evaluate the constant terms of the objective and constraint functions - CALL CUTEST_cfn( status, n, m, X, f, B ) + CALL CUTEST_cfn_r( status, n, m, X, f, B ) IF ( status /= 0 ) GO TO 910 B( 1 : m ) = - B( 1 : m ) @@ -201,7 +207,8 @@ PROGRAM HRB_main ! Evaluate the linear terms of the objective and constraint functions ! in a sparse format - CALL CUTEST_csgr( status, n, m, X, Y, .FALSE., nj, matmax, VAL, COL, ROW ) + CALL CUTEST_csgr_r( status, n, m, X, Y, .FALSE., nj, matmax, & + VAL, COL, ROW ) IF ( status /= 0 ) GO TO 910 SLACK( 1 : m ) = ONE @@ -273,8 +280,8 @@ PROGRAM HRB_main ! Evaluate the Hessian of the Lagrangian function at the initial point - CALL CUTEST_csh( status, n, m, X, Y, nh, matmax - na, & - VAL( na + 1 ), ROW( na + 1 ), COL( na + 1 ) ) + CALL CUTEST_csh_r( status, n, m, X, Y, nh, matmax - na, & + VAL( na + 1 ), ROW( na + 1 ), COL( na + 1 ) ) IF ( status /= 0 ) GO TO 910 ! Remove zero entries @@ -337,8 +344,8 @@ PROGRAM HRB_main ! Evaluate the Hessian of the Lagrangian function at the initial point - CALL CUTEST_ceh( status, n, m, X, Y, ne, colmax, IP, COL, & - matmax, ROW, matmax, VAL, .TRUE. ) + CALL CUTEST_ceh_r( status, n, m, X, Y, ne, colmax, IP, COL, & + matmax, ROW, matmax, VAL, .TRUE. ) IF ( status /= 0 ) GO TO 910 ! Include terms representing penalties @@ -409,21 +416,23 @@ PROGRAM HRB_main IF ( maform == 'A' ) CALL REORDER( ncol, nnz, ROW, COL, VAL, IP, IW ) - IF ( matype == 'J' ) THEN - write(74,"( ' J' )" ) - DO j = 1, ncol - DO k = IP( j ), IP( j + 1 ) - 1 - write(74,"( 2I8, ES12.4 )" ) row( k ), j, val( k ) - END DO - END DO - ELSE IF ( matype == 'T' ) THEN - write(75,"( ' JT' )" ) - DO j = 1, ncol - DO k = IP( j ), IP( j + 1 ) - 1 - write(75,"( 2I8, ES12.4 )" ) j, row( k ), val( k ) - END DO - END DO - END IF + IF ( .FALSE. ) THEN + IF ( matype == 'J' ) THEN + write(74,"( ' J' )" ) + DO j = 1, ncol + DO k = IP( j ), IP( j + 1 ) - 1 + write(74,"( 2I8, ES12.4 )" ) row( k ), j, val( k ) + END DO + END DO + ELSE IF ( matype == 'T' ) THEN + write(75,"( ' JT' )" ) + DO j = 1, ncol + DO k = IP( j ), IP( j + 1 ) - 1 + write(75,"( 2I8, ES12.4 )" ) j, row( k ), val( k ) + END DO + END DO + END IF + END IF ! Harwell-Boeing format @@ -629,7 +638,7 @@ PROGRAM HRB_main CLOSE( OUTPUT ) IF ( rb ) CLOSE( OUTRHS ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -661,9 +670,10 @@ PROGRAM HRB_main CONTAINS SUBROUTINE REORDER( nc, nnz, IRN, JCN, A, IP, IW ) - INTEGER :: nc, nnz - INTEGER :: IRN( nnz ), JCN( nnz ), IW( nc + 1 ), IP( nc + 1 ) - REAL ( KIND = wp ) :: A( nnz ) + INTEGER ( KIND = ip_ ) :: nc, nnz + INTEGER ( KIND = ip_ ) :: IRN( nnz ), JCN( nnz ) + INTEGER ( KIND = ip_ ) :: IW( nc + 1 ), IP( nc + 1 ) + REAL ( KIND = rp_ ) :: A( nnz ) ! Sort a sparse matrix from arbitrary order to column order @@ -671,7 +681,7 @@ SUBROUTINE REORDER( nc, nnz, IRN, JCN, A, IP, IW ) ! 7th November, 1990 INTEGER :: i, j, k, l, ic, ncp1, itemp, jtemp, locat - REAL ( KIND = wp ) :: anext , atemp + REAL ( KIND = rp_ ) :: anext , atemp ! Initialize the workspace as zero @@ -762,15 +772,15 @@ SUBROUTINE REORDER( nc, nnz, IRN, JCN, A, IP, IW ) END SUBROUTINE REORDER SUBROUTINE SORT_ascending( n, lind, IND, VAL ) - INTEGER :: n, lind - INTEGER :: IND( lind ) - REAL ( KIND = wp ) :: VAL( lind ) + INTEGER ( KIND = ip_ ) :: n, lind + INTEGER ( KIND = ip_ ) :: IND( lind ) + REAL ( KIND = rp_ ) :: VAL( lind ) ! Sort n numbers into ascending order. Yes, we should use ! quicksort but ...well, we are hoping that n won't be too big INTEGER :: i, j, curmin, indmin - REAL ( KIND = wp ) :: valmin + REAL ( KIND = rp_ ) :: valmin ! Find the I-th smallest value diff --git a/src/hrb/makemaster b/src/hrb/makemaster index a6822f6..408a17f 100644 --- a/src/hrb/makemaster +++ b/src/hrb/makemaster @@ -1,86 +1,37 @@ # Main body of the installation makefile for CUTEst HRB interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 7 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-20 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = HRB -package = hrb - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o +PACKAGE = HRB +package = hrb -SUCC = precision version) compiled successfully +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# main compilations and runs +# include standard CUTEst makefile definitions -#all: hrb -all: $(package) +include $(CUTEST)/src/makedefs/definitions -# basic packages +# include compilation and run instructions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +include $(CUTEST)/src/makedefs/instructions -# run example tests +# run example test run_test: tools test_cutest_constrained $(package) - echo " Test of unconstrained $(package)" + echo " Test of constrained $(package)" cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d @@ -88,44 +39,7 @@ run_test: tools test_cutest_constrained $(package) >& ../$(package)/c_test.output cat ../$(package)/c_test.output cat ../$(package)/ALLINITC.aug - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/ipopt/ipopt_main.f b/src/ipopt/ipopt_main.F similarity index 85% rename from src/ipopt/ipopt_main.f rename to src/ipopt/ipopt_main.F index 74c28ee..c4acf30 100644 --- a/src/ipopt/ipopt_main.f +++ b/src/ipopt/ipopt_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 12 Mar 2014 at 07:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" C Copyright (C) 2002, 2004, 2005 Carnegie Mellon University, C Dominique Orban and others. @@ -13,32 +16,33 @@ PROGRAM IPOPT_main C Adapted for C++ version by Andreas Waechter, Oct 2004 C CUTEst evolution, Nick Gould, January 2013 + USE CUTEST_KINDS_precision IMPLICIT NONE - INTEGER, PARAMETER :: cnr_input = 60, inp_input = 70, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: n, m, nz, ierr, status - INTEGER :: idx_style, nele_jac, nele_hess - DOUBLE PRECISION :: f + INTEGER ( KIND = ip_ ), PARAMETER :: cnr_input = 60 + INTEGER ( KIND = ip_ ), PARAMETER :: inp_input = 70, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: n, m, nz, ierr, status + INTEGER ( KIND = ip_ ) :: idx_style, nele_jac, nele_hess + REAL ( KIND = rp_ ) :: f CHARACTER ( LEN = 10 ) :: pname - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IDAT - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: DAT - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: Z_l, Z_u, LAM - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: G, G_l, G_u + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IDAT + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: DAT + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Z_l, Z_u, LAM + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: G, G_l, G_u LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAMES CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: GNAMES - INTEGER :: IPSOLVE -CNOT64 INTEGER :: iproblem, IPCREATE -CIS64 INTEGER*8 :: iproblem, IPCREATE + INTEGER ( KIND = ip_ ) :: IPSOLVE + INTEGER ( KIND = ip_ ) :: iproblem, IPCREATE EXTERNAL :: EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS C The following arrays are work space for the evaluation subroutines - integer :: i + integer ( kind = ip_ ) :: i logical :: ex - double precision :: init_val + real ( kind = rp_ ) :: init_val C Open the problem data file. @@ -48,7 +52,7 @@ PROGRAM IPOPT_main C compute problem dimensions - CALL CUTEST_cdimen( status, cnr_input, n, m ) + CALL CUTEST_cdimen_r( status, cnr_input, n, m ) IF ( status /= 0 ) GO TO 910 C allocate space @@ -61,7 +65,7 @@ PROGRAM IPOPT_main C set up the data structures necessary to hold the problem functions - CALL CUTEST_csetup( status,cnr_input, out, io_buffer, + CALL CUTEST_csetup_r( status,cnr_input, out, io_buffer, 1 n, m, X, X_l, X_u, LAM, G_l, G_u, 2 equatn, linear, 0, 0, 0 ) CLOSE( cnr_input ) @@ -80,9 +84,9 @@ PROGRAM IPOPT_main C obtain the number of nonzeros in Jacobian and Hessian - CALL CUTEST_cdimsj( status, nele_jac ) + CALL CUTEST_cdimsj_r( status, nele_jac ) nele_jac = nele_jac - n - CALL CUTEST_cdimsh( status, nele_hess ) + CALL CUTEST_cdimsh_r( status, nele_hess ) C allocate furter space @@ -93,7 +97,7 @@ PROGRAM IPOPT_main C get problem name - CALL CUTEST_cnames( status, n, m, pname, VNAMES, GNAMES ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAMES, GNAMES ) C call IPOPT @@ -110,13 +114,13 @@ PROGRAM IPOPT_main C Display CUTEst statistics - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 WRITE( out, 2000 ) pname, n, m, CALLS( 1 ), CALLS( 2 ), * CALLS( 3 ), CALLS( 4 ), CALLS( 5 ), CALLS( 6 ), CALLS( 7 ), * ierr, f, CPU( 1 ), CPU( 2 ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -218,19 +222,20 @@ subroutine EV_F(N, X, NEW_X, F, IDAT, DAT, IERR) C C******************************************************************************* C + USE CUTEST_KINDS_precision IMPLICIT NONE C C------------------------------------------------------------------------------- C Parameter list C------------------------------------------------------------------------------- C - integer N - double precision X(N) - integer NEW_X - double precision F - double precision DAT(*) - integer IDAT(*) - integer IERR + integer ( kind = ip_ ) N + real ( kind = rp_ ) X(N) + integer ( kind = ip_ ) NEW_X + real ( kind = rp_ ) F + real ( kind = rp_ ) DAT(*) + integer ( kind = ip_ ) IDAT(*) + integer ( kind = ip_ ) IERR C C******************************************************************************* C @@ -242,7 +247,7 @@ subroutine EV_F(N, X, NEW_X, F, IDAT, DAT, IERR) C C Call COFG to obtain value of objective function C - call CUTEST_cofg( ierr, N, X, F, DAT, .false.) + call CUTEST_cofg_r( ierr, N, X, F, DAT, .false.) return end @@ -316,25 +321,26 @@ subroutine EV_GRAD_F(N, X, NEW_X, GRAD, IDAT, DAT, IERR) C C******************************************************************************* C + USE CUTEST_KINDS_precision IMPLICIT NONE C C------------------------------------------------------------------------------- C Parameter list C------------------------------------------------------------------------------- C - integer N - double precision X(N) - integer NEW_X - double precision GRAD(N) - double precision DAT(*) - integer IDAT(*) - integer IERR + integer ( kind = ip_ ) N + real ( kind = rp_ ) X(N) + integer ( kind = ip_ ) NEW_X + real ( kind = rp_ ) GRAD(N) + real ( kind = rp_ ) DAT(*) + integer ( kind = ip_ ) IDAT(*) + integer ( kind = ip_ ) IERR C C------------------------------------------------------------------------------- C Local varibales C------------------------------------------------------------------------------- C - double precision f + real ( kind = rp_ ) f C C******************************************************************************* C @@ -346,7 +352,7 @@ subroutine EV_GRAD_F(N, X, NEW_X, GRAD, IDAT, DAT, IERR) C C Call COFG to obtain gradient of objective function C - call CUTEST_cofg( ierr, N, X, f, GRAD, .true.) + call CUTEST_cofg_r( ierr, N, X, f, GRAD, .true.) return end @@ -422,20 +428,21 @@ subroutine EV_G(N, X, NEW_X, M, G, IDAT, DAT, IERR) C C******************************************************************************* C + USE CUTEST_KINDS_precision IMPLICIT NONE C C------------------------------------------------------------------------------- C Parameter list C------------------------------------------------------------------------------- C - integer N - double precision X(N) - integer NEW_X - integer M - double precision G(M) - double precision DAT(*) - integer IDAT(*) - integer IERR + integer ( kind = ip_ ) N + real ( kind = rp_ ) X(N) + integer ( kind = ip_ ) NEW_X + integer ( kind = ip_ ) M + real ( kind = rp_ ) G(M) + real ( kind = rp_ ) DAT(*) + integer ( kind = ip_ ) IDAT(*) + integer ( kind = ip_ ) IERR C C******************************************************************************* C @@ -447,7 +454,7 @@ subroutine EV_G(N, X, NEW_X, M, G, IDAT, DAT, IERR) C C Call CCFG to obtain constraint values, but without slacks C - call CUTEST_ccfg( ierr, N, M, X, G, .FALSE., 1, 1, DAT, .FALSE.) + call CUTEST_ccfg_r( ierr, N, M, X, G, .FALSE., 1, 1, DAT, .FALSE.) return end @@ -529,30 +536,31 @@ subroutine EV_JAC_G(TASK, N, X, NEW_X, M, NZ, ACON, AVAR, A, C C******************************************************************************* C + USE CUTEST_KINDS_precision IMPLICIT NONE C C------------------------------------------------------------------------------- C Parameter list C------------------------------------------------------------------------------- C - integer TASK - integer N - double precision X(N) - integer NEW_X - integer M - integer NZ - double precision A(NZ) - integer ACON(NZ) - integer AVAR(NZ) - double precision DAT(*) - integer IDAT(*) - integer IERR + integer ( kind = ip_ ) TASK + integer ( kind = ip_ ) N + real ( kind = rp_ ) X(N) + integer ( kind = ip_ ) NEW_X + integer ( kind = ip_ ) M + integer ( kind = ip_ ) NZ + real ( kind = rp_ ) A(NZ) + integer ( kind = ip_ ) ACON(NZ) + integer ( kind = ip_ ) AVAR(NZ) + real ( kind = rp_ ) DAT(*) + integer ( kind = ip_ ) IDAT(*) + integer ( kind = ip_ ) IERR C C------------------------------------------------------------------------------- C Local varibales C------------------------------------------------------------------------------- C - integer i, nele_jac + integer ( kind = ip_ ) i, nele_jac C C******************************************************************************* C @@ -566,15 +574,15 @@ subroutine EV_JAC_G(TASK, N, X, NEW_X, M, NZ, ACON, AVAR, A, C Get the nonzero structure C do i = 1, n - DAT(i) = 0.d0 + DAT(i) = 0.0_rp_ enddo - call CUTEST_ccfsg( ierr, n, m, DAT(1), DAT(N+1), nele_jac, + call CUTEST_ccfsg_r( ierr, n, m, DAT(1), DAT(N+1), nele_jac, 1 nz, DAT(2*n+1), AVAR, ACON, .TRUE.) else C C Get the values of nonzeros C - call CUTEST_ccfsg( ierr, N, M, X, DAT(1), nele_jac, + call CUTEST_ccfsg_r( ierr, N, M, X, DAT(1), nele_jac, 1 NZ, A, IDAT(1), IDAT(1+NZ), .TRUE.) endif @@ -662,33 +670,34 @@ subroutine EV_HESS(TASK, N, X, NEW_X, OBJFACT, M, LAM, NEW_LAM, C C******************************************************************************* C + USE CUTEST_KINDS_precision IMPLICIT NONE C C------------------------------------------------------------------------------- C Parameter list C------------------------------------------------------------------------------- C - integer TASK - integer N - double precision X(N) - integer NEW_X - double precision OBJFACT - integer M - double precision LAM(M) - integer NEW_LAM - integer NNZH - integer IRNH(NNZH) - integer ICNH(NNZH) - double precision HESS(NNZH) - double precision DAT(*) - integer IDAT(*) - integer IERR + integer ( kind = ip_ ) TASK + integer ( kind = ip_ ) N + real ( kind = rp_ ) X(N) + integer ( kind = ip_ ) NEW_X + real ( kind = rp_ ) OBJFACT + integer ( kind = ip_ ) M + real ( kind = rp_ ) LAM(M) + integer ( kind = ip_ ) NEW_LAM + integer ( kind = ip_ ) NNZH + integer ( kind = ip_ ) IRNH(NNZH) + integer ( kind = ip_ ) ICNH(NNZH) + real ( kind = rp_ ) HESS(NNZH) + real ( kind = rp_ ) DAT(*) + integer ( kind = ip_ ) IDAT(*) + integer ( kind = ip_ ) IERR C C------------------------------------------------------------------------------- C Local varibales C------------------------------------------------------------------------------- C - integer i, nnzh2 + integer ( kind = ip_ ) i, nnzh2 C C******************************************************************************* C @@ -702,27 +711,27 @@ subroutine EV_HESS(TASK, N, X, NEW_X, OBJFACT, M, LAM, NEW_LAM, C Get the nonzero structure C do i = 1, N - DAT(i) = 0.d0 + DAT(i) = 0.0_rp_ enddo - call CUTEST_csh( ierr, N, M, DAT(1), DAT(1), + call CUTEST_csh_r( ierr, N, M, DAT(1), DAT(1), 1 nnzh2, NNZH, DAT(N+1), IRNH, ICNH) else C C Call CSH to get the values C - if( OBJFACT.ne.0.d0 ) then + if( OBJFACT.ne.0.0_rp_ ) then - if( OBJFACT.ne.1.d0 ) then + if( OBJFACT.ne.1.0_rp_ ) then do i = 1, M DAT(i) = LAM(i)/OBJFACT enddo - call CUTEST_csh( ierr, N, M, X, DAT(1), + call CUTEST_csh_r( ierr, N, M, X, DAT(1), 1 nnzh2, NNZH, HESS, IDAT(1), IDAT(1+NNZH)) do i = 1, NNZH HESS(i) = HESS(i)*OBJFACT enddo else - call CUTEST_csh( ierr, N, M, X, LAM, nnzh2, NNZH, HESS, + call CUTEST_csh_r( ierr, N, M, X, LAM, nnzh2, NNZH, HESS, 1 IDAT(1), IDAT(1+NNZH)) endif @@ -730,12 +739,12 @@ subroutine EV_HESS(TASK, N, X, NEW_X, OBJFACT, M, LAM, NEW_LAM, C now we have to call CSH twice, since we can't otherwise get rid of C the objective function entries do i = 1, M - DAT(i) = 0.d0 + DAT(i) = 0.0_rp_ enddo -C call CUTEST_csh( ierr, N, M, X, DAT(1), nnzh2, +C call CUTEST_csh_r( ierr, N, M, X, DAT(1), nnzh2, C 1 NNZH, DAT(1+M), IDAT(1), IDAT(1+NNZH)) C IF ( ierr /= 0 ) RETURN - call CUTEST_cshc( ierr, N, M, X, LAM, nnzh2, NNZH, HESS, + call CUTEST_cshc_r( ierr, N, M, X, LAM, nnzh2, NNZH, HESS, 1 IDAT(1), IDAT(1+NNZH)) C do i = 1, NNZH C HESS(i) = HESS(i) - DAT(M+i) diff --git a/src/ipopt/ipopt_test.f b/src/ipopt/ipopt_test.F similarity index 59% rename from src/ipopt/ipopt_test.f rename to src/ipopt/ipopt_test.F index 616e5ba..12dc75a 100644 --- a/src/ipopt/ipopt_test.f +++ b/src/ipopt/ipopt_test.F @@ -1,17 +1,21 @@ -C ( Last modified on 15 Jan 2013 at 16:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" C Dummy IPOPT for testing ipopt_main interface to CUTEst + C Nick Gould, 15th January 2013 INTEGER FUNCTION IPSOLVE( iproblem, X, G, f, LAM, Z_L, Z_U, * IDAT, DAT ) - INTEGER :: iproblem - DOUBLE PRECISION :: f - INTEGER :: IDAT( * ) - DOUBLE PRECISION :: X( * ), G( * ), LAM( * ), Z_l( * ), Z_u( * ) - DOUBLE PRECISION :: DAT( * ) - - INTEGER :: n, m, nza, nzh, ierr + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: iproblem + REAL ( KIND = rp_ ) :: f + INTEGER ( KIND = ip_ ) :: IDAT( * ) + REAL ( KIND = rp_ ) :: X( * ), G( * ), LAM( * ) + REAL ( KIND = rp_ ) :: DAT( * ), Z_l( * ), Z_u( * ) + + INTEGER ( KIND = ip_ ) :: n, m, nza, nzh, ierr COMMON / cutest_ipdims / n, m, nza, nzh CALL EV_F( n, X, 0, f, IDAT, DAT, ierr ) @@ -21,9 +25,9 @@ INTEGER FUNCTION IPSOLVE( iproblem, X, G, f, LAM, Z_L, Z_U, 1 IDAT, DAT, ierr ) CALL EV_JAC_G( 1, n, X, 0, m, nza, IDAT(1), IDAT(nza+1), DAT, 1 IDAT, DAT, ierr ) - CALL EV_HESS( 0, N, X, 0, 1.0D+0, m, LAM, 0, + CALL EV_HESS( 0, N, X, 0, 1.0_rp_, m, LAM, 0, 1 nzh, IDAT(1), IDAT(nzh+1), DAT, IDAT, DAT, ierr) - CALL EV_HESS( 1, N, X, 0, 1.0D+0, m, LAM, 0, + CALL EV_HESS( 1, N, X, 0, 1.0_rp_, m, LAM, 0, 1 nzh, IDAT(1), IDAT(nzh+1), DAT, IDAT, DAT, ierr) IPSOLVE = 1 RETURN @@ -31,11 +35,12 @@ INTEGER FUNCTION IPSOLVE( iproblem, X, G, f, LAM, Z_L, Z_U, INTEGER FUNCTION IPCREATE( n, X_L, X_U, m, G_L, G_U, nza, * nzh, idx_style, EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS ) - INTEGER :: n, m, nza, nzh, idx_style - DOUBLE PRECISION :: X_l( n ), X_u( n ), G_l( m ), G_u( m ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, m, nza, nzh, idx_style + REAL ( KIND = rp_ ) :: X_l( n ), X_u( n ), G_l( m ), G_u( m ) EXTERNAL :: EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS - INTEGER :: sn, sm, snza, snzh + INTEGER ( KIND = ip_ ) :: sn, sm, snza, snzh COMMON / cutest_ipdims / sn, sm, snza, snzh sn = n sm = m @@ -47,6 +52,7 @@ INTEGER FUNCTION IPCREATE( n, X_L, X_U, m, G_L, G_U, nza, END SUBROUTINE IPFREE( iproblem ) - INTEGER :: iproblem + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: iproblem RETURN END diff --git a/src/ipopt/makemaster b/src/ipopt/makemaster index e1f789a..8dc67ed 100644 --- a/src/ipopt/makemaster +++ b/src/ipopt/makemaster @@ -1,143 +1,37 @@ # Main body of the installation makefile for CUTEst IPOPT interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 14 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = IPOPT -package = ipopt - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = IPOPT +package = ipopt -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main1.f - $(SED) "s/^C$(NOT64)/ /" $(OBJ)/$(package)_main1.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f $(OBJ)/$(package)_main1.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/knitro/knitro_main.c b/src/knitro/knitro_main.c index 9f03ecb..dd17a47 100644 --- a/src/knitro/knitro_main.c +++ b/src/knitro/knitro_main.c @@ -1,3 +1,4 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-04 AT 16:15 GMT */ /* ================================================ * CUTEst interface to KNITRO 7 @@ -33,6 +34,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #endif #include "cutest.h" +#include "cutest_routines.h" #include "knitro.h" logical somethingTrue = TRUE_; @@ -44,7 +46,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ integer CUTEst_nnzh; /* number of nonzeros in upper triangular part of the Hessian of the Lagrangian */ integer *jacIndexVars, *jacIndexCons, *hessIndexRows, *hessIndexCols; - doublereal *CUTEst_Jac, *CUTEst_Hess, *Hv, f; + rp_ *CUTEst_Jac, *CUTEst_Hess, *Hv, f; /* ======================================================================== */ /* Callback function to evaluate the objective function and constraints */ @@ -70,14 +72,14 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ double* c = evalResult->c; if (CUTEst_ncon > 0) { - CUTEST_cfn( &status, &CUTEst_nvar, &CUTEst_ncon, x, obj, c); + CUTEST_cfn_r( &status, &CUTEst_nvar, &CUTEst_ncon, x, obj, c); /*for (i = 0; i < CUTEst_nvar; i++) */ /* printf(" x = %5d %22.15e\n", i, x[i]); */ /*printf(" f = %22.15e\n", obj[0]); */ /*for (i = 0; i < CUTEst_ncon; i++) */ /* printf(" c = %5d %22.15e\n", i, c[i]); */ } else { - CUTEST_ufn( &status, &CUTEst_nvar, x, obj); + CUTEST_ufn_r( &status, &CUTEst_nvar, x, obj); } if( status ) { @@ -114,9 +116,9 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ if (CUTEst_ncon > 0) { - CUTEST_csgr( &status,&CUTEst_nvar, &CUTEst_ncon, x, lambda, - &somethingFalse, &CUTEst_nnzj, &CUTEst_lcjac, - CUTEst_Jac, jacIndexVars, jacIndexCons); + CUTEST_csgr_r( &status,&CUTEst_nvar, &CUTEst_ncon, x, lambda, + &somethingFalse, &CUTEst_nnzj, &CUTEst_lcjac, + CUTEst_Jac, jacIndexVars, jacIndexCons); for (i = 0; i < CUTEst_nvar; i++) { objGrad[i] = 0.0; @@ -138,7 +140,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ /*COFG(&CUTEst_nvar, x, &f, objGrad, &somethingTrue); */ } else { - CUTEST_ugr( &status, &CUTEst_nvar, x, objGrad); + CUTEST_ugr_r( &status, &CUTEst_nvar, x, objGrad); } if( status ) { @@ -172,11 +174,12 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ double* hessian = evalResult->hess; if (CUTEst_ncon > 0) { - CUTEST_csh( &status,&CUTEst_nvar, &CUTEst_ncon, x, lambda, &CUTEst_nnzh, - &CUTEst_nnzh, hessian, hessIndexRows, hessIndexCols); + CUTEST_csh_r( &status,&CUTEst_nvar, &CUTEst_ncon, x, lambda, + &CUTEst_nnzh, &CUTEst_nnzh, hessian, hessIndexRows, + hessIndexCols); } else { - CUTEST_ush( &status,&CUTEst_nvar, x, &CUTEst_nnzh, - &CUTEst_nnzh, hessian, hessIndexRows, hessIndexCols); + CUTEST_ush_r( &status,&CUTEst_nvar, x, &CUTEst_nnzh, + &CUTEst_nnzh, hessian, hessIndexRows, hessIndexCols); } if( status ) { @@ -197,13 +200,14 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ double* hessVector = evalResult->hessVec; - if (! Hv) MALLOC(Hv, CUTEst_nvar, doublereal); + if (! Hv) MALLOC(Hv, CUTEst_nvar, rp_); if (CUTEst_ncon > 0) - CUTEST_chprod( &status,&CUTEst_nvar, &CUTEst_ncon, &somethingTrue, x, - lambda, hessVector, Hv); + CUTEST_chprod_r( &status,&CUTEst_nvar, &CUTEst_ncon, &somethingTrue, + x, lambda, hessVector, Hv); else - CUTEST_uhprod( &status,&CUTEst_nvar, &somethingTrue, x, hessVector, Hv); + CUTEST_uhprod_r( &status,&CUTEst_nvar, &somethingTrue, x, + hessVector, Hv); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -244,8 +248,8 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ VarTypes vtypes; integer ncon_dummy; - doublereal *x, *bl, *bu, *dummy1, *dummy2; - doublereal *v = NULL, *cl = NULL, *cu = NULL; + rp_ *x, *bl, *bu, *dummy1, *dummy2; + rp_ *v = NULL, *cl = NULL, *cu = NULL; logical *equatn = NULL, *linear = NULL; char *pname, *vnames, *cnames; char** all_vnames, **all_cnames; @@ -253,11 +257,11 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ logical grad; logical constrained = FALSE_; - doublereal *c, f; + rp_ *c, f; - doublereal calls[7], cpu[4]; + rp_ calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; - doublereal dummy; + rp_ dummy; integer ExitCode; int nHessOpt, i; @@ -270,7 +274,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon); + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon); /* printf (" ** the problem has %i constraints\n", &CUTEst_ncon ) ; @@ -288,30 +292,30 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ /* Reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC(x, CUTEst_nvar, doublereal); - MALLOC(bl, CUTEst_nvar, doublereal); - MALLOC(bu, CUTEst_nvar, doublereal); + MALLOC(x, CUTEst_nvar, rp_); + MALLOC(bl, CUTEst_nvar, rp_); + MALLOC(bu, CUTEst_nvar, rp_); MALLOC(consIndex, CUTEst_ncon, KNINT); if (constrained) { MALLOC(equatn, CUTEst_ncon+1, logical ); MALLOC(linear, CUTEst_ncon+1, logical ); - MALLOC(v, CUTEst_ncon+CUTEst_nvar+1, doublereal); - MALLOC(cl, CUTEst_ncon+1, doublereal); - MALLOC(cu, CUTEst_ncon+1, doublereal); - CUTEST_csetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, - v, cl, cu, equatn, linear, - &e_order, &l_order, &v_order); + MALLOC(v, CUTEst_ncon+CUTEst_nvar+1, rp_); + MALLOC(cl, CUTEst_ncon+1, rp_); + MALLOC(cu, CUTEst_ncon+1, rp_); + CUTEST_csetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, + v, cl, cu, equatn, linear, + &e_order, &l_order, &v_order); } else { MALLOC(equatn, 1, logical ); MALLOC(linear, 1, logical ); - MALLOC(cl, 1, doublereal); - MALLOC(cu, 1, doublereal); - MALLOC(v, CUTEst_nvar+1, doublereal); - CUTEST_usetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, x, bl, bu); + MALLOC(cl, 1, rp_); + MALLOC(cu, 1, rp_); + MALLOC(v, CUTEst_nvar+1, rp_); + CUTEST_usetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, x, bl, bu); } if( status ) { @@ -328,8 +332,8 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ MALLOC(cnames, CUTEst_ncon*FSTRING_LEN, char); MALLOC(all_cnames, CUTEst_ncon*FSTRING_LEN, char*); - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, - pname, vnames, cnames); + CUTEST_cnames_r( &status, &CUTEst_nvar, &CUTEst_ncon, + pname, vnames, cnames); for(i = 0; i < CUTEst_ncon;++i) { @@ -337,7 +341,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } } else - CUTEST_unames( &status, &CUTEst_nvar, pname, vnames); + CUTEST_unames_r( &status, &CUTEst_nvar, pname, vnames); for(i = 0; i < CUTEst_nvar;++i) { @@ -397,7 +401,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ /* Constrained problem. */ - CUTEST_cdimsj( &status, &CUTEst_lcjac); + CUTEST_cdimsj_r( &status, &CUTEst_lcjac); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -405,19 +409,19 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } MALLOC(jacIndexVars, CUTEst_lcjac + 1, integer ); MALLOC(jacIndexCons, CUTEst_lcjac + 1, integer ); - MALLOC(CUTEst_Jac, CUTEst_lcjac + 1, doublereal); + MALLOC(CUTEst_Jac, CUTEst_lcjac + 1, rp_); - MALLOC(c, CUTEst_ncon, doublereal); + MALLOC(c, CUTEst_ncon, rp_); - CUTEST_ccfsg( &status,&CUTEst_nvar, &CUTEst_ncon, x, c, &CUTEst_nnzj, - &CUTEst_lcjac, CUTEst_Jac, jacIndexVars, - jacIndexCons, &somethingTrue); + CUTEST_ccfsg_r( &status,&CUTEst_nvar, &CUTEst_ncon, x, c, &CUTEst_nnzj, + &CUTEst_lcjac, CUTEst_Jac, jacIndexVars, + jacIndexCons, &somethingTrue); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); exit(status); } - CUTEST_cfn( &status,&CUTEst_nvar, &CUTEst_ncon, x, &f, c); + CUTEST_cfn_r( &status,&CUTEst_nvar, &CUTEst_ncon, x, &f, c); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -436,14 +440,14 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ jacIndexVars = NULL; jacIndexCons = NULL; CUTEst_Jac = NULL; - CUTEST_ufn( &status,&CUTEst_nvar, x, &f); + CUTEST_ufn_r( &status,&CUTEst_nvar, x, &f); } /* Obtain Hessian sparsity pattern */ #ifdef KNIT_DEBUG fprintf(stderr, "Obtaining Hessian sparsity pattern...\n"); #endif - CUTEST_cdimsh( &status, &CUTEst_nnzh); + CUTEST_cdimsh_r( &status, &CUTEst_nnzh); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -452,10 +456,10 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ MALLOC(hessIndexRows, CUTEst_nnzh, integer ); MALLOC(hessIndexCols, CUTEst_nnzh, integer ); - MALLOC(CUTEst_Hess, CUTEst_nnzh, doublereal); + MALLOC(CUTEst_Hess, CUTEst_nnzh, rp_); - CUTEST_csh( &status, &CUTEst_nvar, &CUTEst_ncon, x, v, &CUTEst_nnzh, - &CUTEst_nnzh, CUTEst_Hess, hessIndexRows, hessIndexCols); + CUTEST_csh_r( &status, &CUTEst_nvar, &CUTEst_ncon, x, v, &CUTEst_nnzh, + &CUTEst_nnzh, CUTEst_Hess, hessIndexRows, hessIndexCols); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -584,7 +588,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu); + CUTEST_creport_r( &status, calls, cpu); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -643,7 +647,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ FREE(consIndex); - CUTEST_cterminate( &status ); + CUTEST_cterminate_r( &status ); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); diff --git a/src/knitro/makemaster b/src/knitro/makemaster index 0da1d39..9b39cbc 100644 --- a/src/knitro/makemaster +++ b/src/knitro/makemaster @@ -1,142 +1,38 @@ # Main body of the installation makefile for CUTEst KNITRO interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 9 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = KNITRO -package = knitro - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o +PACKAGE = KNITRO +package = knitro -SUCC = precision version) compiled successfully +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# main compilations and runs +# include standard CUTEst makefile definitions -all: $(package) +include $(CUTEST)/src/makedefs/definitions -# basic packages +# include compilation and run instructions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +include $(CUTEST)/src/makedefs/instructions -# run example tests +# select specific run test run_test: echo " No $(PACKAGE) test program at the moment" -run_test_todo: tools test_cutest $(OBJ)/$(package)_main.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(U_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - echo " Test of constrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.c > \ - $(OBJ)/$(package)_main.c - cd $(OBJ); $(CC) -o $(package)_main.o $(CFLAGS) $(package)_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_main.o $(CFLAGSN) $(package)_main.c ) - $(RM) $(OBJ)/$(package)_main.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/la04/la04_main.f b/src/la04/la04_main.F similarity index 87% rename from src/la04/la04_main.f rename to src/la04/la04_main.F index 1c1982b..cf76b60 100644 --- a/src/la04/la04_main.f +++ b/src/la04/la04_main.F @@ -1,7 +1,12 @@ -C ( Last modified on 6 Jan 2013 at 13:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM LA04_main + USE CUTEST_KINDS_precision + C -------------------------------------------------------------------- C C Solve the linear program @@ -20,28 +25,30 @@ PROGRAM LA04_main C C -------------------------------------------------------------------- - INTEGER :: npm, nplus, n, m - INTEGER :: i, itern, ntotal, na, ns, nnzj, ind, job, maxit, ib - INTEGER :: lip, la, nt1, lws, liws, ii, nfree, iores - INTEGER :: nboth, nnoneg, nlower, l, ir, ic, j, iounit, status - INTEGER, PARAMETER :: out = 6, input = 55 - INTEGER, PARAMETER :: inspec = 56, outsol = 57 - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION, PARAMETER :: one = 1.0D+0, zero = 0.0D+0 - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19 - DOUBLE PRECISION :: vl, vu, vx, vm, objf - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) - DOUBLE PRECISION :: CNTL( 15 ), RINFO( 40 ) + INTEGER ( KIND = ip_ ) :: npm, nplus, n, m, maxit, ib, iounit + INTEGER ( KIND = ip_ ) :: status, iores + INTEGER ( KIND = ip_ ) :: i, itern, ntotal, na, ns, nnzj, ind, job + INTEGER ( KIND = ip_ ) :: lip, la, nt1, lws, liws, ii, nfree + INTEGER ( KIND = ip_ ) :: nboth, nnoneg, nlower, l, ir, ic, j + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6, input = 55 + INTEGER ( KIND = ip_ ), PARAMETER :: inspec = 56, outsol = 57 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ + REAL ( KIND = rp_ ) :: vl, vu, vx, vm, objf + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ) :: CNTL( 15 ), RINFO( 40 ) LOGICAL :: writes, pnamee CHARACTER ( LEN = 5 ) :: state CHARACTER ( LEN = 10 ) :: pname CHARACTER ( LEN = 14 ) :: pnames - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IPERM, INVPRM, IX, JX - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IRNA, IP, IWS - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: A, X, Z - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: C, B, G, WS - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: BLOWER, BUPPER - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : , : ) :: BND + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IPERM, IX + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: JX, INVPRM + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IRNA, IP + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IWS + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: A, X, Z + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: C, B, G, WS + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: BLOWER, BUPPER + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , : ) :: BND LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAME CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: CNAME @@ -71,7 +78,7 @@ PROGRAM LA04_main C compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C allocate space @@ -84,7 +91,7 @@ PROGRAM LA04_main C set up the data structures necessary to hold the group partially C separable function - CALL CUTEST_csetup( status, input, out, io_buffer, n, m, + CALL CUTEST_csetup_r( status, input, out, io_buffer, n, m, * WS( 1 ), BLOWER( 1 ), BUPPER( 1 ), * WS( n + 1 ), BLOWER( n + 1 ), * BUPPER( n + 1 ), EQUATN, LINEAR, 0, 0, 0 ) @@ -92,7 +99,7 @@ PROGRAM LA04_main C determine the names of the problem, variables and constraints - CALL CUTEST_cnames( status, n, m, pname, VNAME, CNAME ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAME, CNAME ) IF ( status /= 0 ) GO TO 910 C compute the total number of variables @@ -129,7 +136,7 @@ PROGRAM LA04_main C compute the number of nonzeros in the constraint Jacobian - CALL CUTEST_cdimsj( status, la ) + CALL CUTEST_cdimsj_r( status, la ) IF ( status /= 0 ) GO TO 910 C allocate more space @@ -159,20 +166,20 @@ PROGRAM LA04_main C the problem functions. DO 30 i = 1, N - X( i ) = zero - C( i ) = zero + X( i ) = 0.0_rp_ + C( i ) = 0.0_rp_ 30 CONTINUE C Evaluate the constant terms of the objective and constraint functions. - CALL CUTEST_cfn( status, n, m, X, objf, B ) + CALL CUTEST_cfn_r( status, n, m, X, objf, B ) IF ( status /= 0 ) GO TO 910 C ns = na DO 40 i = 1, m BLOWER( n + i ) = BLOWER( n + i ) - B( i ) BUPPER( n + i ) = BUPPER( n + i ) - B( i ) - B( i ) = zero + B( i ) = 0.0_rp_ 40 CONTINUE C The variables will be permuted, before being passed to @@ -195,7 +202,7 @@ PROGRAM LA04_main IF ( BLOWER( i ) .LT. - biginf ) THEN nfree = nfree + 1 IWS( i ) = 0 - ELSE IF ( BLOWER( i ) .EQ. zero ) THEN + ELSE IF ( BLOWER( i ) .EQ. 0.0_rp_ ) THEN IWS( i ) = 1 ELSE nboth = nboth + 1 @@ -212,9 +219,9 @@ PROGRAM LA04_main DO 12 i = 1, m IF ( .NOT. EQUATN( i ) ) THEN ntotal = ntotal + 1 - IF ( ( BLOWER( n + i ) .EQ. zero .AND. + IF ( ( BLOWER( n + i ) .EQ. 0.0_rp_ .AND. * BUPPER( n + i ) .GT. biginf ) .OR. - * ( BUPPER( n + i ) .EQ. zero .AND. + * ( BUPPER( n + i ) .EQ. 0.0_rp_ .AND. * BLOWER( n + i ) .LT. - biginf ) ) THEN IWS( ntotal ) = 1 ELSE @@ -258,17 +265,17 @@ PROGRAM LA04_main IF ( IWS( ns ) .EQ. 1 ) THEN nnoneg = nnoneg + 1 IPERM( ns ) = nnoneg - IF ( BLOWER( n + i ) .EQ. zero ) THEN - A( na ) = - one + IF ( BLOWER( n + i ) .EQ. 0.0_rp_ ) THEN + A( na ) = - 1.0_rp_ ELSE - A( na ) = one + A( na ) = 1.0_rp_ END IF ELSE IF ( IWS( ns ) .EQ. 2 ) THEN nboth = nboth + 1 IPERM( ns ) = nboth BND( 1, nboth ) = BLOWER( n + i ) BND( 2, nboth ) = BUPPER( n + i ) - A( na ) = - one + A( na ) = - 1.0_rp_ END IF IRNA( na ) = i IWS( na ) = IPERM( ns ) @@ -284,13 +291,13 @@ PROGRAM LA04_main C Evaluate the linear terms of the objective and constraint functions C in a sparse format. - CALL CUTEST_csgr( status, n, m, X, WS, .FALSE., nnzj, la - na, + CALL CUTEST_csgr_r( status, n, m, X, WS, .FALSE., nnzj, la - na, * A( na + 1 ), IWS( na + 1 ), IRNA( na + 1 ) ) IF ( status /= 0 ) GO TO 910 ns = na DO 50 i = 1, nnzj - IF ( A( ns + i ) .NE. zero ) THEN + IF ( A( ns + i ) .NE. 0.0_rp_ ) THEN IF ( IRNA( ns + i ) .GT. 0 ) THEN na = na + 1 A( na ) = A( ns + i ) @@ -344,7 +351,7 @@ PROGRAM LA04_main C End of main iteration loop. 400 CONTINUE - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 C Print details of the solution obtained. @@ -388,7 +395,7 @@ PROGRAM LA04_main ELSE vu = biginf IF ( i .GE. nlower ) THEN - vl = zero + vl = 0.0_rp_ ELSE vl = - biginf END IF @@ -423,7 +430,7 @@ PROGRAM LA04_main ELSE vu = biginf IF ( i .GE. nlower ) THEN - vl = zero + vl = 0.0_rp_ ELSE vl = - biginf END IF @@ -456,7 +463,7 @@ PROGRAM LA04_main C Now compute the constrainmt residuals DO 610 i = 1, M - WS( i ) = zero + WS( i ) = 0.0_rp_ 610 CONTINUE DO 640 j = 1, NTOTAL IF ( INVPRM( j ) .LE. n ) THEN @@ -526,7 +533,7 @@ PROGRAM LA04_main * ( CALLS( i ), i = 5, 7 ), * JOB, RINFO( 1 ) + objf, CPU( 1 ), CPU( 2 ) CLOSE( input ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 890 CONTINUE diff --git a/src/la04/la04_test.F b/src/la04/la04_test.F new file mode 100644 index 0000000..22a8b71 --- /dev/null +++ b/src/la04/la04_test.F @@ -0,0 +1,56 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy LA04AD for testing la04_main interface to CUTEst + +C Nick Gould, 6th January 2013 + + SUBROUTINE LA04AD(A,LA,IRN,IP,M,N,B,C,BND,KB,LB,JOB,CNTL,IX,JX,X, + + Z,G,RINFO,WS,LWS,IWS,LIWS) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) LA,KB,LB,M,N,LWS,LIWS + REAL ( KIND = rp_ ) A(LA),B(M),BND(2,KB),C(N),CNTL(15),G(N) + REAL ( KIND = rp_ ) RINFO(40),WS(LWS),X(N+M),Z(N) + INTEGER ( KIND = ip_ ) IP(N+1),IRN(LA),IWS(LIWS),IX(M),JOB,JX(KB) + INTEGER ( KIND = ip_ ) :: i + IF ( job .EQ. 7 ) THEN + DO 10 i = 1, m + WS( i ) = 1.0_rp_ + 10 CONTINUE + ELSE + DO 20 i = 1, n + Z( i ) = 2.0_rp_ + 20 CONTINUE + DO 30 i = 1, kb + JX( i ) = 0 + 30 CONTINUE + DO 40 i = 1, m + WS( i ) = 1.0_rp_ + IX( i ) = i + 40 CONTINUE + job = 0 + END IF + RINFO( 1 ) = 0.0_rp_ + RETURN + END + + SUBROUTINE LA04ID(CNTL) + USE CUTEST_KINDS_precision + REAL ( KIND = rp_ ) CNTL(15) + RETURN + END + + SUBROUTINE MC49AD(IND,NC,NR,NNZ,IRN,JCN,YESA,LA,A,LIP,IP,LIW,IW, + + IFLAG) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) IFLAG,IND,LA,LIP,LIW,NC,NNZ,NR + LOGICAL YESA + REAL ( KIND = rp_ ) A(LA) + INTEGER ( KIND = ip_ ) IP(LIP),IRN(NNZ),IW(LIW),JCN(NNZ) + INTEGER ( KIND = ip_ ) :: i + DO 10 i = 1, lip + IP( i ) = 1 + 10 CONTINUE + RETURN + END diff --git a/src/la04/la04_test.f b/src/la04/la04_test.f deleted file mode 100644 index 8ffec9f..0000000 --- a/src/la04/la04_test.f +++ /dev/null @@ -1,50 +0,0 @@ -C ( Last modified on 6 Jan 2013 at 16:00:00 ) - -C Dummy LA04AD for testing la04_main interface to CUTEst -C Nick Gould, 6th January 2013 - - SUBROUTINE LA04AD(A,LA,IRN,IP,M,N,B,C,BND,KB,LB,JOB,CNTL,IX,JX,X, - + Z,G,RINFO,WS,LWS,IWS,LIWS) - INTEGER LA,KB,LB,M,N,LWS,LIWS - DOUBLE PRECISION A(LA),B(M),BND(2,KB),C(N),CNTL(15),G(N), - + RINFO(40),WS(LWS),X(N+M),Z(N) - INTEGER IP(N+1),IRN(LA),IWS(LIWS),IX(M),JOB,JX(KB) - INTEGER :: i - IF ( job .EQ. 7 ) THEN - DO 10 i = 1, m - WS( i ) = 1.0D0 - 10 CONTINUE - ELSE - DO 20 i = 1, n - Z( i ) = 2.0D0 - 20 CONTINUE - DO 30 i = 1, kb - JX( i ) = 0 - 30 CONTINUE - DO 40 i = 1, m - WS( i ) = 1.0D0 - IX( i ) = i - 40 CONTINUE - job = 0 - END IF - RINFO( 1 ) = 0.0D0 - RETURN - END - - SUBROUTINE LA04ID(CNTL) - DOUBLE PRECISION CNTL(15) - RETURN - END - - SUBROUTINE MC49AD(IND,NC,NR,NNZ,IRN,JCN,YESA,LA,A,LIP,IP,LIW,IW, - + IFLAG) - INTEGER IFLAG,IND,LA,LIP,LIW,NC,NNZ,NR - LOGICAL YESA - DOUBLE PRECISION A(LA) - INTEGER IP(LIP),IRN(NNZ),IW(LIW),JCN(NNZ) - INTEGER :: i - DO 10 i = 1, lip - IP( i ) = 1 - 10 CONTINUE - RETURN - END diff --git a/src/la04/makemaster b/src/la04/makemaster index 509a5ff..28bd789 100644 --- a/src/la04/makemaster +++ b/src/la04/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst LA04 interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = LA04 -package = la04 - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = LA04 +package = la04 -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/lbfgs/lbfgs_main.f b/src/lbfgs/lbfgs_main.F similarity index 78% rename from src/lbfgs/lbfgs_main.f rename to src/lbfgs/lbfgs_main.F index ce43547..b4013ef 100644 --- a/src/lbfgs/lbfgs_main.f +++ b/src/lbfgs/lbfgs_main.F @@ -1,25 +1,33 @@ -C ( Last modified on 2 Jan 2013 at 13:40:00 ) - PROGRAM LBFGS_main +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 15:00 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM LBFGS_main + + USE CUTEST_KINDS_precision + IMPLICIT NONE + C C LBFGS test driver for problems derived from SIF files. C C Nick Gould and Ph. Toint, for CGT Productions. C Revised for CUTEst, January 2013 C - INTEGER :: N, M, status, LP, MP, LW, I, MAXIT, iflag - INTEGER :: icall, IPRINT( 2 ) - INTEGER, PARAMETER :: input = 55, out = 6 , inspec = 46 - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION F, EPS, XTOL, GTOL, GNORM, BIGINF - DOUBLE PRECISION one, ZERO, STPMIN, STPMAX + INTEGER ( KIND = ip_ ) :: N, M, status, LP, MP, LW, I, MAXIT + INTEGER ( KIND = ip_ ) :: icall, iflag, IPRINT( 2 ) + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 , inspec = 46 + REAL ( KIND = rp_ ) F, EPS, XTOL, GTOL, GNORM, BIGINF + REAL ( KIND = rp_ ) STPMIN, STPMAX LOGICAL DIAGCO, BOUNDS - PARAMETER ( BIGINF = 9.0D+19, ZERO = 0.0D0, one = 1.0D0 ) + PARAMETER ( BIGINF = 9.0E+19_rp_ ) CHARACTER ( LEN = 10 ) :: PNAME, SPCDAT - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, G, DIAG, W + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, G, DIAG, W CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES EXTERNAL LB2 COMMON / LB3 / MP, LP, GTOL, STPMIN, STPMAX - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) C C Open the Spec file for the method. C @@ -36,8 +44,7 @@ PROGRAM LBFGS_main C MAXIT : the maximum number of iterations, C EPS : the required norm of the gradient C - READ ( INSPEC, 1000 ) M, IPRINT( 1 ), IPRINT( 2 ), MAXIT, - * EPS + READ ( INSPEC, 1000 ) M, IPRINT( 1 ), IPRINT( 2 ), MAXIT, EPS C C Close input file. C @@ -50,7 +57,7 @@ PROGRAM LBFGS_main C C Find the problem dimension C - CALL CUTEST_udimen( status, INPUT, n ) + CALL CUTEST_udimen_r( status, INPUT, n ) IF ( status /= 0 ) GO TO 910 C Allocate workspace @@ -62,13 +69,13 @@ PROGRAM LBFGS_main C C Set up SIF data. C - CALL CUTEST_usetup( status, INPUT, out, io_buffer, N, X, W, + CALL CUTEST_usetup_r( status, INPUT, out, io_buffer, N, X, W, * W( n + 1 ) ) IF ( status /= 0 ) GO TO 910 C C Obtain variable names. C - CALL CUTEST_unames( status, N, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, N, PNAME, XNAMES ) C C Set up algorithmic input data. C @@ -83,12 +90,12 @@ PROGRAM LBFGS_main ICALL = 0 IFLAG = 0 DIAGCO = .FALSE. - XTOL = EPSILON( one ) + XTOL = EPSILON( 1.0_rp_ ) 20 CONTINUE C C Evaluate the function and gradient. C - CALL CUTEST_uofg( status, N, X, F, G, .TRUE. ) + CALL CUTEST_uofg_r( status, N, X, F, G, .TRUE. ) IF ( status /= 0 ) GO TO 910 C C Call the optimizer. @@ -105,9 +112,9 @@ PROGRAM LBFGS_main C C Terminal exit. C - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - GNORM = ZERO + GNORM = 0.0_rp_ DO 30 I = 1, N GNORM = MAX( GNORM, ABS( G( I ) ) ) 30 CONTINUE @@ -118,7 +125,7 @@ PROGRAM LBFGS_main WRITE ( out, 2000 ) PNAME, N, INT( CALLS(1) ), INT( CALLS(2) ), * IFLAG, F, CPU(1), CPU(2) CLOSE( INPUT ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE diff --git a/src/lbfgs/lbfgs_test.f b/src/lbfgs/lbfgs_test.F similarity index 50% rename from src/lbfgs/lbfgs_test.f rename to src/lbfgs/lbfgs_test.F index a6e4074..3b1a632 100644 --- a/src/lbfgs/lbfgs_test.f +++ b/src/lbfgs/lbfgs_test.F @@ -1,15 +1,18 @@ -C ( Last modified on 4 Jan 2013 at 13:40:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 15:00 GMT. + +#include "cutest_modules.h" C Dummy LBFGS for testing lbfgs_main interface to CUTEst C Nick Gould, 4th January 2013 SUBROUTINE LBFGS( n, m, X, f, G, DIAGCO, DIAG, IPRINT, eps, xtol, * W, iflag ) - INTEGER n, m, iflag, iprint( 2 ) - DOUBLE PRECISION f, eps, xtol + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n, m, iflag, iprint( 2 ) + REAL ( KIND = rp_ ) f, eps, xtol LOGICAL diagco - DOUBLE PRECISION X( n ), G( n ), DIAG( n ), - * W( n * ( 2 * m + 1 ) + 2 * m ) + REAL ( KIND = rp_ ) X( n ), G( n ), DIAG( n ), + * W( n * ( 2 * m + 1 ) + 2 * m ) IF ( iflag == 0 ) THEN iflag = 1 ELSE diff --git a/src/lbfgs/makemaster b/src/lbfgs/makemaster index 6d69dcd..a5856a2 100644 --- a/src/lbfgs/makemaster +++ b/src/lbfgs/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst LBFGS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 4 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-29 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = LBFGS -package = lbfgs - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = LBFGS +package = lbfgs -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/lbfgsb/lbfgsb_main.f b/src/lbfgsb/lbfgsb_main.F similarity index 80% rename from src/lbfgsb/lbfgsb_main.f rename to src/lbfgsb/lbfgsb_main.F index 6708be1..ff186bd 100644 --- a/src/lbfgsb/lbfgsb_main.f +++ b/src/lbfgsb/lbfgsb_main.F @@ -1,5 +1,13 @@ -C ( Last modified on 4 Sep 2017 at 08:20:00 ) - PROGRAM LBFGSB_main +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 15:00 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM LBFGSB_main + + USE CUTEST_KINDS_precision + IMPLICIT NONE + C C LBFGSB test driver for problems derived from SIF files. C @@ -7,22 +15,24 @@ PROGRAM LBFGSB_main C September 2004 C Revised for CUTEst, January 2013 C - INTEGER I, out, N, M, INPUT, MAXIT, status - INTEGER IFLAG , INSPEC, IPRINT, lwa, liwa, ISAVE( 44 ) - INTEGER :: io_buffer = 11 - DOUBLE PRECISION F, GNORM, ZERO, ONE - DOUBLE PRECISION PGTOL, FACTR, INFTY, DSAVE( 29 ) + INTEGER ( KIND = ip_ ) I, out, N, M, INPUT, MAXIT, status + INTEGER ( KIND = ip_ ) IFLAG , INSPEC, IPRINT, lwa, liwa + INTEGER ( KIND = ip_ ) ISAVE( 44 ) + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + REAL ( KIND = rp_ ) F, GNORM + REAL ( KIND = rp_ ) PGTOL, FACTR, INFTY, DSAVE( 29 ) CHARACTER ( LEN = 60 ) :: TASK, CSAVE - LOGICAL LSAVE( 4 ) - PARAMETER ( out = 6 ) - INTEGER, ALLOCATABLE, DIMENSION( : ) :: NBD, IWA - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, XL, XU, G, WA - PARAMETER ( INPUT = 55, INSPEC = 56 ) - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, INFTY = 1.0D+19 ) + LOGICAL LSAVE( 4 ) + PARAMETER ( out = 6 ) + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: NBD, IWA + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, XL, XU + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: G, WA + PARAMETER ( INPUT = 55, INSPEC = 56 ) + PARAMETER ( INFTY = 1.0E+19_rp_ ) CHARACTER ( LEN = 10 ) :: PNAME, SPCDAT CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - EXTERNAL SETULB + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + EXTERNAL SETULB C C Open the Spec file for the method. C @@ -61,7 +71,7 @@ PROGRAM LBFGSB_main C C Check to see if there is sufficient room C - CALL CUTEST_udimen( status, INPUT, N ) + CALL CUTEST_udimen_r( status, INPUT, N ) IF ( status /= 0 ) GO TO 910 liwa = 3 * n @@ -73,7 +83,8 @@ PROGRAM LBFGSB_main C C Set up SIF data. C - CALL CUTEST_usetup( status, INPUT, out, io_buffer, N, X, XL, XU ) + CALL CUTEST_usetup_r( status, INPUT, out, io_buffer, + * N, X, XL, XU ) IF ( status /= 0 ) GO TO 910 C C Set bound constraint status @@ -96,7 +107,7 @@ PROGRAM LBFGSB_main C C Obtain variable names. C - CALL CUTEST_unames( status, N, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, N, PNAME, XNAMES ) IF ( status /= 0 ) GO TO 910 C C Set up algorithmic input data. @@ -116,7 +127,7 @@ PROGRAM LBFGSB_main C Evaluate the function, f, and gradient, G C IF (TASK( 1: 2 ) .EQ. 'FG' ) THEN - CALL CUTEST_uofg( status, N, X, F, G, .TRUE. ) + CALL CUTEST_uofg_r( status, N, X, F, G, .TRUE. ) IF ( status /= 0 ) GO TO 910 GO TO 30 C @@ -142,7 +153,7 @@ PROGRAM LBFGSB_main C C Terminal exit. C - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 GNORM = DSAVE( 13 ) WRITE ( out, 2010 ) F, GNORM @@ -153,7 +164,7 @@ PROGRAM LBFGSB_main WRITE ( out, 2000 ) PNAME, N, INT( CALLS(1) ), INT( CALLS(2) ), * IFLAG, F, CPU(1), CPU(2) CLOSE( INPUT ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -187,18 +198,19 @@ PROGRAM LBFGSB_main END SUBROUTINE REORDA( NC, NNZ, IRN, JCN, A, IP, IW ) - INTEGER NC, NNZ - INTEGER IRN( NNZ ), JCN( NNZ ) - INTEGER IW( NC + 1 ), IP( NC + 1 ) - DOUBLE PRECISION A( NNZ ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) NC, NNZ + INTEGER ( KIND = ip_ ) IRN( NNZ ), JCN( NNZ ) + INTEGER ( KIND = ip_ ) IW( NC + 1 ), IP( NC + 1 ) + REAL ( KIND = rp_ ) A( NNZ ) C Sort a sparse matrix from arbitrary order to column order C Nick Gould C 7th November, 1990 - INTEGER I, J, K, L, IC, NCP1, ITEMP, JTEMP, LOCAT - DOUBLE PRECISION ANEXT , ATEMP + INTEGER ( KIND = ip_ ) I, J, K, L, IC, NCP1, ITEMP, JTEMP, LOCAT + REAL ( KIND = rp_ ) ANEXT , ATEMP C Initialize the workspace as zero @@ -284,10 +296,11 @@ SUBROUTINE REORDA( NC, NNZ, IRN, JCN, A, IP, IW ) END SUBROUTINE TIMER( TTIME ) + USE CUTEST_KINDS_precision C CPU timer - DOUBLE PRECISION TTIME + REAL ( KIND = rp_ ) TTIME CALL CPU_TIME( TTIME ) RETURN diff --git a/src/lbfgsb/lbfgsb_test.f b/src/lbfgsb/lbfgsb_test.F similarity index 58% rename from src/lbfgsb/lbfgsb_test.f rename to src/lbfgsb/lbfgsb_test.F index 8392d7b..13cb63d 100644 --- a/src/lbfgsb/lbfgsb_test.f +++ b/src/lbfgsb/lbfgsb_test.F @@ -1,23 +1,26 @@ -C ( Last modified on 4 Sep 2017 at 08:20:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 15:00 GMT. + +#include "cutest_modules.h" C Dummy SETULB for testing lbfgsb_main interface to CUTEst C Nick Gould, 4th January 2013 SUBROUTINE SETULB( n, m, X, XL, XU, NBD, f, G, factr, pgtol, WA, * IWA, task, iprint, csave, LSAVE, ISAVE, DSAVE ) - INTEGER n, m, iprint, ISAVE( 44 ) - DOUBLE PRECISION f, factr, pgtol, DSAVE( 29 ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n, m, iprint, ISAVE( 44 ) + REAL ( KIND = rp_ ) f, factr, pgtol, DSAVE( 29 ) CHARACTER ( LEN = 60 ) :: TASK, CSAVE LOGICAL LSAVE( 4 ) - INTEGER :: NBD( n ), IWA( 3 * n ) - DOUBLE PRECISION X( n ), XL( n ), XU( n ), G( n ), + INTEGER ( KIND = ip_ ) :: NBD( n ), IWA( 3 * n ) + REAL ( KIND = rp_ ) X( n ), XL( n ), XU( n ), G( n ), * WA( 2 * m * n + 5 * n + 11 * m * m + 8 * m ) -C * WA( 2 * m * n + 4 * n + 12 * m * m + 12 * m ) IF ( TASK( 1: 5 ) .EQ. 'START' ) THEN TASK( 1: 5 ) = 'FG ' ELSE TASK( 1: 5 ) = 'CONV ' END IF + DSAVE( 13 ) = 0.0_rp_ RETURN END diff --git a/src/lbfgsb/makemaster b/src/lbfgsb/makemaster index 91e45e9..194925e 100644 --- a/src/lbfgsb/makemaster +++ b/src/lbfgsb/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst LBFGS-B interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 4 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-29 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = LBFGSB -package = lbfgsb - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = LBFGSB +package = lbfgsb -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/lincoa/lincoa_main.f90 b/src/lincoa/lincoa_main.F90 similarity index 77% rename from src/lincoa/lincoa_main.f90 rename to src/lincoa/lincoa_main.F90 index 32c5b9b..fc7224d 100644 --- a/src/lincoa/lincoa_main.f90 +++ b/src/lincoa/lincoa_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 16 Dec 2013 at 09:40:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 13:00 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM LINCOA_main @@ -6,21 +9,23 @@ PROGRAM LINCOA_main ! Nick Gould, December 2013 + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision + IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: maxfun, lw, status, iprint, i, npt, m, n, mc - REAL( KIND = wp ) :: rhobeg, rhoend, f - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+19 - REAL( KIND = wp ), DIMENSION( : ), ALLOCATABLE :: X, X_l, X_u, B, G, W - REAL( KIND = wp ), DIMENSION( : ), ALLOCATABLE :: Y, C_l, C_u - REAL( KIND = wp ), DIMENSION( : , : ), ALLOCATABLE :: A, J + INTEGER ( KIND = ip_ ) :: maxfun, lw, status, iprint, i, npt, m, n, mc + REAL( KIND = rp_ ) :: rhobeg, rhoend, f + REAL( KIND = rp_ ), PARAMETER :: infty = 1.0E+19_rp_ + REAL( KIND = rp_ ), DIMENSION( : ), ALLOCATABLE :: X, X_l, X_u, B, G, W + REAL( KIND = rp_ ), DIMENSION( : ), ALLOCATABLE :: Y, C_l, C_u + REAL( KIND = rp_ ), DIMENSION( : , : ), ALLOCATABLE :: A, J LOGICAL, DIMENSION( : ), ALLOCATABLE :: EQUATN, LINEAR CHARACTER ( LEN = 10 ) :: pname CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAMES, CNAMES - REAL( KIND = wp ), DIMENSION( 4 ) :: CPU - REAL( KIND = wp ), DIMENSION( 4 ) :: CALLS - INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CPU + REAL( KIND = rp_ ), DIMENSION( 4 ) :: CALLS + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46, out = 6 ! open the relevant file @@ -29,7 +34,7 @@ PROGRAM LINCOA_main ! compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 ! allocate space @@ -42,14 +47,14 @@ PROGRAM LINCOA_main ! set up the data structures necessary to hold the problem functions. - CALL CUTEST_csetup( status, input, out, io_buffer, n, m, & - X, X_l, X_u, Y, C_l, C_u, EQUATN, LINEAR, 0, 0, 0 ) + CALL CUTEST_csetup_r( status, input, out, io_buffer, n, m, & + X, X_l, X_u, Y, C_l, C_u, EQUATN, LINEAR, 0, 0, 0 ) IF ( status /= 0 ) GO TO 910 CLOSE( input ) ! compute the constraint Jacobian - CALL CUTEST_cgr( status, n, m, X, Y, .FALSE., G, .FALSE., m, n, J ) + CALL CUTEST_cgr_r( status, n, m, X, Y, .FALSE., G, .FALSE., m, n, J ) IF ( status /= 0 ) GO TO 910 ! compute the number of constraints (include simple bounds, constraints @@ -77,14 +82,14 @@ PROGRAM LINCOA_main DO i = 1, n IF ( X_l( i ) > - infty ) THEN mc = mc + 1 - A( 1 : n, mc ) = 0.0_wp - A( i, mc ) = - 1.0_wp + A( 1 : n, mc ) = 0.0_rp_ + A( i, mc ) = - 1.0_rp_ B( mc ) = - X_l( i ) END IF IF ( X_u( i ) < infty ) THEN mc = mc + 1 - A( 1 : n, mc ) = 0.0_wp - A( i, mc ) = 1.0_wp + A( 1 : n, mc ) = 0.0_rp_ + A( i, mc ) = 1.0_rp_ B( mc ) = X_u( i ) END IF END DO @@ -144,11 +149,11 @@ PROGRAM LINCOA_main ! output report - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 ALLOCATE( VNAMES( n ), CNAMES( m ), STAT = status ) - CALL CUTEST_cnames( status, n, m, pname, VNAMES, CNAMES ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAMES, CNAMES ) CALL CALFUN( n, X, f ) WRITE( out, 2110 ) ( i, VNAMES( i ), X( i ), X_l( i ), X_u( i ), & @@ -162,7 +167,7 @@ PROGRAM LINCOA_main DEALLOCATE( G, J, X, X_l, X_u, Y, C_l, C_u, VNAMES, CNAMES, W, & STAT = status ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP ! error returns @@ -203,19 +208,19 @@ SUBROUTINE CALFUN( n, X, f ) ! evaluates the objective function value in a format compatible with LINCOA, ! but using the CUTEst tools. - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: n - REAL( KIND = wp ), INTENT( OUT ) :: f - REAL( KIND = wp ), INTENT( IN ) :: X( n ) + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n + REAL( KIND = rp_ ), INTENT( OUT ) :: f + REAL( KIND = rp_ ), INTENT( IN ) :: X( n ) - INTEGER :: status - REAL( KIND = wp ) :: G( n ) + INTEGER ( KIND = ip_ ) :: status + REAL( KIND = rp_ ) :: G( n ) ! Evaluate the objective function and constraints. - CALL CUTEST_uofg( status, n, X, f, G, .FALSE. ) + CALL CUTEST_uofg_r( status, n, X, f, G, .FALSE. ) IF ( status /= 0 ) GO TO 910 ! f = CUTEST_problem_global%f RETURN diff --git a/src/lincoa/lincoa_test.F90 b/src/lincoa/lincoa_test.F90 new file mode 100644 index 0000000..1e16dc0 --- /dev/null +++ b/src/lincoa/lincoa_test.F90 @@ -0,0 +1,22 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 13:15 GMT. + +#include "cutest_modules.h" + +! Dummy LINCOA for testing lincoa_main interface to CUTEst +! Nick Gould, 29th January 2013 + + SUBROUTINE LINCOA( n, npt, m, A, ia, B, X, rhobeg, rhoend, iprint, & + maxfun, W ) + USE CUTEST_KINDS_precision + +! dummy arguments + + INTEGER ( KIND = ip_ ) :: n, npt, m, ia, iprint, maxfun + REAL( KIND = rp_ ) :: rhobeg, rhoend + REAL( KIND = rp_ ) :: A( ia, * ), B( * ), X( * ), W( * ) + + REAL( KIND = rp_ ) :: f + CALL CALFUN( n, X, f ) + + RETURN + END diff --git a/src/lincoa/lincoa_test.f90 b/src/lincoa/lincoa_test.f90 deleted file mode 100644 index b043160..0000000 --- a/src/lincoa/lincoa_test.f90 +++ /dev/null @@ -1,20 +0,0 @@ -! ( Last modified on 29 Jan 2013 at 14:15:00 ) - -! Dummy LINCOA for testing lincoa_main interface to CUTEst -! Nick Gould, 29th January 2013 - - SUBROUTINE LINCOA( n, npt, m, A, ia, B, X, rhobeg, rhoend, iprint, & - maxfun, W ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - -! dummy arguments - - INTEGER :: n, npt, m, ia, iprint, maxfun - REAL( KIND = wp ) :: rhobeg, rhoend - REAL( KIND = wp ) :: A( ia, * ), B( * ), X( * ), W( * ) - - REAL( KIND = wp ) :: f - CALL CALFUN( n, X, f ) - - RETURN - END diff --git a/src/lincoa/makemaster b/src/lincoa/makemaster index b9da83e..c223012 100644 --- a/src/lincoa/makemaster +++ b/src/lincoa/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst LINCOA interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 16 XII 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = LINCOA -package = lincoa - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = LINCOA +package = lincoa -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/loqo/loqo_main.c b/src/loqo/loqo_main.c index 15921c6..2d8e048 100644 --- a/src/loqo/loqo_main.c +++ b/src/loqo/loqo_main.c @@ -1,3 +1,4 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-05 AT 08:15 GMT */ /* ==================================================== * CUTEst interface for LOQO October 22nd, 2003 @@ -23,39 +24,40 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #include "loqo_alloc.h" #include "loqo.h" #include "cutest.h" +#include "cutest_routines.h" #define max(a,b) ((a)>(b)?(a):(b)) typedef struct keyword keyword; struct keyword { - char *name; - int type; - int ivalue; - double dvalue; + char *name; + int type; + int ivalue; + rp_ dvalue; }; #define KW(a,b,c,d) {a,b,c,d} static keyword keywds[] = { - KW("bndpush", 2, 0, -1.0), - KW("convex", 0, 0, 0.0), - KW("dense", 1, -1, 0.0), - KW("dual", 0, 0, 0.0), - KW("epsdiag", 2, 0, 1.0e-10), - KW("epsnum", 2, 0, 0.0), - KW("epssol", 2, 0, 1.0e-6), - KW("honor_bnds", 0, 0, 0.0), - KW("honor_bnds_init", 0, 0, 0.0), - KW("inftol", 2, 0, 1e-6), - KW("inftol2", 2, 0, 1e+5), - KW("iterlim", 1, 500, 0.0), - KW("lincons", 1, 0, 0.0), - KW("max", 0, 0, 0.0), - KW("maximize", 0, 0, 0.0), - KW("maxit", 1, 200, 0.0), - KW("min", 0, 0, 0.0), - KW("mindeg", 0, 0, 0.0), - KW("minimize", 0, 0, 0.0), + KW("bndpush", 2, 0, -1.0), + KW("convex", 0, 0, 0.0), + KW("dense", 1, -1, 0.0), + KW("dual", 0, 0, 0.0), + KW("epsdiag", 2, 0, 1.0e-10), + KW("epsnum", 2, 0, 0.0), + KW("epssol", 2, 0, 1.0e-6), + KW("honor_bnds", 0, 0, 0.0), + KW("honor_bnds_init", 0, 0, 0.0), + KW("inftol", 2, 0, 1e-6), + KW("inftol2", 2, 0, 1e+5), + KW("iterlim", 1, 500, 0.0), + KW("lincons", 1, 0, 0.0), + KW("max", 0, 0, 0.0), + KW("maximize", 0, 0, 0.0), + KW("maxit", 1, 200, 0.0), + KW("min", 0, 0, 0.0), + KW("mindeg", 0, 0, 0.0), + KW("minimize", 0, 0, 0.0), KW("minlocfil", 0, 0, 0.0), KW("mufactor", 2, 0, -1.0), KW("noreord", 0, 0, 0.0), @@ -76,34 +78,34 @@ static int spec = 0; /* Prototypes */ - double objval( double *x ); - void objgrad( double *c, double *x ); - void hessian( double *Q, double *x, double *y ); - void conval( double *h, double *x ); - void congrad( double *A, double *At, double *x ); + rp_ objval( rp_ *x ); + void objgrad( rp_ *c, rp_ *x ); + void hessian( rp_ *Q, rp_ *x, rp_ *y ); + void conval( rp_ *h, rp_ *x ); + void congrad( rp_ *A, rp_ *At, rp_ *x ); int compare( const void *A, const void *B ); void convert_sparse_format( int ishess, int n, int m, int nnz_in, - integer *irow_in, integer *jcol_in, - int *nnz_out, int **row_out, - int **col_out, int **cute2loqo ); - int rd_opns(char *s); - int rd_specs(char *Spec_name); - void *binsearch(char **sp); - void set_opns(LOQO *lp); + integer *irow_in, integer *jcol_in, + int *nnz_out, int **row_out, + int **col_out, int **cute2loqo ); + int rd_opns(char *s); + int rd_specs(char *Spec_name); + void *binsearch(char **sp); + void set_opns(LOQO *lp); /* * Global variables used by auxilliary library functions in ccutest.c */ typedef struct { - int i, j, pos; + int i, j, pos; } CUTEstentry; integer CUTEst_nvar; /* number of variables */ integer CUTEst_ncon; /* number of constraints */ integer CUTEst_nnzj; /* number of nonzeros in Jacobian */ integer CUTEst_nnzh; /* number of nonzeros in upper triangular part of Hessian - of Lagrangian */ + of Lagrangian */ /* Counters for number of function and derivative evaluations */ int count_f = 0; /* objective function */ @@ -115,7 +117,7 @@ static int spec = 0; /* Variables used in LOQO main driver */ int *Acutest2loqo, *Atcutest2loqo, qnz, *Qcutest2loqo; - double *cscale; /* some of the constraints must be scaled by minus one, */ + rp_ *cscale; /* some of the constraints must be scaled by minus one, */ /* if they are inequalities with infinite lower bound. */ /* ============ */ @@ -123,386 +125,387 @@ static int spec = 0; /* ============ */ int main( void ) { - LOQO *lp; /* LOQO data structure */ - char *fname = "OUTSDIF.d"; /* CUTEst data file */ - integer funit = 42; /* FORTRAN unit number for OUTSDIF.d */ - integer iout = 6; /* FORTRAN unit number for error output */ - integer io_buffer = 11; /* FORTRAN unit internal input/output */ - integer ierr; /* Exit flag from OPEN and CLOSE */ - integer status; /* Exit flag from CUTEst tools */ - - integer nconp1; - - integer idummy, *indvar, *indfun, *irnh, *icnh; - doublereal *x, *bl, *bu, *c, *J, *H; - doublereal *v = NULL, *cl = NULL, *cu = NULL; - logical *equatn = NULL, *linear = NULL; - integer e_order = 0, l_order = 0, v_order = 0; + LOQO *lp; /* LOQO data structure */ + char *fname = "OUTSDIF.d"; /* CUTEst data file */ + integer funit = 42; /* FORTRAN unit number for OUTSDIF.d */ + integer iout = 6; /* FORTRAN unit number for error output */ + integer io_buffer = 11; /* FORTRAN unit internal input/output */ + integer ierr; /* Exit flag from OPEN and CLOSE */ + integer status; /* Exit flag from CUTEst tools */ + + integer nconp1; + + integer idummy, *indvar, *indfun, *irnh, *icnh; + rp_ *x, *bl, *bu, *c, *J, *H; + rp_ *v = NULL, *cl = NULL, *cu = NULL; + logical *equatn = NULL, *linear = NULL; + integer e_order = 0, l_order = 0, v_order = 0; logical grad; - char *pname, *vnames, *gnames; - doublereal f, cmax; - doublereal calls[7], cpu[4]; + char *pname, *vnames, *gnames; + rp_ f, cmax; + rp_ calls[7], cpu[4]; - int *iA=NULL, *kA=NULL, *iQ=NULL, *kQ=NULL, *iAt=NULL, *kAt=NULL; + int *iA=NULL, *kA=NULL, *iQ=NULL, *kQ=NULL, *iAt=NULL, *kAt=NULL; - /* int i, status; */ - int i; + /* int i, status; */ + int i; - /* Open problem description file OUTSDIF.d */ - FORTRAN_open( &funit, fname, &ierr ); - if( ierr ) { - printf("Error opening file OUTSDIF.d.\nAborting.\n"); - exit(1); - } + /* Open problem description file OUTSDIF.d */ + FORTRAN_open( &funit, fname, &ierr ); + if( ierr ) { + printf("Error opening file OUTSDIF.d.\nAborting.\n"); + exit(1); + } - /* Determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); + /* Determine problem size */ + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } + exit(status); + } + + /* Reserve memory for variables, bounds, and multipliers */ + MALLOC( x, CUTEst_nvar, rp_ ); + MALLOC( bl, CUTEst_nvar, rp_ ); + MALLOC( bu, CUTEst_nvar, rp_ ); + MALLOC( equatn, CUTEst_ncon+1, logical ); + MALLOC( linear, CUTEst_ncon+1, logical ); + MALLOC( v, CUTEst_ncon+1, rp_ ); + MALLOC( cl, CUTEst_ncon+1, rp_ ); + MALLOC( cu, CUTEst_ncon+1, rp_ ); + + /* Seems to be needed for some Solaris C compilers */ + nconp1 = CUTEst_ncon + 1; + + /* Call initialization routine for CUTEst */ + CUTEST_csetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, + v, cl, cu, equatn, linear, + &e_order, &l_order, &v_order ); - /* Reserve memory for variables, bounds, and multipliers */ - MALLOC( x, CUTEst_nvar, doublereal ); - MALLOC( bl, CUTEst_nvar, doublereal ); - MALLOC( bu, CUTEst_nvar, doublereal ); - MALLOC( equatn, CUTEst_ncon+1, logical ); - MALLOC( linear, CUTEst_ncon+1, logical ); - MALLOC( v, CUTEst_ncon+1, doublereal ); - MALLOC( cl, CUTEst_ncon+1, doublereal ); - MALLOC( cu, CUTEst_ncon+1, doublereal ); - - /* Seems to be needed for some Solaris C compilers */ - nconp1 = CUTEst_ncon + 1; - - /* Call initialization routine for CUTEst */ - CUTEST_csetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, &CUTEst_ncon, x, bl, bu, - v, cl, cu, equatn, linear, &e_order, &l_order, &v_order ); - - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } + exit(status); + } - /* Free unneeded arrays */ - FREE( equatn ); - FREE( linear ); + /* Free unneeded arrays */ + FREE( equatn ); + FREE( linear ); - if( CUTEst_ncon > 0 ) - { - /* Determine number of nonzeros in Jacobian */ - CUTEST_cdimsj( &status, &CUTEst_nnzj ); + if( CUTEst_ncon > 0 ) + { + /* Determine number of nonzeros in Jacobian */ + CUTEST_cdimsj_r( &status, &CUTEst_nnzj ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - /* CUTEst_nnzj -= CUTEst_nvar; */ /* substract dense gradient of objective function */ - - /* Get Jacobian at starting point */ - MALLOC( c, CUTEst_ncon, doublereal ); - MALLOC( J, CUTEst_nnzj, doublereal ); - MALLOC( indvar, CUTEst_nnzj, integer ); - MALLOC( indfun, CUTEst_nnzj, integer ); - grad = TRUE_; - /* Here, idummy will be set to nnzj again */ - CUTEST_ccfsg( &status, &CUTEst_nvar, &CUTEst_ncon, x, c, &idummy, - &CUTEst_nnzj, J, indvar, indfun, &grad ); - - if( status ) { + exit(status); + } + + /* CUTEst_nnzj -= CUTEst_nvar; */ /* substract dense gradient of objective function */ + + /* Get Jacobian at starting point */ + MALLOC( c, CUTEst_ncon, rp_ ); + MALLOC( J, CUTEst_nnzj, rp_ ); + MALLOC( indvar, CUTEst_nnzj, integer ); + MALLOC( indfun, CUTEst_nnzj, integer ); + grad = TRUE_; + /* Here, idummy will be set to nnzj again */ + CUTEST_ccfsg_r( &status, &CUTEst_nvar, &CUTEst_ncon, x, c, &idummy, + &CUTEst_nnzj, J, indvar, indfun, &grad ); + + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } + exit(status); + } - FREE( c ); - FREE( J ); + FREE( c ); + FREE( J ); #ifdef DEBUG - for( i=0; i 0 ) - { - /* Get Hessian of Lagrangian at starting point */ - MALLOC( H, CUTEst_nnzh, doublereal ); - MALLOC( irnh, CUTEst_nnzh, integer ); - MALLOC( icnh, CUTEst_nnzh, integer ); - if( CUTEst_ncon == 0 ) idummy = CUTEst_nnzh; /* for unconstrained problems */ - /* idummy will be set to nnzh again */ - CUTEST_csh( &status, &CUTEst_nvar, &CUTEst_ncon, x, v, - &idummy, &CUTEst_nnzh, H, irnh, icnh ); + if( CUTEst_nnzh > 0 ) + { + /* Get Hessian of Lagrangian at starting point */ + MALLOC( H, CUTEst_nnzh, rp_ ); + MALLOC( irnh, CUTEst_nnzh, integer ); + MALLOC( icnh, CUTEst_nnzh, integer ); + if( CUTEst_ncon == 0 ) idummy = CUTEst_nnzh; /* for unconstrained problems */ + /* idummy will be set to nnzh again */ + CUTEST_csh_r( &status, &CUTEst_nvar, &CUTEst_ncon, x, v, + &idummy, &CUTEst_nnzh, H, irnh, icnh ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } + exit(status); + } - FREE( H ); + FREE( H ); #ifdef DEBUG - for( i=0; in = CUTEst_nvar; - lp->m = CUTEst_ncon; - - CALLOC( lp->A, CUTEst_nnzj, double ); - lp->nz = CUTEst_nnzj; - lp->iA = iA; - lp->kA = kA; - - /* Hessian */ - CALLOC( lp->Q, qnz, double ); - lp->qnz = qnz; - lp->iQ = iQ; - lp->kQ = kQ; - - /* Bounds on variables */ - MALLOC( lp->l, CUTEst_nvar, double ); - MALLOC( lp->u, CUTEst_nvar, double ); - for(i=0;il[i] = -HUGE_VAL; - else - lp->l[i] = bl[i]; - - if( bu[i] >= CUTE_INF ) - lp->u[i] = HUGE_VAL; - else - lp->u[i] = bu[i]; - } - - /* Bounds for the constraints */ - MALLOC( lp->b, CUTEst_ncon, double ); - MALLOC( lp->r, CUTEst_ncon, double ); - MALLOC( cscale, CUTEst_ncon, double ); - for( i=0; ib[i] = -1.*cu[i]; - lp->r[i] = HUGE_VAL; - } - else - { - cscale[i] = 1.; - lp->b[i] = cl[i]; - if( cu[i] >= CUTE_INF ) - lp->r[i] = HUGE_VAL; - else - lp->r[i] = cu[i]-cl[i]; - } - } + FREE( irnh ); + FREE( icnh ); + } + else + { + CALLOC( kQ, CUTEst_nvar+1, int ); + } + + /* now we can forget the initial multipliers */ + FREE( v ); + + /* Now we can start to define the problem for LOQO */ + lp = openlp(); + + /* Problem size */ + lp->n = CUTEst_nvar; + lp->m = CUTEst_ncon; + + CALLOC( lp->A, CUTEst_nnzj, rp_ ); + lp->nz = CUTEst_nnzj; + lp->iA = iA; + lp->kA = kA; + + /* Hessian */ + CALLOC( lp->Q, qnz, rp_ ); + lp->qnz = qnz; + lp->iQ = iQ; + lp->kQ = kQ; + + /* Bounds on variables */ + MALLOC( lp->l, CUTEst_nvar, rp_ ); + MALLOC( lp->u, CUTEst_nvar, rp_ ); + for(i=0;il[i] = -HUGE_VAL; + else + lp->l[i] = bl[i]; + + if( bu[i] >= CUTE_INF ) + lp->u[i] = HUGE_VAL; + else + lp->u[i] = bu[i]; + } + + /* Bounds for the constraints */ + MALLOC( lp->b, CUTEst_ncon, rp_ ); + MALLOC( lp->r, CUTEst_ncon, rp_ ); + MALLOC( cscale, CUTEst_ncon, rp_ ); + for( i=0; ib[i] = -1.*cu[i]; + lp->r[i] = HUGE_VAL; + } + else + { + cscale[i] = 1.; + lp->b[i] = cl[i]; + if( cu[i] >= CUTE_INF ) + lp->r[i] = HUGE_VAL; + else + lp->r[i] = cu[i]-cl[i]; + } + } #ifdef DEBUG - for(i=0; ir[i], i, lp->b[i]); + for(i=0; ir[i], i, lp->b[i]); #endif - /* Space for the objective function gradient */ - MALLOC( lp->c, CUTEst_nvar, double ); + /* Space for the objective function gradient */ + MALLOC( lp->c, CUTEst_nvar, rp_ ); - /* Read algorithmic parameters from spec file */ - bad_opns = rd_specs( "LOQO.SPC" ); - if( bad_opns ) { - printf( "Error in LOQO.SPC, line %d \n", bad_opns ); - return 0; - } + /* Read algorithmic parameters from spec file */ + bad_opns = rd_specs( "LOQO.SPC" ); + if( bad_opns ) { + printf( "Error in LOQO.SPC, line %d \n", bad_opns ); + return 0; + } set_opns( lp ); - nlsetup( lp ); + nlsetup( lp ); - /* Assign starting point */ - lp->x = x; + /* Assign starting point */ + lp->x = x; - status = solvelp( lp ); + status = solvelp( lp ); - /* Free memory */ - FREE( Qcutest2loqo ); - FREE( cscale ); - FREE( Atcutest2loqo ); - FREE( Acutest2loqo ); + /* Free memory */ + FREE( Qcutest2loqo ); + FREE( cscale ); + FREE( Atcutest2loqo ); + FREE( Acutest2loqo ); - printf("LOQO status: %d\n",status); + printf("LOQO status: %d\n",status); - /* Get problem name */ - MALLOC( pname, FSTRING_LEN+1, char ); - MALLOC( vnames, CUTEst_nvar*FSTRING_LEN, char ); - MALLOC( gnames, CUTEst_ncon*FSTRING_LEN, char ); - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, - pname, vnames, gnames ); + /* Get problem name */ + MALLOC( pname, FSTRING_LEN+1, char ); + MALLOC( vnames, CUTEst_nvar*FSTRING_LEN, char ); + MALLOC( gnames, CUTEst_ncon*FSTRING_LEN, char ); + CUTEST_cnames_r( &status, &CUTEst_nvar, &CUTEst_ncon, + pname, vnames, gnames ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - FREE( vnames ); - FREE( gnames ); - pname[FSTRING_LEN] = '\0'; - i = FSTRING_LEN - 1; - while( i-- > 0 && pname[i] == ' ') { - pname[i] = '\0'; - } + exit(status); + } + + FREE( vnames ); + FREE( gnames ); + pname[FSTRING_LEN] = '\0'; + i = FSTRING_LEN - 1; + while( i-- > 0 && pname[i] == ' ') { + pname[i] = '\0'; + } - /* Compute final value of objective function and constraint violation */ - MALLOC( c, CUTEst_ncon, doublereal ); - CUTEST_cfn( &status, &CUTEst_nvar, &CUTEst_ncon, lp->x, &f, c ); + /* Compute final value of objective function and constraint violation */ + MALLOC( c, CUTEst_ncon, rp_ ); + CUTEST_cfn_r( &status, &CUTEst_nvar, &CUTEst_ncon, lp->x, &f, c ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - cmax = 0.; - for( i=0; i -CUTE_INF ) - cmax = max(cmax, cl[i] - c[i]); - if( cu[i] < CUTE_INF ) - cmax = max(cmax, c[i] - cu[i]); - } - FREE( c ); - for( i=0; i -CUTE_INF ) - cmax = max(cmax, bl[i] - lp->x[i]); - if( bu[i] < CUTE_INF ) - cmax = max(cmax, lp->x[i] - bu[i]); - } + exit(status); + } + + cmax = 0.; + for( i=0; i -CUTE_INF ) + cmax = max(cmax, cl[i] - c[i]); + if( cu[i] < CUTE_INF ) + cmax = max(cmax, c[i] - cu[i]); + } + FREE( c ); + for( i=0; i -CUTE_INF ) + cmax = max(cmax, bl[i] - lp->x[i]); + if( bu[i] < CUTE_INF ) + cmax = max(cmax, lp->x[i] - bu[i]); + } + + /* Output some Loqo info */ + printf( "# Iterations\t%-5d\n", lp->iter ); + printf( " KKT residual\t%-g\n", max( ABS(lp->pres), ABS(lp->dres) ) ); + printf( " Infeasibility\t%-g\n", cmax ); + printf( " LOQO CPU \t%-10.2f\n", lp->elaptime ); + printf( "# Eval f(x) \t%-6d\n", count_f ); + printf( "# Eval g(x) \t%-6d\n", count_g ); + printf( "# Eval c(x) \t%-6d\n", count_c ); + printf( "# Eval J(x) \t%-6d\n", count_a ); + printf( "# Eval H(x) \t%-6d\n", count_h ); + + /* Get CUTEst statistics */ + CUTEST_creport_r( &status, calls, cpu ); - /* Output some Loqo info */ - printf( "# Iterations\t%-5d\n", lp->iter ); - printf( " KKT residual\t%-g\n", max( ABS(lp->pres), ABS(lp->dres) ) ); - printf( " Infeasibility\t%-g\n", cmax ); - printf( " LOQO CPU \t%-10.2f\n", lp->elaptime ); - printf( "# Eval f(x) \t%-6d\n", count_f ); - printf( "# Eval g(x) \t%-6d\n", count_g ); - printf( "# Eval c(x) \t%-6d\n", count_c ); - printf( "# Eval J(x) \t%-6d\n", count_a ); - printf( "# Eval H(x) \t%-6d\n", count_h ); - - /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu ); - - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } - - printf("\n\n ************************ CUTEst statistics ************************\n\n"); - printf(" Code used : LOQO\n"); - printf(" Problem : %-s\n", pname); - printf(" # variables = %-10d\n", CUTEst_nvar); - printf(" # constraints = %-10d\n", CUTEst_ncon); - printf(" # objective functions = %-15.7g\n", calls[0]); - printf(" # objective gradients = %-15.7g\n", calls[1]); - printf(" # objective Hessians = %-15.7g\n", calls[2]); - printf(" # Hessian-vector prdct = %-15.7g\n", calls[3]); - printf(" # constraints functions = %-15.7g\n", calls[4]); - printf(" # constraints gradients = %-15.7g\n", calls[5]); - printf(" # constraints Hessians = %-15.7g\n", calls[6]); - printf(" Exit code = %-10d\n", status); - printf(" Final f = %-23.15g\n", f); - printf(" Final ||c||_inf = %-23.15g\n", cmax); - printf(" Set up time = %-10.2f seconds\n", cpu[0]); - printf(" Solve time = %-10.2f seconds\n", cpu[1]); - printf(" count_f (LOQO) = %-8d\n", count_f); - printf(" count_g (LOQO) = %-8d\n", count_g); - printf(" count_c (LOQO) = %-8d\n", count_c); - printf(" count_a (LOQO) = %-8d\n", count_a); - printf(" count_h (LOQO) = %-8d\n", count_h); - printf(" ******************************************************************\n\n"); - - FORTRAN_close( &funit, &ierr ); - if( ierr ) { - printf( "Error closing file %s", fname ); - return 1; - } - CUTEST_cterminate( &status ); - return 0; + exit(status); + } + + printf("\n\n ************************ CUTEst statistics ************************\n\n"); + printf(" Code used : LOQO\n"); + printf(" Problem : %-s\n", pname); + printf(" # variables = %-10d\n", CUTEst_nvar); + printf(" # constraints = %-10d\n", CUTEst_ncon); + printf(" # objective functions = %-15.7g\n", calls[0]); + printf(" # objective gradients = %-15.7g\n", calls[1]); + printf(" # objective Hessians = %-15.7g\n", calls[2]); + printf(" # Hessian-vector prdct = %-15.7g\n", calls[3]); + printf(" # constraints functions = %-15.7g\n", calls[4]); + printf(" # constraints gradients = %-15.7g\n", calls[5]); + printf(" # constraints Hessians = %-15.7g\n", calls[6]); + printf(" Exit code = %-10d\n", status); + printf(" Final f = %-23.15g\n", f); + printf(" Final ||c||_inf = %-23.15g\n", cmax); + printf(" Set up time = %-10.2f seconds\n", cpu[0]); + printf(" Solve time = %-10.2f seconds\n", cpu[1]); + printf(" count_f (LOQO) = %-8d\n", count_f); + printf(" count_g (LOQO) = %-8d\n", count_g); + printf(" count_c (LOQO) = %-8d\n", count_c); + printf(" count_a (LOQO) = %-8d\n", count_a); + printf(" count_h (LOQO) = %-8d\n", count_h); + printf(" ******************************************************************\n\n"); + + FORTRAN_close( &funit, &ierr ); + if( ierr ) { + printf( "Error closing file %s", fname ); + return 1; + } + CUTEST_cterminate_r( &status ); + return 0; } /* -------------------------------------------------- */ @@ -513,21 +516,21 @@ static int spec = 0; #undef __FUNCT__ #endif #define __FUNCT__ "objval" - double objval( double *x ) { - logical grad = FALSE_; - doublereal *dummy, f; - integer status; + rp_ objval( rp_ *x ) { + logical grad = FALSE_; + rp_ *dummy, f; + integer status; - count_f++; + count_f++; - CUTEST_cofg( &status, &CUTEst_nvar, x, &f, dummy, &grad ); + CUTEST_cofg_r( &status, &CUTEst_nvar, x, &f, dummy, &grad ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } + exit(status); + } - return f; + return f; } /* -------------------------------------------------- */ @@ -536,21 +539,21 @@ static int spec = 0; #undef __FUNCT__ #endif #define __FUNCT__ "objgrad" - void objgrad( double *c, double *x ) { - logical grad = TRUE_; - doublereal fdummy; - integer status; + void objgrad( rp_ *c, rp_ *x ) { + logical grad = TRUE_; + rp_ fdummy; + integer status; - count_g++; + count_g++; - CUTEST_cofg( &status, &CUTEst_nvar, x, &fdummy, c, &grad ); + CUTEST_cofg_r( &status, &CUTEst_nvar, x, &fdummy, c, &grad ); - if( status ) { + if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); - exit(status); - } + exit(status); + } - return; + return; } /* -------------------------------------------------- */ @@ -559,41 +562,41 @@ static int spec = 0; #undef __FUNCT__ #endif #define __FUNCT__ "hessian" - void hessian( double *Q, double *x, double *y ) { - doublereal *h; - doublereal *v; - integer idummy, *irnh, *icnh; - int i; - integer status; + void hessian( rp_ *Q, rp_ *x, rp_ *y ) { + rp_ *h; + rp_ *v; + integer idummy, *irnh, *icnh; + int i; + integer status; - count_h++; + count_h++; - MALLOC( v, CUTEst_ncon, doublereal ); - MALLOC( h, CUTEst_nnzh, doublereal ); - MALLOC( irnh, CUTEst_nnzh, integer ); - MALLOC( icnh, CUTEst_nnzh, integer ); + MALLOC( v, CUTEst_ncon, rp_ ); + MALLOC( h, CUTEst_nnzh, rp_ ); + MALLOC( irnh, CUTEst_nnzh, integer ); + MALLOC( icnh, CUTEst_nnzh, integer ); - /* Rescale the multipliers according to cscale - also, note that LOQO - uses '-' in the definition of the Lagrangian while CUTEst uses '+' */ - for( i=0; ij < b->j) return(-1); - if (a->j > b->j) return(1); - if (a->i < b->i) return(-1); - if (a->i > b->i) return(1); - printf("Two entries for same element: i = %d j = %d. Abort.\n",a->i,a->j); - exit(1); + CUTEstentry *a, *b; + a = (CUTEstentry *) A; + b = (CUTEstentry *) B; + if (a->j < b->j) return(-1); + if (a->j > b->j) return(1); + if (a->i < b->i) return(-1); + if (a->i > b->i) return(1); + printf("Two entries for same element: i = %d j = %d. Abort.\n",a->i,a->j); + exit(1); } /* -------------------------------------------------- */ @@ -705,82 +708,82 @@ static int spec = 0; #endif #define __FUNCT__ "convert_sparse_format" void convert_sparse_format(int ishess, /* 0 for Jac, 1 for Hessian */ - int n, /* number of rows */ - int m, /* number of columns */ - int nnz_in, /* number of nonzeros in input */ - integer *irow_in, /* row position of input*/ - integer *jcol_in, /* column position of input */ - int *nnz_out, /* number of nonzeros in output */ - int **i_out, /* sparse format - rows */ - int **k_out, /* sparse format - columns */ - int **cute2loqo /* mapping for values */ - ) { - int i, j, icutest; - CUTEstentry *A; - - MALLOC(A, 2*nnz_in, CUTEstentry); /* we are generous... */ - - /* copy data to sort array */ - *nnz_out = 0; - if( ishess ) { - for( i=0; i= 'a' && *s <= 'z') || (*s >= 'A' && *s <= 'Z')) { - kw = (keyword *)binsearch(&s); - if (bad_opns) return 0; - while (*s && *s == ' ') s++; - switch (kw->type) { - case 0: - kw->ivalue = 1; /* depending on keyword, this may need to change */ - break; - case 1: - if (*s == '=') { - s++; - while (*s && *s == ' ') s++; - if (*s <= '9' && *s >= '0') { - kw->ivalue = (int)strtol(s1 = s, &s, 10); - } else { - return 0; - } - } else { - return 0; - } - break; - case 2: + char *s1; + keyword *kw; + + while (*s) { + while (*s && *s==' ') s++; + if (!*s) return 1; + if ((*s >= 'a' && *s <= 'z') || (*s >= 'A' && *s <= 'Z')) { + kw = (keyword *)binsearch(&s); + if (bad_opns) return 0; + while (*s && *s == ' ') s++; + switch (kw->type) { + case 0: + kw->ivalue = 1; /* depending on keyword, this may need to change */ + break; + case 1: + if (*s == '=') { + s++; + while (*s && *s == ' ') s++; + if (*s <= '9' && *s >= '0') { + kw->ivalue = (int)strtol(s1 = s, &s, 10); + } else { + return 0; + } + } else { + return 0; + } + break; + case 2: if (*s == '=') { s++; while (*s && *s == ' ') s++; @@ -830,13 +833,13 @@ int rd_opns(char *s) { return 0; } break; - } - } else { - return 0; - } - } - - return 1; + } + } else { + return 0; + } + } + + return 1; } /* -------------------------------------------------- */ @@ -846,36 +849,36 @@ int rd_opns(char *s) { #endif #define __FUNCT__ "binsearch" void *binsearch(char **sp) { - keyword *kw = keywds; - keyword *kw1; - int n = 32; /* number of keywords */ - int n1; - int c1, c2; - char *s, *s1, *s2; - - s = *sp; - while (n > 0) { - kw1 = kw + (n1 = n >> 1); - s2 = *(char **)kw1; - for (s1 = s;; s1++) { - c1 = tolower(*(unsigned char *)s1); - if (!(c2 = *s2++)) { - if (c1 <= ' ' || c1 == '=') { - *sp = s1; - return kw1; - } - break; - } - if (c1 != c2) break; - } - if (c1 == '=' || c1 < c2) n = n1; - else { - n -= n1 + 1; - kw = kw1 + 1; - } - } - bad_opns++; - return 0; + keyword *kw = keywds; + keyword *kw1; + int n = 32; /* number of keywords */ + int n1; + int c1, c2; + char *s, *s1, *s2; + + s = *sp; + while (n > 0) { + kw1 = kw + (n1 = n >> 1); + s2 = *(char **)kw1; + for (s1 = s;; s1++) { + c1 = tolower(*(unsigned char *)s1); + if (!(c2 = *s2++)) { + if (c1 <= ' ' || c1 == '=') { + *sp = s1; + return kw1; + } + break; + } + if (c1 != c2) break; + } + if (c1 == '=' || c1 < c2) n = n1; + else { + n -= n1 + 1; + kw = kw1 + 1; + } + } + bad_opns++; + return 0; } /* -------------------------------------------------- */ @@ -885,58 +888,58 @@ void *binsearch(char **sp) { #endif #define __FUNCT__ "set_opns" void set_opns(LOQO *lp) { - keyword *kw = keywds; - int verbose, itnlim; - int noreord, md, mlf; - int primal, dual; - int max, maximize, min, minimize; - - lp->bndpush = kw->dvalue; kw++; - lp->convex = kw->ivalue; kw++; - lp->dense = kw->ivalue; kw++; - dual = kw->ivalue; kw++; - lp->epsdiag = kw->dvalue; kw++; - lp->epsnum = kw->dvalue; kw++; - lp->epssol = kw->dvalue; kw++; - lp->honor_bnds = kw->ivalue; kw++; - lp->honor_bnds_init = kw->ivalue; kw++; - lp->inftol = kw->dvalue; kw++; - lp->inftol2 = kw->dvalue; kw++; - itnlim = kw->ivalue; kw++; - lp->lincons = kw->ivalue; kw++; - max = kw->ivalue; kw++; - maximize = kw->ivalue; kw++; - if (itnlim == 200) lp->itnlim = kw->ivalue; else lp->itnlim = itnlim; kw++; - min = kw->ivalue; kw++; - md = kw->ivalue; kw++; - minimize = kw->ivalue; kw++; - mlf = kw->ivalue; kw++; - lp->mufactor = kw->dvalue; kw++; - noreord = kw->ivalue; kw++; - verbose = kw->ivalue; kw++; - lp->pred_corr = kw->ivalue; kw++; - primal = kw->ivalue; kw++; - lp->quadratic = kw->ivalue; kw++; - lp->sdp = kw->ivalue; kw++; - lp->sf_req = kw->ivalue; kw++; - lp->stablty = kw->dvalue; kw++; - lp->steplen = kw->dvalue; kw++; - if (kw->dvalue != -1.0) lp->timlim = kw->dvalue; kw++; - if (verbose == 0) lp->verbose = kw->ivalue; else lp->verbose = verbose; kw++; - lp->method=1; - if (noreord) lp->method = 0; - else if (mlf) lp->method = 2; - else if (md) lp->method = 1; - - lp->pdf=0; - if (primal) lp->pdf = 1; - if (dual) lp->pdf = 2; - - lp->max=1; - if (max || maximize) lp->max = -1; - if (min || minimize) lp->max = 1; - - if (lp->quadratic) lp->lincons=1; + keyword *kw = keywds; + int verbose, itnlim; + int noreord, md, mlf; + int primal, dual; + int max, maximize, min, minimize; + + lp->bndpush = kw->dvalue; kw++; + lp->convex = kw->ivalue; kw++; + lp->dense = kw->ivalue; kw++; + dual = kw->ivalue; kw++; + lp->epsdiag = kw->dvalue; kw++; + lp->epsnum = kw->dvalue; kw++; + lp->epssol = kw->dvalue; kw++; + lp->honor_bnds = kw->ivalue; kw++; + lp->honor_bnds_init = kw->ivalue; kw++; + lp->inftol = kw->dvalue; kw++; + lp->inftol2 = kw->dvalue; kw++; + itnlim = kw->ivalue; kw++; + lp->lincons = kw->ivalue; kw++; + max = kw->ivalue; kw++; + maximize = kw->ivalue; kw++; + if (itnlim == 200) lp->itnlim = kw->ivalue; else lp->itnlim = itnlim; kw++; + min = kw->ivalue; kw++; + md = kw->ivalue; kw++; + minimize = kw->ivalue; kw++; + mlf = kw->ivalue; kw++; + lp->mufactor = kw->dvalue; kw++; + noreord = kw->ivalue; kw++; + verbose = kw->ivalue; kw++; + lp->pred_corr = kw->ivalue; kw++; + primal = kw->ivalue; kw++; + lp->quadratic = kw->ivalue; kw++; + lp->sdp = kw->ivalue; kw++; + lp->sf_req = kw->ivalue; kw++; + lp->stablty = kw->dvalue; kw++; + lp->steplen = kw->dvalue; kw++; + if (kw->dvalue != -1.0) lp->timlim = kw->dvalue; kw++; + if (verbose == 0) lp->verbose = kw->ivalue; else lp->verbose = verbose; kw++; + lp->method=1; + if (noreord) lp->method = 0; + else if (mlf) lp->method = 2; + else if (md) lp->method = 1; + + lp->pdf=0; + if (primal) lp->pdf = 1; + if (dual) lp->pdf = 2; + + lp->max=1; + if (max || maximize) lp->max = -1; + if (min || minimize) lp->max = 1; + + if (lp->quadratic) lp->lincons=1; } /* -------------------------------------------------- */ @@ -946,63 +949,67 @@ void set_opns(LOQO *lp) { #endif #define __FUNCT__ "rd_specs" int rd_specs(char *Spec_name) { - char *s1; - keyword *kw; - char *CUTEst_loc; - char *Spec_loc; - char specline[80]; - char option[15], val[15], comment[50]; - char *optionptr, *valptr; - int i, j; - FILE *specfile; - int s; - - spec = 1; - - /* open the specs file */ - specfile = fopen(Spec_name, "r"); - fgets(specline, 80, specfile); - s = sscanf(specline, "%s%s%s", option, val, comment); - i = 0; - while (s && !feof(specfile)) { - i++; - if ((option[0] >= 'a' && option[0] <= 'z') || (option[0] >= 'A' && option[0] <= 'Z')) { - optionptr = &option[0]; - kw = (keyword *)binsearch(&optionptr); - if (bad_opns) { fclose(specfile); return i; } - switch (kw->type) { - case 0: - if (val[0] == 'T') kw->ivalue = 1; - else if (val[0] == 'F') kw->ivalue = 0; - else { fclose(specfile); return i; } - break; - case 1: - if ((val[0] <= '9' && val[0] >= '0') || (val[0] == '-' && val[1] <= '9' && val[1] >= 0)) { - valptr = &val[0]; - kw->ivalue = (int)strtol(s1 = valptr, &valptr, 10); - } else { - fclose(specfile); - return i; - } - break; - case 2: - if (val[0] <= '9' && val[0] >= '0') { - valptr = &val[0]; - kw->dvalue = strtod(s1 = valptr, &valptr); - } else { - fclose(specfile); - return i; - } - break; - } - } else { - if (option[0] != '*') { /* Comment */ - fclose(specfile); - return i; - } - } - fgets(specline, 80, specfile); - s = sscanf(specline, "%s%s%s", option, val, comment); + char *s1; + keyword *kw; + char *CUTEst_loc; + char *Spec_loc; + char specline[80]; + char option[15], val[15], comment[50]; + char *optionptr, *valptr; + int i, j; + FILE *specfile; + int s; + + spec = 1; + + /* open the specs file */ + specfile = fopen(Spec_name, "r"); + if(fgets(specline, 80, specfile)) + ; + s = sscanf(specline, "%s%s%s", option, val, comment); + i = 0; + while (s && !feof(specfile)) { + i++; + if ((option[0] >= 'a' && option[0] <= 'z') || + (option[0] >= 'A' && option[0] <= 'Z')) { + optionptr = &option[0]; + kw = (keyword *)binsearch(&optionptr); + if (bad_opns) { fclose(specfile); return i; } + switch (kw->type) { + case 0: + if (val[0] == 'T') kw->ivalue = 1; + else if (val[0] == 'F') kw->ivalue = 0; + else { fclose(specfile); return i; } + break; + case 1: + if ((val[0] <= '9' && val[0] >= '0') || + (val[0] == '-' && val[1] <= '9' && val[1] >= 0)) { + valptr = &val[0]; + kw->ivalue = (int)strtol(s1 = valptr, &valptr, 10); + } else { + fclose(specfile); + return i; + } + break; + case 2: + if (val[0] <= '9' && val[0] >= '0') { + valptr = &val[0]; + kw->dvalue = strtod(s1 = valptr, &valptr); + } else { + fclose(specfile); + return i; + } + break; + } + } else { + if (option[0] != '*') { /* Comment */ + fclose(specfile); + return i; + } + } + if(fgets(specline, 80, specfile)) + ; + s = sscanf(specline, "%s%s%s", option, val, comment); } fclose(specfile); return 0; diff --git a/src/loqo/makemaster b/src/loqo/makemaster index 5665848..32e4ca4 100644 --- a/src/loqo/makemaster +++ b/src/loqo/makemaster @@ -1,134 +1,38 @@ # Main body of the installation makefile for CUTEst LOQO interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 15 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = LOQO -package = loqo - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o +PACKAGE = LOQO +package = loqo -SUCC = precision version) compiled successfully +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# main compilations and runs +# include standard CUTEst makefile definitions -all: $(package) +include $(CUTEST)/src/makedefs/definitions -# basic packages +# include compilation and run instructions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +include $(CUTEST)/src/makedefs/instructions -# run example tests +# select specific run test run_test: echo " No $(PACKAGE) test program at the moment" -run_test_todo: tools test_cutest $(OBJ)/$(package)_main.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.c > \ - $(OBJ)/$(package)_main.c - -cd $(OBJ); $(CC) -o $(package)_main.o $(CFLAGS) $(package)_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_main.o $(CFLAGSN) $(package)_main.c ) - $(RM) $(OBJ)/$(package)_main.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/makedefs/compile b/src/makedefs/compile index 8ba7b0a..b9e2849 100644 --- a/src/makedefs/compile +++ b/src/makedefs/compile @@ -7,42 +7,42 @@ $(OBJ)/%.o : %.c @printf ' %-9s %-15s\t\t' "Compiling" "$*" - $(CC) -c $(CFLAGS) $(CPPFLAGS) $< -o $@ \ + $(CC) $(CFLAGS) $(CPPFLAGS) $< -o $@ \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -c $(CFLAGSN) $(CPPFLAGS) $< -o $@ ) + $(CC) $(CFLAGSN) $(CPPFLAGS) $< -o $@ ) @printf '[ OK ]\n' $(OBJ)/%.o : %.C @printf ' %-9s %-15s\t\t' "Compiling" "$*" - $(CC) -c $(CFLAGS) $(CPPFLAGS) $< -o $@ \ + $(CC) $(CFLAGS) $(CPPFLAGS) $< -o $@ \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -c $(CFLAGSN) $(CPPFLAGS) $< -o $@ ) + $(CC) $(CFLAGSN) $(CPPFLAGS) $< -o $@ ) @printf '[ OK ]\n' $(OBJ)/%.o : %.F90 @printf ' %-9s %-15s\t\t' "Compiling" "$*" - $(FORTRAN) -c $(F90FLAGS) $(CPPFLAGS) $< -o $@ \ + $(FORTRAN) $(F90FLAGS) $(CPPFLAGS) $< -o $@ \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -c $(F90FLAGSN) $(CPPFLAGS) $< -o $@ ) + $(FORTRAN) $(F90FLAGSN) $(CPPFLAGS) $< -o $@ ) @printf '[ OK ]\n' $(OBJ)/%.o : %.f90 @printf ' %-9s %-15s\t\t' "Compiling" "$*" - $(FORTRAN) -c $(F90FLAGS) $(CPPFLAGS) $< -o $@ \ + $(FORTRAN) $(F90FLAGS) $(CPPFLAGS) $< -o $@ \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -c $(F90FLAGSN) $(CPPFLAGS) $< -o $@ ) + $(FORTRAN) $(F90FLAGSN) $(CPPFLAGS) $< -o $@ ) @printf '[ OK ]\n' $(OBJ)/%.o : %.F @printf ' %-9s %-15s\t\t' "Compiling" "$*" - $(FORTRAN) -c $(FFLAGS) $(CPPFLAGS) $< -o $@ \ + $(FORTRAN) $(FFLAGS) $(CPPFLAGS) $< -o $@ \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -c $(FFLAGSN) $(CPPFLAGS) $< -o $@ ) + $(FORTRAN) $(FFLAGSN) $(CPPFLAGS) $< -o $@ ) @printf '[ OK ]\n' $(OBJ)/%.o : %.f @printf ' %-9s %-15s\t\t' "Compiling" "$*" - $(FORTRAN) -c $(FFLAGS) $(CPPFLAGS) $< -o $@ \ + $(FORTRAN) $(FFLAGS) $(CPPFLAGS) $< -o $@ \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -c $(FFLAGSN) $(CPPFLAGS) $< -o $@ ) + $(FORTRAN) $(FFLAGSN) $(CPPFLAGS) $< -o $@ ) @printf '[ OK ]\n' diff --git a/src/makedefs/defaults b/src/makedefs/defaults index 2508c88..51d81e0 100644 --- a/src/makedefs/defaults +++ b/src/makedefs/defaults @@ -3,3 +3,5 @@ # Nick Gould, for GALAHAD productions # This version: 2023-11-06 +EXTRAINCLUDES = + diff --git a/src/makedefs/definitions b/src/makedefs/definitions index a165c6f..7127d97 100644 --- a/src/makedefs/definitions +++ b/src/makedefs/definitions @@ -1,7 +1,7 @@ -# Standard GALAHAD makefile definitions +# Standard CUTEst makefile definitions # Nick Gould, for GALAHAD production -# This version: 2023-05-18 +# This version: 2023-11-22 # makefile shell @@ -16,19 +16,25 @@ endif # compiler flags F90FLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include -F90FLAGSFS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) \ - $(DPREC) -I $(CUTEST)/include -F90FLAGSFN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) \ - $(DPREC) -I $(CUTEST)/include + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) +F90FLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) \ + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) +F90FLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) \ + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) \ - $(DPREC) -I $(CUTEST)/include + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) +CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) \ + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) +CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) \ + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) \ - $(DPREC) -I $(CUTEST)/include + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) -lstdc++ +CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) \ + $(DPREC) -I $(CUTEST)/include $(EXTRAINCLUDES) $(CCFFLAGS) # names of random libraries @@ -48,6 +54,14 @@ LLC = $(OBJ)/libcutest_lapack.a LLCS = $(OBJS)/libcutest_lapack.a LLCD = $(OBJD)/libcutest_lapack.a +MLC = $(OBJ)/libcutest_matlab.a +MLCS = $(OBJS)/libcutest_matlab.a +MLCD = $(OBJD)/libcutest_matlab.a + +OLC = $(OBJ)/libcutest_octave.a +OLCS = $(OBJS)/libcutest_octave.a +OLCD = $(OBJD)/libcutest_octave.a + # Libraries used #LIBS = -lcutest -lcutest_lapack -lcutest_blas @@ -71,3 +85,15 @@ LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) # strings SUCC = precision version) compiled successfully + +# main component + +$(PACKAGE) = $(OBJ)/$(package)_main.o + +# test example components + +#U_TEST = $(OBJ)/u_elfun.o $(OBJ)/u_group.o $(OBJ)/u_range.o $(OBJ)/u_exter.o +#C_TEST = $(OBJ)/c_elfun.o $(OBJ)/c_group.o $(OBJ)/c_range.o $(OBJ)/c_exter.o +U_TEST = $(OBJ)/u_elfun.o $(OBJ)/u_group.o $(OBJ)/u_range.o +C_TEST = $(OBJ)/c_elfun.o $(OBJ)/c_group.o $(OBJ)/c_range.o +Q_TEST = $(OBJ)/q_elfun.o $(OBJ)/q_group.o $(OBJ)/q_range.o diff --git a/src/makedefs/instructions b/src/makedefs/instructions index 4bf91bf..83f619c 100644 --- a/src/makedefs/instructions +++ b/src/makedefs/instructions @@ -1,22 +1,10 @@ # standard CUTEst compilation and run instructions # Nick Gould, for GALAHAD production -# This version: 2023-11-06 +# This version: 2023-11-22 # compilation agenda -$(PACKAGE) = $(OBJ)/$(package)_main.o - -#U_TEST = $(OBJ)/u_elfun.o $(OBJ)/u_group.o $(OBJ)/u_range.o $(OBJ)/u_exter.o -#C_TEST = $(OBJ)/c_elfun.o $(OBJ)/c_group.o $(OBJ)/c_range.o $(OBJ)/c_exter.o -U_TEST = $(OBJ)/u_elfun.o $(OBJ)/u_group.o $(OBJ)/u_range.o -C_TEST = $(OBJ)/c_elfun.o $(OBJ)/c_group.o $(OBJ)/c_range.o -Q_TEST = $(OBJ)/q_elfun.o $(OBJ)/q_group.o $(OBJ)/q_range.o - -# ========================================================================= -# ========================== makefile stanza ============================== -# ========================================================================= - all: $(package) # basic packages @@ -26,20 +14,8 @@ $(package): $(package)_$(PRECIS) $(package)_single: $($(PACKAGE)) $(package)_double: $($(PACKAGE)) -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +# compile tools -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) tools: ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) @@ -50,11 +26,73 @@ ctools: ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# compile test example + +test_cutest: test_cutest_unconstrained test_cutest_constrained + +test_cutest_unconstrained: + ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ + test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) + +test_cutest_constrained: + ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ + test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) + +test_cutest_quadratic: + ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ + test_cutest_quadratic PRECIS=$(PRECIS) PWD=$(PWD)/../test ) + +# run example tests + +run_unconstrained_test: tools test_cutest_unconstrained $(package) \ + $(OBJ)/$(package)_test.o + echo " Test of unconstrained $(package)" + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test >& ../$(package)/u_test.output + cat ../$(package)/u_test.output + rm $(OBJ)/run_test ../$(package)/OUTSDIF.d $(OBJ)/$(package)_test.o + +run_constrained_test: tools test_cutest_constrained $(package) \ + $(OBJ)/$(package)_test.o + echo " Test of constrained $(package)" + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test >& ../$(package)/u_test.output + cat ../$(package)/u_test.output + rm $(OBJ)/run_test ../$(package)/OUTSDIF.d $(OBJ)/$(package)_test.o + +run_both_tests: tools test_cutest $(package) $(OBJ)/$(package)_test.o + echo " Test of unconstrained $(package)" + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test >& ../$(package)/u_test.output + cat ../$(package)/u_test.output + echo " Test of constrained $(package)" + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test >& ../$(package)/u_test.output + cat ../$(package)/u_test.output + rm $(OBJ)/run_test ../$(package)/OUTSDIF.d $(OBJ)/$(package)_test.o + +run_qp_test: tools test_cutest_quadratic $(package) $(OBJ)/$(package)_test.o + echo " Test of quadratic programming $(package)" + cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ + $(package)_main.o $(package)_test.o $(Q_TEST) -L$(OBJ) $(LIBS) + ln -fs $(CUTEST)/src/test/q_OUTSDIF.d ../$(package)/OUTSDIF.d + - $(OBJ)/run_test >& ../$(package)/q_test.output + cat ../$(package)/q_test.output + rm $(OBJ)/run_test ../$(package)/OUTSDIF.d $(OBJ)/$(package)_test.o + # book keeping clean: @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* + $(RM) $(OBJ)/$(package)* @printf '[ OK ]\n' cleanall: diff --git a/src/makemaster b/src/makemaster index 595669b..4bb280f 100644 --- a/src/makemaster +++ b/src/makemaster @@ -43,8 +43,8 @@ all_single: tools_single hrb PRECIS=single PWD=$(PWD)/hrb ) ( cd ipopt ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ ipopt PRECIS=single PWD=$(PWD)/ipopt ) - ( cd knitro ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - knitro PRECIS=single PWD=$(PWD)/knitro ) +# ( cd knitro ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ +# knitro PRECIS=single PWD=$(PWD)/knitro ) ( cd la04 ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ la04 PRECIS=single PWD=$(PWD)/la04 ) ( cd lbfgs ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ @@ -53,8 +53,8 @@ all_single: tools_single lbfgsb PRECIS=single PWD=$(PWD)/lbfgsb ) ( cd lincoa ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ lincoa PRECIS=single PWD=$(PWD)/lincoa ) - ( cd loqo ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - loqo PRECIS=single PWD=$(PWD)/loqo ) +# ( cd loqo ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ +# loqo PRECIS=single PWD=$(PWD)/loqo ) ( cd minos ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ minos PRECIS=single PWD=$(PWD)/minos ) ( cd newuoa ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ @@ -95,8 +95,8 @@ all_single: tools_single uncmin PRECIS=single PWD=$(PWD)/uncmin ) ( cd vf13 ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ vf13 PRECIS=single PWD=$(PWD)/vf13 ) - ( cd worhp ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - worhp PRECIS=single PWD=$(PWD)/worhp ) +# ( cd worhp ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ +# worhp PRECIS=single PWD=$(PWD)/worhp ) all_double: tools_double ( cd algencan ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ algencan PRECIS=double PWD=$(PWD)/algencan ) @@ -201,7 +201,7 @@ all_2008_double: all_double # all tools (including gsl) and interfaces -all_with_gsl: all_with_tao_$(PRECIS) +all_with_gsl: all_with_gsl_$(PRECIS) all_with_gsl_single: all_single ( cd gsl ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ gsl PRECIS=single PWD=$(PWD)/gsl ) @@ -301,8 +301,8 @@ run_test_single: tools_single test_single run_test PRECIS=single PWD=$(PWD)/cgplus ) ( cd cobyla ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ run_test PRECIS=single PWD=$(PWD)/cobyla ) -# ( cd derchk ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ -# run_test PRECIS=single PWD=$(PWD)/derchk ) + ( cd derchk ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ + run_test PRECIS=single PWD=$(PWD)/derchk ) ( cd dfo ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ run_test PRECIS=single PWD=$(PWD)/dfo ) ( cd e04nqf ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ @@ -323,8 +323,8 @@ run_test_single: tools_single test_single run_test PRECIS=single PWD=$(PWD)/hrb ) ( cd ipopt ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ run_test PRECIS=single PWD=$(PWD)/ipopt ) - ( cd knitro ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - run_test PRECIS=single PWD=$(PWD)/knitro ) +# ( cd knitro ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ +# run_test PRECIS=single PWD=$(PWD)/knitro ) ( cd la04 ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ run_test PRECIS=single PWD=$(PWD)/la04 ) ( cd lbfgs ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ @@ -383,8 +383,8 @@ run_test_double: tools_double test_double run_test PRECIS=double PWD=$(PWD)/cgplus ) ( cd cobyla ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ run_test PRECIS=double PWD=$(PWD)/cobyla ) -# ( cd derchk ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ -# run_test PRECIS=double PWD=$(PWD)/derchk ) + ( cd derchk ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ + run_test PRECIS=double PWD=$(PWD)/derchk ) ( cd dfo ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ run_test PRECIS=double PWD=$(PWD)/dfo ) ( cd e04nqf ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ diff --git a/src/matlab/makemaster b/src/matlab/makemaster index b8f03e7..95c6f72 100644 --- a/src/matlab/makemaster +++ b/src/matlab/makemaster @@ -1,14 +1,24 @@ # Main body of the installation makefile for CUTEst Matlab programs # N. Gould, D. Orban and Ph. L. Toint. -# This version: 16 I 2013 +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = MATLAB +include $(CUTEST)/src/makedefs/defaults + +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== + +# package name + +PACKAGE = MATLAB_CUTEST package = matlab -SHELL = /bin/$(BINSHELL) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== # Mex compiler @@ -17,79 +27,15 @@ MEX = $(MYMATLAB)/bin/mex # compiler flags MATLABINC = -I$(MATLAB)/extern/include -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(MATLABINC) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(MATLABINC) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - MFFLAGS = $(MBASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -#MFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) MFLAGS = CC='$(CC)' FC='$(FORTRAN)' GCC='$(CC)' \ FFLAGS='$(MFFLAGS) $(OPENMP)' \ LD='$(FORTRAN) $(MFFLAGS) $(OPENMP)' \ -g -largeArrayDims $(MATLABINC) -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -MLC = $(OBJ)/libcutest_matlab.a -MLCS = $(OBJS)/libcutest_matlab.a -MLCD = $(OBJD)/libcutest_matlab.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest_matlab -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -MARR = $(AR) $(ARREPFLAGS) $(MLC) -MRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(MLC) - -# Derived type dependencies - -MAT_BASIC = $(MLC)(gtools.o) - -# compilation agenda - -GEN77 = $(OBJ)/gen77.o $(OBJ)/gen77_main.o -GEN90 = $(OBJ)/gen90.o $(OBJ)/gen90_main.o -GENC = $(OBJ)/genc.o $(OBJ)/genc_main.o +# include standard CUTEst makefile definitions -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully +include $(CUTEST)/src/makedefs/definitions # main compilations and runs @@ -98,13 +44,12 @@ all: $(package) # basic packages $(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -#$(package)_single: $(OBJS)/utools.o $(OBJS)/ctools.o $(OBJS)/mcutest.o -#$(package)_double: $(OBJD)/utools.o $(OBJD)/ctools.o $(OBJD)/mcutest.o -$(package)_single: $(OBJS)/mcutest.o +$(package)_single: + @printf ' %-21s\n' "$(package) is not available in single precision" $(package)_double: $(OBJD)/mcutest.o + @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -# dependent packages +# compile tools tools: ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ @@ -118,61 +63,13 @@ ctools: # individual compilations -# utools - -utools.o: $(OBJ)/utools.o - -$(OBJ)/utools.o: utools $(MAT_BASIC) utools.F - @printf ' %-9s %-15s\t\t' "Compiling" "utools" - $(SED) -f $(SEDS) utools.F > $(OBJ)/utools.F - cd $(OBJ) ; $(MEX) -c $(MFLAGS) utools.F - $(RM) $(OBJ)/utools.F - @printf '[ OK ]\n' - -# ctools - -ctools.o: $(OBJ)/ctools.o - -$(OBJ)/ctools.o: ctools $(MAT_BASIC) ctools.F - @printf ' %-9s %-15s\t\t' "Compiling" "ctools" - $(SED) -f $(SEDS) ctools.F > $(OBJ)/ctools.F - cd $(OBJ) ; $(MEX) -c $(MFLAGS) ctools.F - $(RM) $(OBJ)/ctools.F - @printf '[ OK ]\n' - # mcutest mcutest.o: $(OBJ)/mcutest.o -$(OBJ)/mcutest.o: tools mcutest.c +$(OBJ)/mcutest.o: mcutest.c @printf ' %-9s %-15s\t\t' "Compiling" "mcutest" $(CP) mcutest.c $(OBJ)/mcutest.c cd $(OBJ) ; $(MEX) -c $(MFLAGS) -I$(CUTEST)/include mcutest.c $(RM) $(OBJ)/mcutest.c @printf '[ OK ]\n' - -# main copying utilities - -gtools.o: $(MLC)(gtools.o) - -$(MLC)(gtools.o): gtools.F - @printf ' %-9s %-15s\t\t' "Compiling" "gtools" - $(CP) gtools.F $(OBJ)/gtools.F - cd $(OBJ) ; $(MEX) $(MFLAGS) -c gtools.F - cd $(OBJ) ; $(MARR) gtools.o - $(RM) $(OBJ)/utools.o $(OBJ)/ctools.o - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' - diff --git a/src/minos/makemaster b/src/minos/makemaster index 58e04e8..c4f6e23 100644 --- a/src/minos/makemaster +++ b/src/minos/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst MINOS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 14 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = MINOS -package = minos - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = MINOS +package = minos -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/minos/minos_main.f b/src/minos/minos_main.F similarity index 79% rename from src/minos/minos_main.f rename to src/minos/minos_main.F index 911f054..01a78d6 100644 --- a/src/minos/minos_main.f +++ b/src/minos/minos_main.F @@ -1,6 +1,10 @@ -C ( Last modified on 11 Jan 2013 at 14:30:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + C C Main program for MINOS using CUTEst C @@ -10,45 +14,48 @@ C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ PROGRAM MINOS_main - implicit none + USE CUTEST_KINDS_precision + IMPLICIT NONE C ------- these may need to be altered - see also funcon below -------- - INTEGER, PARAMETER :: n_guess = 100000 - INTEGER, PARAMETER :: ne_guess = 1000000 - INTEGER, PARAMETER :: nwcore = 10000000 - INTEGER, PARAMETER :: licwk = 2 * ne_guess + n_guess + 1 - INTEGER, PARAMETER :: lcwk = ne_guess + n_guess - INTEGER :: ICWK( licwk ) - DOUBLE PRECISION :: CWK( lcwk ) - DOUBLE PRECISION :: Z( nwcore ) + INTEGER ( KIND = ip_ ), PARAMETER :: n_guess = 100000 + INTEGER ( KIND = ip_ ), PARAMETER :: ne_guess = 1000000 + INTEGER ( KIND = ip_ ), PARAMETER :: nwcore = 10000000 + INTEGER ( KIND = ip_ ), PARAMETER :: + * licwk = 2 * ne_guess + n_guess + 1 + INTEGER ( KIND = ip_ ), PARAMETER :: lcwk = ne_guess + n_guess + INTEGER ( KIND = ip_ ) :: ICWK( licwk ) + REAL ( KIND = rp_ ) :: CWK( lcwk ) + REAL ( KIND = rp_ ) :: Z( nwcore ) C --------------------------------------------------------------------- - INTEGER :: ispecs, iprint, isumm, ns, l_j, status - INTEGER :: m, n, ne, nb, nncon, nnjac, nnobj, iobj, inform, mincor - INTEGER :: i, ii, j, k, jslack, njac, ninf, neq, nlc - INTEGER, PARAMETER :: input = 55, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: NAME1( 1 ), NAME2( 1 ) - DOUBLE PRECISION :: objadd, sinf, obj, atemp, f - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0, big = 1.0D+20 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) + INTEGER ( KIND = ip_ ) :: ispecs, iprint, isumm, ns, l_j, status + INTEGER ( KIND = ip_ ) :: m, n, ne, nb, nncon, nnjac, nnobj, iobj + INTEGER ( KIND = ip_ ) :: inform, mincor, nlc + INTEGER ( KIND = ip_ ) :: i, ii, j, k, jslack, njac, ninf, neq + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: NAME1( 1 ), NAME2( 1 ) + REAL ( KIND = rp_ ) :: objadd, sinf, obj, atemp, f + REAL ( KIND = rp_ ), PARAMETER :: big = 1.0E+20_rp_ + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) CHARACTER ( LEN = 8 ) :: start, NAMES( 5 ) CHARACTER ( LEN = 10 ) :: pname INTEGER * 4, ALLOCATABLE, DIMENSION( : ) :: HA, HS - INTEGER, ALLOCATABLE, DIMENSION( : ) :: KA - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: AA, Y, C, RC + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: KA + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: AA, Y, C, RC LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAME CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: CNAME C MINOS common block - INTEGER :: ncom, nden, nlag, nmajor, nminor - DOUBLE PRECISION :: penpar, rowtol + INTEGER ( KIND = ip_ ) :: ncom, nden, nlag, nmajor, nminor + REAL ( KIND = rp_ ) :: penpar, rowtol COMMON /M8AL1 / penpar, rowtol, ncom, nden, nlag, nmajor, nminor C Sparse Jacobian common block - INTEGER :: jstrt, indv, indf + INTEGER ( KIND = ip_ ) :: jstrt, indv, indf COMMON / SPJAC / CWK, ICWK, jstrt, indv, indf SAVE / SPJAC / @@ -60,7 +67,7 @@ PROGRAM MINOS_main C compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C allocate space @@ -93,7 +100,7 @@ PROGRAM MINOS_main C input problem data using csetup - CALL CUTEST_csetup( status, input, out, io_buffer, n, m, + CALL CUTEST_csetup_r( status, input, out, io_buffer, n, m, * X, BL, BU, Y, BL( n + 1 ), BU( n + 1 ), * EQUATN, LINEAR, 0, 1, 1 ) CLOSE( input ) @@ -101,7 +108,7 @@ PROGRAM MINOS_main C compute the numbers of nonlinear variables, and linear/equatity constraints - CALL CUTEST_cstats( status, nnobj, nnjac, neq, nlc ) + CALL CUTEST_cstats_r( status, nnobj, nnjac, neq, nlc ) IF ( status /= 0 ) GO TO 910 C Ensure there is sufficient room in CWK @@ -114,9 +121,9 @@ PROGRAM MINOS_main ! compute the objective and constraints at X = 0 DO 90 i = 1, n - CWK( i ) = zero + CWK( i ) = 0.0_rp_ 90 CONTINUE - CALL CUTEST_cfn( status, n, m, CWK, f, C ) + CALL CUTEST_cfn_r( status, n, m, CWK, f, C ) IF ( status /= 0 ) GO TO 910 C Determine the number of nonlinear constraints @@ -127,8 +134,8 @@ PROGRAM MINOS_main DO 100 i = 1, m IF ( EQUATN( i ) ) THEN - BL( n + i ) = zero - BU( n + i ) = zero + BL( n + i ) = 0.0_rp_ + BU( n + i ) = 0.0_rp_ ELSE atemp = - BU( n + i ) BU( n + i ) = - BL( n + i ) @@ -142,8 +149,8 @@ PROGRAM MINOS_main m = m + 1 BL( n + m ) = - big BU( n + m ) = big - C( m ) = zero - X( n + m ) = zero + C( m ) = 0.0_rp_ + X( n + m ) = 0.0_rp_ IF ( nnobj .LT. n ) THEN iobj = m ELSE @@ -166,7 +173,7 @@ PROGRAM MINOS_main C find the entries in the dense Jacobian - CALL CUTEST_cgr( status, n, m, X, Y, .FALSE., + CALL CUTEST_cgr_r( status, n, m, X, Y, .FALSE., * CWK, .FALSE., m, n, AA ) IF ( status /= 0 ) GO TO 910 @@ -193,7 +200,7 @@ PROGRAM MINOS_main C compute the number of nonzeros in the Jacobian - CALL CUTEST_cdimsj( status, ne ) + CALL CUTEST_cdimsj_r( status, ne ) IF ( status /= 0 ) GO TO 910 C Partition the integer sparse work vector ICWK @@ -227,7 +234,7 @@ PROGRAM MINOS_main C Use CSGR to find entries in sparse Jacobian. Since CSGR and MINOS use C different sparse formats, store Jacobian temporarily in CWK and ICWK. - CALL CUTEST_csgr( status, n, m, X, Y, .FALSE., ne, l_j, + CALL CUTEST_csgr_r( status, n, m, X, Y, .FALSE., ne, l_j, * CWK, ICWK( indv + 1 ), ICWK( indf + 1 ) ) IF ( status /= 0 ) GO TO 910 k = ne @@ -324,7 +331,7 @@ PROGRAM MINOS_main C If possible, set slack variables to be nonbasic at zero. - X( jslack ) = MAX( zero, BL( jslack ) ) + X( jslack ) = MAX( 0.0_rp_, BL( jslack ) ) X( jslack ) = MIN( X( jslack ), BU( jslack ) ) 400 CONTINUE @@ -332,12 +339,12 @@ PROGRAM MINOS_main C objective function is completely linear. (If the objective function has C nonlinear part, constants are added in COFG, which is called by FUNOBJ.) - objadd = zero + objadd = 0.0_rp_ IF ( nnobj .EQ. 0 ) objadd = objadd - f C determine the names for problem quantities - CALL CUTEST_cnames( status, n, m, pname, VNAME, CNAME ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAME, CNAME ) IF ( status /= 0 ) GO TO 910 C Assign names to problem, constraints, and objective function. @@ -351,7 +358,7 @@ PROGRAM MINOS_main nb = n + m DO 410 I = 1, nb HS( i ) = 0 - RC( i ) = zero + RC( i ) = 0.0_rp_ 410 CONTINUE C Call MINOS as a subroutine @@ -361,7 +368,7 @@ PROGRAM MINOS_main * iobj, objadd, NAMES, AA, HA, KA, BL, BU, * NAME1, NAME2, HS, X, Y, RC, inform, mincor, * ns, ninf, sinf, obj, Z, nwcore ) - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 C Try to handle abnormal MINOS inform codes gracefully @@ -401,7 +408,7 @@ PROGRAM MINOS_main CLOSE( iprint ) DEALLOCATE( HS, KA, X, BL, BU, Y, C, RC, EQUATN, * LINEAR, VNAME, CNAME, HA, AA, STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -458,20 +465,21 @@ PROGRAM MINOS_main END SUBROUTINE FUNOBJ( mode, n, X, f, G, nstate, nprob, Z, nwcore ) - INTEGER :: mode, n, nstate, nprob, nwcore - DOUBLE PRECISION :: f - DOUBLE PRECISION :: X( n ), G( n ), Z( nwcore ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: mode, n, nstate, nprob, nwcore + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ) :: X( n ), G( n ), Z( nwcore ) C Local variables - INTEGER :: status + INTEGER ( KIND = ip_ ) :: status LOGICAL :: grad IF ( mode .EQ. 0 ) THEN grad = .FALSE. ELSE grad = .TRUE. END IF - CALL CUTEST_cofg( status, n, X, f, G, grad ) + CALL CUTEST_cofg_r( status, n, X, f, G, grad ) IF ( status .NE. 0 ) THEN WRITE( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") * status @@ -482,29 +490,31 @@ SUBROUTINE FUNOBJ( mode, n, X, f, G, nstate, nprob, Z, nwcore ) SUBROUTINE FUNCON( mode, m, n, njac, X, C, JAC, nstate, nprob, * Z, nwcore ) - INTEGER :: mode, m, n, njac, nstate, nprob, nwcore - DOUBLE PRECISION :: X( n ), C( m ), JAC( njac ), Z( nwcore ) - INTEGER :: ncom, nden, nlag, nmajor, nminor - DOUBLE PRECISION :: penpar, rowtol + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: mode, m, n, njac, nstate, nprob, nwcore + REAL ( KIND = rp_ ) :: X( n ), C( m ), JAC( njac ), Z( nwcore ) + INTEGER ( KIND = ip_ ) :: ncom, nden, nlag, nmajor, nminor + REAL ( KIND = rp_ ) :: penpar, rowtol COMMON / M8AL1 / penpar, rowtol, ncom, nden, nlag, nmajor, nminor C Sparse Jacobian common block C ----- these may need to be altered - see also MINOS_main above ------ - INTEGER, PARAMETER :: n_guess = 100000 - INTEGER, PARAMETER :: ne_guess = 1000000 - INTEGER, PARAMETER :: licwk = 2 * ne_guess + n_guess + 1 - INTEGER, PARAMETER :: lcwk = ne_guess + n_guess - INTEGER :: ICWK( licwk ) - DOUBLE PRECISION :: CWK( lcwk ) + INTEGER ( KIND = ip_ ), PARAMETER :: n_guess = 100000 + INTEGER ( KIND = ip_ ), PARAMETER :: ne_guess = 1000000 + INTEGER ( KIND = ip_ ), PARAMETER :: + * licwk = 2 * ne_guess + n_guess + 1 + INTEGER ( KIND = ip_ ), PARAMETER :: lcwk = ne_guess + n_guess + INTEGER ( KIND = ip_ ) :: ICWK( licwk ) + REAL ( KIND = rp_ ) :: CWK( lcwk ) C --------------------------------------------------------------------- - INTEGER :: jstrt, indv, indf + INTEGER ( KIND = ip_ ) :: jstrt, indv, indf COMMON / SPJAC / CWK, ICWK, jstrt, indv, indf SAVE / SPJAC / C Local variables - INTEGER :: i, j, k, nnzj, status + INTEGER ( KIND = ip_ ) :: i, j, k, nnzj, status LOGICAL :: grad IF ( mode .EQ. 0 ) THEN @@ -516,13 +526,14 @@ SUBROUTINE FUNCON( mode, m, n, njac, X, C, JAC, nstate, nprob, C Jacobian is stored in dense format IF ( nden .EQ. 1 ) THEN - CALL CUTEST_ccfg( status, n, m, X, C, .FALSE., m, n, JAC, grad ) + CALL CUTEST_ccfg_r( status, n, m, X, C, .FALSE., m, n, + * JAC, grad ) IF ( status .NE. 0 ) GO TO 910 C Jacobian is stored in sparse format ELSE - CALL CUTEST_ccfsg( status, n, m, X, C, nnzj, njac, CWK, + CALL CUTEST_ccfsg_r( status, n, m, X, C, nnzj, njac, CWK, * ICWK( indv + 1 ), ICWK( indf + 1 ), grad ) IF ( status .NE. 0 ) GO TO 910 @@ -556,13 +567,15 @@ SUBROUTINE FUNCON( mode, m, n, njac, X, C, JAC, nstate, nprob, SUBROUTINE MATMOD( NCYCLE, NPROB, FINISH, M, N, NB, NE, NKA, NS, * NSCL, A, HA, KA, BL, BU, ASCALE, HS, ID1, ID2, * X, PI, Z, NWCORE ) - INTEGER :: ncycle, nprob, m, n, nb, ne, nka, ns, nscl, nwcore - INTEGER :: HA( ne ), HS( nb ) - INTEGER :: KA( nka ), ID1( nb ), ID2( nb ) - DOUBLE PRECISION :: A( ne ), ASCALE( nscl ), BL( nb ), BU( nb ), - * X( nb ), PI( m ), Z( nwcore ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: ncycle, nprob, m, n, nb, ne, nka + INTEGER ( KIND = ip_ ) :: ns, nscl, nwcore + INTEGER ( KIND = ip_ ) :: HA( ne ), HS( nb ) + INTEGER ( KIND = ip_ ) :: KA( nka ), ID1( nb ), ID2( nb ) + REAL ( KIND = rp_ ) :: A( ne ), ASCALE( nscl ), BL( nb ), BU( nb ) + REAL ( KIND = rp_ ) :: X( nb ), PI( m ), Z( nwcore ) LOGICAL :: finish - INTEGER :: iread, iprint, isumm + INTEGER ( KIND = ip_ ) :: iread, iprint, isumm COMMON / M1FILE / iread, iprint, isumm IF ( iprint .GT. 0 ) WRITE( iprint, 2000 ) IF ( isumm .GT. 0 ) WRITE( isumm, 2000 ) diff --git a/src/minos/minos_test.F b/src/minos/minos_test.F new file mode 100644 index 0000000..1e74236 --- /dev/null +++ b/src/minos/minos_test.F @@ -0,0 +1,55 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy MINOSS for testing minos_main interface to CUTEst + +C Nick Gould, 14th January 2013 + + subroutine minoss( start, m, n, nb, ne, nname, + $ nncon, nnobj, nnjac, + $ iobj, objadd, names, + $ a, ha, ka, bl, bu, name1, name2, + $ hs, xn, pi, rc, + $ inform, mincor, ns, ninf, sinf, obj, + $ z, nwcore ) + use CUTEST_KINDS_precision +C implicit real ( kind = rp_ ) (a-h,o-z) + integer ( kind = ip_ ) nwcore, nprob, nstate + integer ( kind = ip_ ) m, n, nb, ne, nname, nncon, nnobj, nnjac + integer ( kind = ip_ ) iobj, inform, mincor, ns, ninf + character*8 start + character*8 names(5) + integer*4 ha(ne), hs(nb) + integer ( kind = ip_ ) ka(n+1), name1(nname), name2(nname) + real ( kind = rp_ ) objadd, sinf, obj + real ( kind = rp_ ) a(ne), bl(nb), bu(nb) + real ( kind = rp_ ) xn(nb), pi(m), rc(nb), z(nwcore) + integer ( kind = ip_ ) mode + mode = 1 + call funobj( mode, n, xn, obj, Z, nstate, nprob, Z, nwcore ) + call funcon( mode, m, n, ne, xn, Z, a, nstate, nprob, + * Z, nwcore ) + return + end + + subroutine m1open( lun, index, state ) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) lun, index + character*3 state + integer ( kind = ip_ ) ncom, nden, nlag, nmajor, nminor + real ( kind = rp_ ) penpar, rowtol + common / m8al1 / penpar, rowtol, ncom, nden, nlag, nmajor, nminor +C dense derivatives +C nden = 1 +C sparse derivatives + nden = 0 + return + end + + subroutine mispec( ispecx, iprinx, isummx, nwcore, inform ) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) ispecx, iprinx, isummx, nwcore, inform + inform = 0 + return + end diff --git a/src/minos/minos_test.f b/src/minos/minos_test.f deleted file mode 100644 index aecc47f..0000000 --- a/src/minos/minos_test.f +++ /dev/null @@ -1,49 +0,0 @@ -C ( Last modified on 14 Jan 2013 at 10:00:00 ) - -C Dummy MINOSS for testing minos_main interface to CUTEst -C Nick Gould, 14th January 2013 - - subroutine minoss( start, m, n, nb, ne, nname, - $ nncon, nnobj, nnjac, - $ iobj, objadd, names, - $ a, ha, ka, bl, bu, name1, name2, - $ hs, xn, pi, rc, - $ inform, mincor, ns, ninf, sinf, obj, - $ z, nwcore ) -C implicit double precision (a-h,o-z) - integer nwcore, nprob, nstate - integer m, n, nb, ne, nname, nncon, nnobj, nnjac - integer iobj, inform, mincor, ns, ninf - character*8 start - character*8 names(5) - integer*4 ha(ne), hs(nb) - integer ka(n+1), name1(nname), name2(nname) - double precision objadd, sinf, obj - double precision a(ne), bl(nb), bu(nb) - double precision xn(nb), pi(m), rc(nb), z(nwcore) - integer mode - mode = 1 - call funobj( mode, n, xn, obj, Z, nstate, nprob, Z, nwcore ) - call funcon( mode, m, n, ne, xn, Z, a, nstate, nprob, - * Z, nwcore ) - return - end - - subroutine m1open( lun, index, state ) - integer lun, index - character*3 state - integer ncom, nden, nlag, nmajor, nminor - double precision penpar, rowtol - common / m8al1 / penpar, rowtol, ncom, nden, nlag, nmajor, nminor -C dense derivatives -C nden = 1 -C sparse derivatives - nden = 0 - return - end - - subroutine mispec( ispecx, iprinx, isummx, nwcore, inform ) - integer ispecx, iprinx, isummx, nwcore, inform - inform = 0 - return - end diff --git a/src/newuoa/makemaster b/src/newuoa/makemaster index 60122c7..63695af 100644 --- a/src/newuoa/makemaster +++ b/src/newuoa/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst NEWUOA interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 27 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = NEWUOA -package = newuoa - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = NEWUOA +package = newuoa -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/newuoa/newuoa_main.f90 b/src/newuoa/newuoa_main.F90 similarity index 75% rename from src/newuoa/newuoa_main.f90 rename to src/newuoa/newuoa_main.F90 index 2d69474..640e4c7 100644 --- a/src/newuoa/newuoa_main.f90 +++ b/src/newuoa/newuoa_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 27 Jan 2013 at 17:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 13:20 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM NEWUOA_main @@ -6,18 +9,18 @@ PROGRAM NEWUOA_main ! Nick Gould, January 2013 - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER :: maxfun, lw, status, iprint, i, ierr, npt - REAL( KIND = wp ) :: rhobeg, rhoend - REAL( KIND = wp ), PARAMETER :: infty = 1.0D+19 - REAL( KIND = wp ), DIMENSION( : ), ALLOCATABLE :: W - REAL( KIND = wp ), DIMENSION( 4 ) :: CPU - REAL( KIND = wp ), DIMENSION( 4 ) :: CALLS + INTEGER ( KIND = ip_ ) :: maxfun, lw, status, iprint, i, ierr, npt + REAL ( KIND = rp_ ) :: rhobeg, rhoend + REAL ( KIND = rp_ ), PARAMETER :: infty = REAL( 1.0D+19, KIND = rp_ ) + REAL ( KIND = rp_ ), DIMENSION( : ), ALLOCATABLE :: W + REAL ( KIND = rp_ ), DIMENSION( 4 ) :: CPU + REAL ( KIND = rp_ ), DIMENSION( 4 ) :: CALLS INTEGER :: io_buffer = 11 - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46, out = 6 ! open the relevant file @@ -34,12 +37,12 @@ PROGRAM NEWUOA_main CUTEST_problem_global%allocate_J = .FALSE. - CALL CUTEST_problem_setup( status, CUTEST_problem_global, input ) + CALL CUTEST_problem_setup_r( status, CUTEST_problem_global, input ) IF ( status /= 0 ) GO TO 910 ! set up the data structures necessary to hold the problem functions. - CALL CUTEST_usetup( status, input, out, io_buffer, & + CALL CUTEST_usetup_r( status, input, out, io_buffer, & CUTEST_problem_global%n, CUTEST_problem_global%x, & CUTEST_problem_global%x_l, CUTEST_problem_global%x_u ) IF ( status /= 0 ) GO TO 910 @@ -84,12 +87,12 @@ PROGRAM NEWUOA_main ! output report - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_unames( status, CUTEST_problem_global%n, & - CUTEST_problem_global%pname, & - CUTEST_problem_global%vnames ) + CALL CUTEST_unames_r( status, CUTEST_problem_global%n, & + CUTEST_problem_global%pname, & + CUTEST_problem_global%vnames ) WRITE( out, 2110 ) ( i, CUTEST_problem_global%vnames( i ), & CUTEST_problem_global%x( i ), CUTEST_problem_global%x_l( i ), & CUTEST_problem_global%x_u( i ), i = 1, CUTEST_problem_global%n ) @@ -98,10 +101,10 @@ PROGRAM NEWUOA_main ! clean-up data structures - CALL CUTEST_problem_terminate( status, CUTEST_problem_global ) + CALL CUTEST_problem_terminate_r( status, CUTEST_problem_global ) IF ( status /= 0 ) GO TO 910 DEALLOCATE( W, STAT = ierr ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP ! error returns @@ -139,19 +142,19 @@ SUBROUTINE CALFUN( n, X, f ) ! evaluates the objective function value in a format compatible with NEWUOA, ! but using the CUTEst tools. - USE CUTEst_problem + USE CUTEST_KINDS_precision + USE CUTEST_PROBLEM_precision - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, INTENT( IN ) :: n - REAL( KIND = wp ), INTENT( OUT ) :: f - REAL( KIND = wp ), INTENT( IN ) :: X( n ) + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n + REAL( KIND = rp_ ), INTENT( OUT ) :: f + REAL( KIND = rp_ ), INTENT( IN ) :: X( n ) - INTEGER :: status + INTEGER ( KIND = ip_ ) :: status ! Evaluate the objective function and constraints. - CALL CUTEST_ufn( status, CUTEST_problem_global%n, & - X, CUTEST_problem_global%f ) + CALL CUTEST_ufn_r( status, CUTEST_problem_global%n, & + X, CUTEST_problem_global%f ) IF ( status /= 0 ) GO TO 910 f = CUTEST_problem_global%f RETURN diff --git a/src/newuoa/newuoa_test.F90 b/src/newuoa/newuoa_test.F90 new file mode 100644 index 0000000..eed3aaf --- /dev/null +++ b/src/newuoa/newuoa_test.F90 @@ -0,0 +1,21 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 13:25 GMT. + +#include "cutest_modules.h" + +! Dummy NEWUOA for testing newuoa_main interface to CUTEst +! Nick Gould, 29th January 2013 + + SUBROUTINE NEWUOA( n, npt, X, rhobeg, rhoend, iprint, maxfun, W ) + USE CUTEST_KINDS_precision + +! dummy arguments + + INTEGER ( KIND = ip_ ) :: n, npt, iprint, maxfun + REAL( KIND = rp_ ) :: rhobeg, rhoend + REAL( KIND = rp_ ) :: X( * ), W( * ) + + REAL( KIND = rp_ ) :: f + CALL CALFUN( n, X, f ) + + RETURN + END diff --git a/src/newuoa/newuoa_test.f90 b/src/newuoa/newuoa_test.f90 deleted file mode 100644 index 40aae9d..0000000 --- a/src/newuoa/newuoa_test.f90 +++ /dev/null @@ -1,19 +0,0 @@ -! ( Last modified on 29 Jan 2013 at 14:15:00 ) - -! Dummy NEWUOA for testing newuoa_main interface to CUTEst -! Nick Gould, 29th January 2013 - - SUBROUTINE NEWUOA( n, npt, X, rhobeg, rhoend, iprint, maxfun, W ) - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - -! dummy arguments - - INTEGER :: n, npt, iprint, maxfun - REAL( KIND = wp ) :: rhobeg, rhoend - REAL( KIND = wp ) :: X( * ), W( * ) - - REAL( KIND = wp ) :: f - CALL CALFUN( n, X, f ) - - RETURN - END diff --git a/src/nitsol/makemaster b/src/nitsol/makemaster index 975fbb1..a6fee6b 100644 --- a/src/nitsol/makemaster +++ b/src/nitsol/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst NITSOL interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 7 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = NITSOL -package = nitsol - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = NITSOL +package = nitsol -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/nitsol/nitsol_main.f b/src/nitsol/nitsol_main.F similarity index 80% rename from src/nitsol/nitsol_main.f rename to src/nitsol/nitsol_main.F index b43b0e5..17d2d73 100644 --- a/src/nitsol/nitsol_main.f +++ b/src/nitsol/nitsol_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 6 Jan 2013 at 16:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM NITSOL_main @@ -14,22 +17,24 @@ PROGRAM NITSOL_main C C ------------------------------------------------------ - INTEGER :: lipar, lrpar, nwork, i, nn, mm, m, n, iterm, status - INTEGER :: nfree, nnimax, ijacv, ikrysl, kdmax, irpre - INTEGER :: iksmax, iresup, ifdord, ibtmax, ieta, ipsol - INTEGER, PARAMETER :: input = 55, out = 6, inspec = 46 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: NINPUT( 10 ), INFO( 6 ) - DOUBLE PRECISION ftol, stptol, final, f - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0 - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) + USE CUTEST_KINDS_precision + + INTEGER ( KIND = ip_ ) :: lipar, lrpar, nwork, i, nn, mm, m, n + INTEGER ( KIND = ip_ ) :: iterm, status, irpre, ipsol + INTEGER ( KIND = ip_ ) :: nfree, nnimax, ijacv, ikrysl, kdmax + INTEGER ( KIND = ip_ ) :: iksmax, iresup, ifdord, ibtmax, ieta + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, inspec = 46 + INTEGER ( KIND = ip_ ) :: NINPUT( 10 ), INFO( 6 ) + REAL ( KIND = rp_ ) ftol, stptol, final, f + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) CHARACTER ( LEN = 10 ) :: pname LOGICAL :: bound, inequality - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IPAR - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, WORK - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: RPAR, XFREE - DOUBLE PRECISION NITSOL_dot, NITSOL_norm2 + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IPAR + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, WORK + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: RPAR, XFREE + REAL ( KIND = rp_ ) NITSOL_dot, NITSOL_norm2 CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAME CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: CNAME LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR @@ -45,7 +50,7 @@ PROGRAM NITSOL_main C NITSOL info common block (see nitprint.h) INTEGER INSTEP, NEWSTEP, KRYSTAT - DOUBLE PRECISION AVRATE, FCURNRM, ETA + REAL ( KIND = rp_ ) AVRATE, FCURNRM, ETA COMMON / NITINFO / AVRATE, FCURNRM, ETA, INSTEP, NEWSTEP, KRYSTAT C common block to tell when to evluate Jacobian again @@ -121,7 +126,7 @@ PROGRAM NITSOL_main C determine the number of variables and constraints - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C allocate space @@ -146,7 +151,7 @@ PROGRAM NITSOL_main nn = n mm = m - CALL CUTEST_csetup( status, INPUT, out, io_buffer, n, m, + CALL CUTEST_csetup_r( status, INPUT, out, io_buffer, n, m, * X, WORK( 1 ), WORK( nn + 1 ), * WORK( 2 * nn + 2 * mm + 1 ), WORK( 2 * nn + 1 ), * WORK( 2 * nn + mm + 1 ), EQUATN, LINEAR, 0, 0, 0 ) @@ -154,7 +159,7 @@ PROGRAM NITSOL_main C determine the names of the problem, variables and constraints - CALL CUTEST_cnames( status, N, M, PNAME, VNAME, CNAME ) + CALL CUTEST_cnames_r( status, N, M, PNAME, VNAME, CNAME ) IF ( status /= 0 ) GO TO 910 C check that there are no variable bounds @@ -222,7 +227,7 @@ PROGRAM NITSOL_main ELSE X( i ) = WORK( i ) RPAR( i ) = X( i ) - RPAR( n + i ) = zero + RPAR( n + i ) = 0.0_rp_ END IF 30 CONTINUE CALL NITSOL( nfree, XFREE, NITSOL_evalfn, NITSOL_evaljn, FTOL, @@ -235,9 +240,9 @@ PROGRAM NITSOL_main C write results - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_cfn( status, n, m, X, F, WORK ) + CALL CUTEST_cfn_r( status, n, m, X, F, WORK ) IF ( status /= 0 ) GO TO 910 final = NITSOL_norm2( M, WORK, 1 ) @@ -293,14 +298,15 @@ PROGRAM NITSOL_main C function and Jacobian-vector product evaluation subroutines SUBROUTINE NITSOL_evalf( n, X, C, RPAR, IPAR, ITRMF ) - INTEGER N, ITRMF - INTEGER IPAR( * ) - DOUBLE PRECISION f, X( n ), C( n ), RPAR( * ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, ITRMF + INTEGER ( KIND = ip_ ) IPAR( * ) + REAL ( KIND = rp_ ) f, X( n ), C( n ), RPAR( * ) LOGICAL jknown COMMON / NITJEV / jknown - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_cfn( status, n, n, X, f, C ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_cfn_r( status, n, n, X, f, C ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status @@ -312,15 +318,16 @@ SUBROUTINE NITSOL_evalf( n, X, C, RPAR, IPAR, ITRMF ) END SUBROUTINE NITSOL_evalj( n, X, C, ijob, V, Z, RPAR, IPAR, itrmjv ) - INTEGER n, ijob, itrmjv - INTEGER IPAR( * ) - DOUBLE PRECISION X( N ), C( N ), V( N ), Z( N ), RPAR( * ) + USE CUTEST_KINDS_precision + INTEGER :: n, ijob, itrmjv + INTEGER :: IPAR( * ) + REAL ( KIND = rp_ ) X( n ), C( n ), V( n ), Z( n ), RPAR( * ) LOGICAL jknown COMMON / NITJEV / jknown - INTEGER :: status - INTEGER, PARAMETER :: out = 6 + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 IF ( ijob .EQ. 0 ) THEN - CALL CUTEST_cjprod( status, N, N, JKNOWN, .FALSE., + CALL CUTEST_cjprod_r( status, N, N, JKNOWN, .FALSE., * X, V, n, Z, n ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping')") @@ -336,19 +343,20 @@ SUBROUTINE NITSOL_evalj( n, X, C, ijob, V, Z, RPAR, IPAR, itrmjv ) END SUBROUTINE NITSOL_evalfn( nfree, XFREE, C, RPAR, IPAR, itrmf ) - INTEGER nfree, itrmf - INTEGER IPAR( * ) - DOUBLE PRECISION f, XFREE( nfree ), C( nfree ), RPAR( * ) - INTEGER n, m, i, status + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: nfree, itrmf + INTEGER ( KIND = ip_ ) :: IPAR( * ) + REAL ( KIND = rp_ ) f, XFREE( nfree ), C( nfree ), RPAR( * ) + INTEGER ( KIND = ip_ ) :: n, m, i, status LOGICAL jknown COMMON / NITJEV / jknown - INTEGER, PARAMETER :: out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 n = IPAR( 1 ) m = IPAR( 2 ) DO 10 i = 1, nfree RPAR( IPAR( i + 2 ) ) = XFREE( i ) 10 CONTINUE - CALL CUTEST_cfn( status, n, m, RPAR( 1 ), f, C ) + CALL CUTEST_cfn_r( status, n, m, RPAR( 1 ), f, C ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping')") * status @@ -361,12 +369,13 @@ SUBROUTINE NITSOL_evalfn( nfree, XFREE, C, RPAR, IPAR, itrmf ) SUBROUTINE NITSOL_evaljn( nfree, XFREE, C, ijob, VFREE, Z, RPAR, * IPAR, itrmjv ) - INTEGER nfree, ijob, itrmjv - INTEGER IPAR( * ) - DOUBLE PRECISION XFREE( nfree ), C( nfree ), VFREE( nfree ), + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: nfree, ijob, itrmjv + INTEGER ( KIND = ip_ ) :: IPAR( * ) + REAL ( KIND = rp_ ) XFREE( nfree ), C( nfree ), VFREE( nfree ), * Z( nfree ), RPAR( * ) - INTEGER i, n, m, status - INTEGER, PARAMETER :: out = 6 + INTEGER ( KIND = ip_ ) i, n, m, status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 LOGICAL jknown COMMON / NITJEV / jknown IF ( ijob .EQ. 0 ) THEN @@ -376,7 +385,7 @@ SUBROUTINE NITSOL_evaljn( nfree, XFREE, C, ijob, VFREE, Z, RPAR, RPAR( IPAR( i + 2 ) ) = XFREE( i ) RPAR( n + IPAR( i + 2 ) ) = VFREE( i ) 10 CONTINUE - CALL CUTEST_cjprod( status, n, m, jknown, .FALSE., RPAR( 1 ), + CALL CUTEST_cjprod_r( status, n, m, jknown, .FALSE., RPAR( 1 ), * RPAR( n + 1 ), n, Z, m ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping')") diff --git a/src/nitsol/nitsol_test.F b/src/nitsol/nitsol_test.F new file mode 100644 index 0000000..b03e8f9 --- /dev/null +++ b/src/nitsol/nitsol_test.F @@ -0,0 +1,53 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy NITSOL for testing nitsol_main interface to CUTEst + +C Nick Gould, 7th January 2013 + + SUBROUTINE NITSOL( n, X, evalf, evalj, ftol, stptol, + * INPUT, INFO, RWORK, RPAR, IPAR, iterm, dinpr, dnorm ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n, INPUT( 10 ), INFO( 6 ), IPAR( * ), iterm + REAL ( KIND = rp_ ) X( n ), ftol, stptol, RWORK( * ), RPAR( * ) + REAL ( KIND = rp_ ) C( n ), V( n ), Z( n ) + REAL ( KIND = rp_ ) dinpr, dnorm + EXTERNAL evalf, evalj, dinpr, dnorm + INTEGER ( KIND = ip_ ) :: ijob, itrmf, itrmjv, i + CALL evalf( n, X, C, RPAR, IPAR, itrmf ) + ijob = 0 + DO 10 i = 1, n + V( i ) = 1.0_rp_ + 10 CONTINUE + CALL evalj( n, X, C, ijob, V, Z, RPAR, IPAR, itrmjv ) + iterm = 1 + INFO( 1 ) = 1 + INFO( 2 ) = 1 + INFO( 3 ) = 0 + INFO( 4 ) = 1 + INFO( 5 ) = 1 + INFO( 6 ) = 0 + RETURN + END + + REAL ( KIND = rp_ ) FUNCTION NITSOL_dot( n, X, incx, Y, incy ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: incx, incy, n + REAL ( KIND = rp_ ) X( * ), Y( * ) + INTEGER ( KIND = ip_ ) :: i + NITSOL_dot = 0.0_rp_ + DO 10 i = 1, n + NITSOL_dot = NITSOL_dot + X( i ) * Y( i ) + 10 CONTINUE + RETURN + END + + REAL ( KIND = rp_ ) FUNCTION NITSOL_norm2( n, X, incx ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: incx, n + REAL ( KIND = rp_ ) X( * ) + REAL ( KIND = rp_ ) NITSOL_dot + NITSOL_norm2 = SQRT( NITSOL_dot( n, X, incx, X, incx ) ) + RETURN + END diff --git a/src/nitsol/nitsol_test.f b/src/nitsol/nitsol_test.f deleted file mode 100644 index 46c5c77..0000000 --- a/src/nitsol/nitsol_test.f +++ /dev/null @@ -1,47 +0,0 @@ -C ( Last modified on 7 Jan 2013 at 07:25:00 ) - -C Dummy NITSOL for testing nitsol_main interface to CUTEst -C Nick Gould, 7th January 2013 - - SUBROUTINE NITSOL( n, X, evalf, evalj, ftol, stptol, - * INPUT, INFO, RWORK, RPAR, IPAR, iterm, dinpr, dnorm ) - integer n, INPUT( 10 ), INFO( 6 ), IPAR( * ), iterm - DOUBLE PRECISION X( n ), ftol, stptol, RWORK( * ), RPAR( * ) - DOUBLE PRECISION C( n ), V( n ), Z( n ) - DOUBLE PRECISION dinpr, dnorm - EXTERNAL evalf, evalj, dinpr, dnorm - INTEGER :: ijob, itrmf, itrmjv, i - CALL evalf( n, X, C, RPAR, IPAR, itrmf ) - ijob = 0 - DO 10 i = 1, n - V( i ) = 1.0D+0 - 10 CONTINUE - CALL evalj( n, X, C, ijob, V, Z, RPAR, IPAR, itrmjv ) - iterm = 1 - INFO( 1 ) = 1 - INFO( 2 ) = 1 - INFO( 3 ) = 0 - INFO( 4 ) = 1 - INFO( 5 ) = 1 - INFO( 6 ) = 0 - RETURN - END - - DOUBLE PRECISION FUNCTION NITSOL_dot( n, X, incx, Y, incy ) - INTEGER incx, incy, n - DOUBLE PRECISION X( * ), Y( * ) - INTEGER :: i - NITSOL_dot = 0.0D+0 - DO 10 i = 1, n - NITSOL_dot = NITSOL_dot + X( i ) * Y( i ) - 10 CONTINUE - RETURN - END - - DOUBLE PRECISION FUNCTION NITSOL_norm2( n, X, incx ) - INTEGER incx, n - DOUBLE PRECISION X( * ) - DOUBLE PRECISION NITSOL_dot - NITSOL_norm2 = SQRT( NITSOL_dot( n, X, incx, X, incx ) ) - RETURN - END diff --git a/src/nlpqlp/makemaster b/src/nlpqlp/makemaster index 01acf55..e628e96 100644 --- a/src/nlpqlp/makemaster +++ b/src/nlpqlp/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst NLPQLP interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 22 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = NLPQLP -package = nlpqlp - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = NLPQLP +package = nlpqlp -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/nlpqlp/nlpqlp_main.f b/src/nlpqlp/nlpqlp_main.F similarity index 82% rename from src/nlpqlp/nlpqlp_main.f rename to src/nlpqlp/nlpqlp_main.F index 6010684..f417407 100644 --- a/src/nlpqlp/nlpqlp_main.f +++ b/src/nlpqlp/nlpqlp_main.F @@ -1,7 +1,12 @@ -C ( Last modified on 22 Feb 2013 at 10:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM NLPQLP_main - implicit none + + USE CUTEST_KINDS_precision + IMPLICIT NONE C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C @@ -13,23 +18,23 @@ PROGRAM NLPQLP_main C Set up parameters, variables and arrays required by constrained tools - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: la1, n1, lj1, lu, l_par, alloc_stat, status - INTEGER :: n, m_e, m, i, k, l, maxit, maxfun, iprint, maxnm - INTEGER :: lwa, lkwa, lactiv, mode, ifail, m_total - DOUBLE PRECISION :: acc, accqp, stpmin, rho + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, out = 6 + INTEGER ( KIND = ip_ ) :: la1, n1, lj1, lu, l_par, alloc_stat + INTEGER ( KIND = ip_ ) :: status, iprint, maxnm + INTEGER ( KIND = ip_ ) :: n, m_e, m, i, k, l, maxit, maxfun + INTEGER ( KIND = ip_ ) :: lwa, lkwa, lactiv, mode, ifail, m_total + REAL ( KIND = rp_ ) :: acc, accqp, stpmin, rho LOGICAL :: lql - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0, half = 5.0D-1 - DOUBLE PRECISION, PARAMETER :: infinity = 1.0D+19 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ), PARAMETER :: infinity = 1.0E+19_rp_ + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) CHARACTER * 10 :: pname - INTEGER, ALLOCATABLE, DIMENSION( : ) :: KWA - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X_l, X_u, F - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: C_l, C_u, Y - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: U, G, D, WA - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : , : ) :: A, H, C, X - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : , : ) :: J_val, CON + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: KWA + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X_l, X_u, F + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: C_l, C_u, Y + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: U, G, D, WA + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , : ) :: A, H, C, X + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , : ) :: J_val, CON LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR, ACTIVE CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: X_names EXTERNAL :: QL @@ -68,7 +73,7 @@ PROGRAM NLPQLP_main C Determine the number of variables and constraints - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C Set workspace dimensions @@ -87,7 +92,7 @@ PROGRAM NLPQLP_main C Set up the data structures necessary to hold the group partially C separable function. - CALL CUTEST_csetup( status, input, out, io_buffer, + CALL CUTEST_csetup_r( status, input, out, io_buffer, & n, m, X( : n, 1 ), X_l, X_u, & Y, C_l, C_u, EQUATN, LINEAR, 1, 0, 0 ) IF ( status /= 0 ) GO TO 910 @@ -109,7 +114,7 @@ PROGRAM NLPQLP_main C Determine the name of the problem - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) IF ( status /= 0 ) GO TO 910 C WRITE( out, "( /, ' Problem: ', A10 )" ) pname @@ -137,7 +142,7 @@ PROGRAM NLPQLP_main IF ( ifail == 0 .OR. ifail == - 1 ) THEN DO k = 1, l - CALL CUTEST_cfn( status, n, m, X( : n, k ), + CALL CUTEST_cfn_r( status, n, m, X( : n, k ), & F( k ), C( : m, k ) ) IF ( status == 3 ) THEN ifail = - 10 @@ -169,7 +174,7 @@ PROGRAM NLPQLP_main C compute the function and constraints at the point X(:,1) IF ( ifail == 0 .OR. ifail == - 2 ) THEN - CALL CUTEST_cgr( status, n, m, X( : n, 1 ), Y, .FALSE., G, + CALL CUTEST_cgr_r( status, n, m, X( : n, 1 ), Y, .FALSE., G, & .FALSE., lj1, n, J_val ) IF ( status /= 0 ) GO TO 910 @@ -207,9 +212,9 @@ PROGRAM NLPQLP_main C Output final objective function value and timing information IF ( out .GT. 0 ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( ifail == 0 ) THEN - CALL CUTEST_varnames( status, n, X_names ) + CALL CUTEST_varnames_r( status, n, X_names ) IF ( status /= 0 ) GO TO 910 WRITE( out,"(' Objective function value:', ES12.4 )" ) F( 1 ) WRITE ( out, "( /, ' Solution:', @@ -225,7 +230,7 @@ PROGRAM NLPQLP_main DEALLOCATE( X, X_l, X_u, U, F, G, A, H, WA, KWA, ACTIVE, CON, & J_val, C, C_l, C_u, Y, EQUATN, STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE diff --git a/src/nlpqlp/nlpqlp_test.F b/src/nlpqlp/nlpqlp_test.F new file mode 100644 index 0000000..fff6002 --- /dev/null +++ b/src/nlpqlp/nlpqlp_test.F @@ -0,0 +1,54 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +! Dummy NLPQLP for testing ql_main interface to CUTEst + +! Nick Gould, 22nd February 2013 + + SUBROUTINE NLPQLP ( l, m, me, mmax, n, nmax, mnn2, X, F, G, + & DF, DG, U, XL, XU, C, D, acc, accqp, stpmin, + & maxfun, maxit, maxnm, rho, iprint, mode, iout, + & ifail, WA, lwa, KWA, lkwa, ACTIVE, lactiv, + & lql, QL ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: m, me, l, n, mmax, nmax, mnn2 + INTEGER ( KIND = ip_ ) :: lwa, lkwa, lactiv, iout, ifail + INTEGER ( KIND = ip_ ) :: maxfun, maxit, maxnm, iprint, mode + REAL ( KIND = rp_ ) :: acc, accqp, stpmin, rho + LOGICAL :: lql + INTEGER ( KIND = ip_ ) :: KWA( lkwa ) + REAL ( KIND = rp_ ) :: X( NMAX, L ),F( L ), G( MMAX, L ) + REAL ( KIND = rp_ ) :: DF( NMAX ), DG( mmax, nmax ), U( mnn2 ) + REAL ( KIND = rp_ ) :: XL( n ), XU( n ) + REAL ( KIND = rp_ ) :: C( nmax, nmax ), D( nmax ), WA( lwa ) + LOGICAL ACTIVE( lactiv ) + EXTERNAL :: QL + IF ( ifail == 0 ) THEN + ifail = - 1 + ELSE IF ( ifail == - 1 ) THEN + ifail = - 2 + ELSE + KWA( 1 ) = 2 + KWA( 2 ) = 2 + KWA( 3 ) = 1 + KWA( 4 ) = 0 + ifail = 1 + END IF + RETURN + END + + SUBROUTINE QL( m, me, mmax, n, nmax, mnn, C, D, A, B, + & XL, XU, X, U, eps, mode, iout, ifail, iprint, + & WAR, lwar, IWAR, liwar ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: m, me, iout, mode, ifail, iprint + INTEGER ( KIND = ip_ ) :: nmax, mmax, n, mnn, lwar, liwar + INTEGER ( KIND = ip_ ) :: IWAR( liwar ) + REAL ( KIND = rp_ ) :: eps + REAL ( KIND = rp_ ) :: C( nmax, n ), D( n ) + REAL ( KIND = rp_ ) :: A( mmax, n ), B( mmax ), WAR( lwar ) + REAL ( KIND = rp_ ) :: XL( n ), XU( n ),X( n ), U( mnn ) + ifail = 1 + RETURN + END diff --git a/src/nlpqlp/nlpqlp_test.f b/src/nlpqlp/nlpqlp_test.f deleted file mode 100644 index cce65d5..0000000 --- a/src/nlpqlp/nlpqlp_test.f +++ /dev/null @@ -1,46 +0,0 @@ -! ( Last modified on 22 Feb 2013 at 10:00:00 ) - -! Dummy NLPQLP for testing ql_main interface to CUTEst -! Nick Gould, 22nd February 2013 - - SUBROUTINE NLPQLP ( l, m, me, mmax, n, nmax, mnn2, X, F, G, - & DF, DG, U, XL, XU, C, D, acc, accqp, stpmin, - & maxfun, maxit, maxnm, rho, iprint, mode, iout, - & ifail, WA, lwa, KWA, lkwa, ACTIVE, lactiv, - & lql, QL ) - INTEGER :: m, me, l, n, mmax, nmax, mnn2, lwa, lkwa, lactiv - INTEGER :: maxfun, maxit, maxnm, iprint, mode, iout, ifail - DOUBLE PRECISION :: acc, accqp, stpmin, rho - LOGICAL :: lql - INTEGER :: KWA( lkwa ) - DOUBLE PRECISION :: X( NMAX, L ),F( L ),G( MMAX, L ), DF( NMAX ) - DOUBLE PRECISION :: DG( mmax, nmax ), U( mnn2 ), XL( n ),XU( n ) - DOUBLE PRECISION :: C( nmax, nmax ), D( nmax ), WA( lwa ) - LOGICAL ACTIVE( lactiv ) - EXTERNAL :: QL - IF ( ifail == 0 ) THEN - ifail = - 1 - ELSE IF ( ifail == - 1 ) THEN - ifail = - 2 - ELSE - KWA( 1 ) = 2 - KWA( 2 ) = 2 - KWA( 3 ) = 1 - KWA( 4 ) = 0 - ifail = 1 - END IF - RETURN - END - - SUBROUTINE QL( m, me, mmax, n, nmax, mnn, C, D, A, B, - & XL, XU, X, U, eps, mode, iout, ifail, iprint, - & WAR, lwar, IWAR, liwar ) - INTEGER :: m, me, iout, mode, ifail, iprint - INTEGER :: nmax, mmax, n, mnn, lwar, liwar - INTEGER :: IWAR( liwar ) - DOUBLE PRECISION :: eps - DOUBLE PRECISION :: C( nmax, n ), D( n ), A( mmax, n ), B( mmax ) - DOUBLE PRECISION :: XL( n ), XU( n ),X( n ), U( mnn ), WAR( lwar ) - ifail = 1 - RETURN - END diff --git a/src/nomad/makemaster b/src/nomad/makemaster index bd07fba..11b2dad 100644 --- a/src/nomad/makemaster +++ b/src/nomad/makemaster @@ -1,169 +1,38 @@ # Main body of the installation makefile for CUTEst NOMAD interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 25 IV 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = nomad -package = nomad - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +include $(CUTEST)/src/makedefs/defaults -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) +# package name -# compilation agenda - -$(PACKAGE) = $(OBJ)/nomad_main.o - -nomad_main = $(OBJ)/nomad_main.o - -#U_TEST = u_elfun.o u_group.o u_range.o -#C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# basic packages - -#test: testc - -#testc: testc_$(PRECIS) -# @printf ' %-21s\n' "CUTEst: nomad ($(PRECIS) $(SUCC)" -#testc_single: $(genc) -#testc_double: $(genc) - -# run example tests - -#run_test: run_testc - -#run_testc: tools test_cutest testc -# echo " Test of unconstrained genc" -# cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_testc \ -# genc_main.o genc.o $(U_TEST) -L$(OBJ) $(LIBS) -# ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../genc/OUTSDIF.d -# - $(OBJ)/run_testc >& ../genc/u_testc.output -# cat ../genc/u_testc.output -# rm $(OBJ)/run_testc ../genc/OUTSDIF.d -# echo " Test of constrained genc" -# cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_testc \ -# genc_main.o genc.o $(C_TEST) -L$(OBJ) $(LIBS) -# ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../genc/OUTSDIF.d -# - $(OBJ)/run_testc >& ../genc/c_testc.output -# cat ../genc/c_testc.output -# rm $(OBJ)/run_testc ../genc/OUTSDIF.d +PACKAGE = NOMAD +package = nomad -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -#$(OBJ)/genc.o: ../genc/genc.c -# @printf ' %-9s %-15s\t\t' "Compiling" "genc" -# $(SED) -f $(SEDS) ../genc/genc.c > $(OBJ)/genc.c -# cd $(OBJ); $(CC) -o genc.o $(CFLAGS) genc.c \ -# || ( printf ' %-26s' "=> Disabling optimization " ; \ -# $(CC) -o genc.o $(CFLAGSN) genc.c ) -# $(RM) $(OBJ)/genc.c -# @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/nomad_main.o: ../nomad/nomad_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "nomad_main" - $(SED) -f $(SEDS) ../nomad/nomad_main.c > $(OBJ)/nomad_main.c - cd $(OBJ); $(CC) -o nomad_main.o $(CFLAGS) nomad_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o nomad_main.o $(CFLAGSN) nomad_main.c ) - $(RM) $(OBJ)/nomad_main.c - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: + echo " No $(PACKAGE) test program at the moment" -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/nomad/nomad_main.c b/src/nomad/nomad_main.c index 601e01f..dcc28cd 100644 --- a/src/nomad/nomad_main.c +++ b/src/nomad/nomad_main.c @@ -1,3 +1,5 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-05 AT 12:40 GMT */ + /* ==================================================== * CUTEst interface simulating a black box for NOMAD. * April 25, 2013 @@ -8,6 +10,7 @@ #include #include +#include #ifdef __cplusplus extern "C" { /* To prevent C++ compilers from mangling symbols */ @@ -20,6 +23,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #endif #include "cutest.h" +#include "cutest_routines.h" integer CUTEst_nvar; /* number of variables */ integer CUTEst_ncon; /* number of constraints */ @@ -38,15 +42,15 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ integer ncon_dummy; - doublereal *x, *bl, *bu; - doublereal *v = NULL, *cl = NULL, *cu = NULL; + rp_ *x, *bl, *bu; + rp_ *v = NULL, *cl = NULL, *cu = NULL; logical *equatn = NULL, *linear = NULL; integer efirst = 0, lfirst = 0, nvfrst = 0; logical constrained = FALSE_; - real calls[7], cpu[2]; + real calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; - doublereal obj; + rp_ obj; int i; /* Open problem description file OUTSDIF.d */ @@ -58,7 +62,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ } /* Determine problem size */ - CUTEST_cdimen( &ierr, &funit, &CUTEst_nvar, &CUTEst_ncon ); + CUTEST_cdimen_r( &ierr, &funit, &CUTEst_nvar, &CUTEst_ncon ); if ( ierr ) { return_infinity(); return -2; @@ -69,19 +73,19 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ /* Reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC( x, CUTEst_nvar, doublereal ); - MALLOC( bl, CUTEst_nvar, doublereal ); - MALLOC( bu, CUTEst_nvar, doublereal ); + MALLOC( x, CUTEst_nvar, rp_ ); + MALLOC( bl, CUTEst_nvar, rp_ ); + MALLOC( bu, CUTEst_nvar, rp_ ); if( constrained ) { MALLOC( equatn, CUTEst_ncon+1, logical ); MALLOC( linear, CUTEst_ncon+1, logical ); - MALLOC( v, CUTEst_ncon+1, doublereal ); - MALLOC( cl, CUTEst_ncon+1, doublereal ); - MALLOC( cu, CUTEst_ncon+1, doublereal ); - CUTEST_csetup( &ierr, &funit, &iout, &io_buffer, - &CUTEst_nvar, &CUTEst_ncon, - x, bl, bu, v, cl, cu, + MALLOC( v, CUTEst_ncon+1, rp_ ); + MALLOC( cl, CUTEst_ncon+1, rp_ ); + MALLOC( cu, CUTEst_ncon+1, rp_ ); + CUTEST_csetup_r( &ierr, &funit, &iout, &io_buffer, + &CUTEst_nvar, &CUTEst_ncon, + x, bl, bu, v, cl, cu, equatn, linear, &efirst, &lfirst, &nvfrst ); if ( ierr ) { return_infinity(); @@ -91,10 +95,10 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ else { MALLOC( equatn, 1, logical ); MALLOC( linear, 1, logical ); - MALLOC( cl, 1, doublereal ); - MALLOC( cu, 1, doublereal ); - CUTEST_usetup( &ierr, &funit, &iout, &io_buffer, - &CUTEst_nvar, x, bl, bu ); + MALLOC( cl, 1, rp_ ); + MALLOC( cu, 1, rp_ ); + CUTEST_usetup_r( &ierr, &funit, &iout, &io_buffer, + &CUTEst_nvar, x, bl, bu ); if ( ierr ) { return_infinity(); return -3; @@ -113,10 +117,16 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ return 0; } +#ifdef CUTEST_SINGLE + char pf[ ]="%f"; +#else + char pf[ ]="%lf"; +#endif + /* See if initial guess is requested */ if (strcmp(argv[1], "--x0") == 0) { for ( i = 0; i < CUTEst_nvar; i++ ) - printf("%lf ", x[i]); + printf(pf, x[i]); printf("\n"); return 0; } @@ -124,7 +134,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ f = fopen(argv[1], "r"); for ( i = 0 ; i < CUTEst_nvar ; i++ ) - fscanf(f, "%lf" , &x[i]); + if(fscanf(f, pf, &x[i])); /* for ( i = 0 ; i < CUTEst_nvar ; i++ ) @@ -136,7 +146,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ if( constrained ) { /* Recycle the array v to store constraint values */ - CUTEST_cfn( &ierr, &CUTEst_nvar, &CUTEst_ncon, x, &obj, v ); + CUTEST_cfn_r( &ierr, &CUTEst_nvar, &CUTEst_ncon, x, &obj, v ); if ( ierr ) { return_infinity(); return -4; @@ -147,7 +157,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ printf("\n"); } else { - CUTEST_ufn( &ierr, &CUTEst_nvar , x , &obj); + CUTEST_ufn_r( &ierr, &CUTEst_nvar , x , &obj); if ( ierr ) { return_infinity(); return -4; diff --git a/src/npsol/makemaster b/src/npsol/makemaster index 8a6cfc1..68a4a09 100644 --- a/src/npsol/makemaster +++ b/src/npsol/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst NPSOL interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = NPSOL -package = npsol - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = NPSOL +package = npsol -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/npsol/npsol_main.f b/src/npsol/npsol_main.F similarity index 83% rename from src/npsol/npsol_main.f rename to src/npsol/npsol_main.F index 789a921..9bacca1 100644 --- a/src/npsol/npsol_main.f +++ b/src/npsol/npsol_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 13 Jun 2016 at 08:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM NPSOL_main @@ -12,24 +15,27 @@ PROGRAM NPSOL_main C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + USE CUTEST_KINDS_precision + C Set up parameters, variables and arrays required by constrained tools - INTEGER, PARAMETER :: input = 55, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: n, m, ldcj, ldr, liwork, lwork, npm, i, ib, ic, j - INTEGER :: ioptns, iprint, nclin, ncnln, inform, iter, status, lda - DOUBLE PRECISION :: f - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: n, m, ldcj, ldr, liwork, lwork, npm + INTEGER ( KIND = ip_ ) :: i, ib, ic, j, iter, status, lda + INTEGER ( KIND = ip_ ) :: ioptns, iprint, nclin, ncnln, inform + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) LOGICAL :: debug CHARACTER ( LEN= 10 ) :: cbgbnd CHARACTER * 10 pname - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IWORK, ISTATE - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, G - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: Y, CL, CU, C - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: BLOWER, BUPPER - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: CLAMBDA, WORK - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : , : ) :: A, R, CJAC + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IWORK + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: ISTATE + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, G + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Y, CL, CU, C + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: BLOWER, BUPPER + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: CLAMBDA, WORK + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , : ) :: A, R, CJAC LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR external :: NPSOL_evalfg, NPSOL_evalcj LOGICAL :: fdgrad @@ -37,11 +43,12 @@ PROGRAM NPSOL_main C and dimension IPADNP and IPSVNP only once - INTEGER, PARAMETER :: mxparm = 30 - INTEGER :: idbgnp, itmxnp, jvrfy1, jvrfy2, jvrfy3, jvrfy4, ldbgnp - INTEGER :: lformh, lvlder, lverfy, msgnp , nlnf, nlnj, nlnx - INTEGER :: nncnln, nsave, nload, ksave - INTEGER :: ipadnp( 12 ), IPSVNP( mxparm ) + INTEGER ( KIND = ip_ ), PARAMETER :: mxparm = 30 + INTEGER ( KIND = ip_ ) :: idbgnp, ldbgnp, itmxnp, nlnf, nlnj, nlnx + INTEGER ( KIND = ip_ ) :: jvrfy1, jvrfy2, jvrfy3, jvrfy4 + INTEGER ( KIND = ip_ ) :: lformh, lvlder, lverfy, msgnp + INTEGER ( KIND = ip_ ) :: nncnln, nsave, nload, ksave + INTEGER ( KIND = ip_ ) :: ipadnp( 12 ), IPSVNP( mxparm ) COMMON / NPPAR1/ IPSVNP, idbgnp, itmxnp, jvrfy1, jvrfy2, jvrfy3, * jvrfy4, ldbgnp, lformh, lvlder, lverfy, msgnp, * nlnf, nlnj, nlnx, nncnln, nsave, nload, ksave, @@ -58,7 +65,7 @@ PROGRAM NPSOL_main C compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C Set up parameters, variables and arrays required by NPSOL. @@ -102,7 +109,7 @@ PROGRAM NPSOL_main C are ordered in this way so that CCFG need evaluate the Jacobian for C only the first NCNLN constraints - CALL CUTEST_csetup( status, input, out, io_buffer, n, m, X, BL, + CALL CUTEST_csetup_r( status, input, out, io_buffer, n, m, X, BL, * BU, Y, CL, CU,EQUATN, LINEAR, 0, 2, 0 ) CLOSE( input ) IF ( status /= 0 ) GO TO 910 @@ -124,8 +131,8 @@ PROGRAM NPSOL_main DO 150 i = 1, n BLOWER( i ) = BL( i ) BUPPER( i ) = BU( i ) - CLAMBDA( i ) = zero - G( i ) = zero + CLAMBDA( i ) = 0.0_rp_ + G( i ) = 0.0_rp_ 150 CONTINUE DO 160 i = 1, nclin ib = n + i @@ -143,7 +150,7 @@ PROGRAM NPSOL_main C compute the constraint values and Jacobian at X = G = 0 - CALL CUTEST_ccfg( status, n, m, G, C, .FALSE., + CALL CUTEST_ccfg_r( status, n, m, G, C, .FALSE., * ldcj, n, CJAC, .TRUE. ) IF ( status .NE. 0 ) THEN WRITE( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") @@ -182,7 +189,7 @@ PROGRAM NPSOL_main C Get the problem name and write some debug messages. C m = nclin + ncnln - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) WRITE ( out, 2080 ) pname, n, nclin, ncnln IF ( debug ) THEN WRITE( out, 2030 ) ( i, X( i ), BLOWER( i ), @@ -232,7 +239,7 @@ PROGRAM NPSOL_main * C, CJAC, CLAMBDA, f, G, R, X, IWORK, liwork, WORK, * lwork ) - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) C Print messages about abnormal NPSOL inform codes @@ -267,7 +274,7 @@ PROGRAM NPSOL_main DEALLOCATE( X, BL, BU, Y, CL, CU, G, C, EQUATN, LINEAR, WORK, * IWORK, ISTATE, CJAC, A, R, BLOWER, BUPPER, CLAMBDA, * STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -336,11 +343,12 @@ SUBROUTINE NPSOL_evalfg( mode, n, X, f, G, nstate ) C evaluate the objective and its gradient - INTEGER :: mode, n, nstate - DOUBLE PRECISION :: f - DOUBLE PRECISION :: X( n ), G( n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: mode, n, nstate + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ) :: X( n ), G( n ) - INTEGER :: j, status + INTEGER ( KIND = ip_ ) :: j, status LOGICAL :: grad, fdgrad COMMON / FDG / fdgrad @@ -349,7 +357,7 @@ SUBROUTINE NPSOL_evalfg( mode, n, X, f, G, nstate ) ELSE grad = .TRUE. END IF - CALL CUTEST_cofg( status, n, X, f, G, grad ) + CALL CUTEST_cofg_r( status, n, X, f, G, grad ) IF ( status .NE. 0 ) THEN WRITE( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") * status @@ -372,11 +380,12 @@ SUBROUTINE NPSOL_evalcj( mode, ncnln, n, ldcj, C evaluate the constraints and their gradients (Jacobian) - INTEGER :: mode, ncnln, n, ldcj, nstate - INTEGER :: NEEDC( * ) - DOUBLE PRECISION :: X( n ), C( ldcj ), CJAC( ldcj, n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: mode, ncnln, n, ldcj, nstate + INTEGER ( KIND = ip_ ) :: NEEDC( * ) + REAL ( KIND = rp_ ) :: X( n ), C( ldcj ), CJAC( ldcj, n ) - INTEGER :: i, j, m, status + INTEGER ( KIND = ip_ ) :: i, j, m, status LOGICAL :: grad, fdgrad COMMON / FDG / fdgrad COMMON / NPSOL_m/ m @@ -386,7 +395,7 @@ SUBROUTINE NPSOL_evalcj( mode, ncnln, n, ldcj, ELSE grad = .TRUE. END IF - CALL CUTEST_ccfg( status, n, m, X, C, .FALSE., + CALL CUTEST_ccfg_r( status, n, m, X, C, .FALSE., * ldcj, n, CJAC, grad ) IF ( status .NE. 0 ) THEN WRITE( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") @@ -400,7 +409,7 @@ SUBROUTINE NPSOL_evalcj( mode, ncnln, n, ldcj, IF ( grad .AND. fdgrad ) THEN DO 20 j = 1, n DO 10 i = 1, ncnln - CJAC( i, j ) = -11111.0D+0 + CJAC( i, j ) = -11111.0_rp_ 10 CONTINUE 20 CONTINUE END IF diff --git a/src/npsol/npsol_test.F b/src/npsol/npsol_test.F new file mode 100644 index 0000000..757369d --- /dev/null +++ b/src/npsol/npsol_test.F @@ -0,0 +1,57 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy NPSOL for testing npsol_main interface to CUTEst + +C Nick Gould, 11th January 2013 + + subroutine npsol ( n, nclin, ncnln, ldA, ldJu, ldR, + $ A, bl, bu, + $ funcon, funobj, + $ inform, iter, istate, + $ c, cJacu, clamda, objf, gradu, R, x, + $ iw, leniw, w, lenw ) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) n, nclin, ncnln, leniw, lenw + integer ( kind = ip_ ) inform, iter, ldA, ldJu, ldR + real ( kind = rp_ ) objf + external funcon, funobj + integer ( kind = ip_ ) istate(n+nclin+ncnln) + integer ( kind = ip_ ) iw(leniw) + real ( kind = rp_ ) A(ldA,*), bl(n+nclin+ncnln), bu(n+nclin+ncnln) + real ( kind = rp_ ) c(*), cJacu(ldJu,*), clamda(n+nclin+ncnln) + real ( kind = rp_ ) gradu(n), R(ldR,*), x(n) + real ( kind = rp_ ) w(lenw) + INTEGER ( KIND = ip_ ) :: mode, nstate + INTEGER ( KIND = ip_ ) :: needc( 1 ) + + mode = 1 + CALL FUNOBJ( mode, n, X, objf, w, nstate ) + CALL FUNCON( mode, ncnln, n, ldJu, needc, x, c, cJacu, nstate ) + RETURN + END + + subroutine npfile( ioptns, inform ) + use CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: ioptns, inform + INTEGER ( KIND = ip_ ), PARAMETER :: mxparm = 30 + INTEGER ( KIND = ip_ ) :: idbgnp, itmxnp, ldbgnp, nlnj, nlnx + INTEGER ( KIND = ip_ ) :: jvrfy1, jvrfy2, jvrfy3, jvrfy4 + INTEGER ( KIND = ip_ ) :: lformh, lvlder, lverfy, msgnp, nlnf + INTEGER ( KIND = ip_ ) :: nncnln, nsave, nload, ksave + INTEGER ( KIND = ip_ ) :: ipadnp( 12 ), IPSVNP( mxparm ) + COMMON / NPPAR1/ IPSVNP, idbgnp, itmxnp, jvrfy1, jvrfy2, jvrfy3, + * jvrfy4, ldbgnp, lformh, lvlder, lverfy, msgnp, + * nlnf, nlnj, nlnx, nncnln, nsave, nload, ksave, + * IPADNP + lvlder = 2 + inform = 0 + RETURN + END + + subroutine npoptn( string ) + character*(*) string + RETURN + END + diff --git a/src/npsol/npsol_test.f b/src/npsol/npsol_test.f deleted file mode 100644 index 358c668..0000000 --- a/src/npsol/npsol_test.f +++ /dev/null @@ -1,51 +0,0 @@ -C ( Last modified on 11 Jan 2013 at 14:00:00 ) - -C Dummy NPSOL for testing npsol_main interface to CUTEst -C Nick Gould, 11th January 2013 - - subroutine npsol ( n, nclin, ncnln, ldA, ldJu, ldR, - $ A, bl, bu, - $ funcon, funobj, - $ inform, iter, istate, - $ c, cJacu, clamda, objf, gradu, R, x, - $ iw, leniw, w, lenw ) - integer n, nclin, ncnln, leniw, lenw, ldA, ldJu, ldR - integer inform, iter - double precision objf - external funcon, funobj - integer istate(n+nclin+ncnln) - integer iw(leniw) - double precision A(ldA,*), bl(n+nclin+ncnln), bu(n+nclin+ncnln) - double precision c(*), cJacu(ldJu,*), clamda(n+nclin+ncnln) - double precision gradu(n), R(ldR,*), x(n) - double precision w(lenw) - INTEGER :: mode, nstate - INTEGER :: needc( 1 ) - - mode = 1 - CALL FUNOBJ( mode, n, X, objf, w, nstate ) - CALL FUNCON( mode, ncnln, n, ldJu, needc, x, c, cJacu, nstate ) - RETURN - END - - subroutine npfile( ioptns, inform ) - integer ioptns, inform - INTEGER, PARAMETER :: mxparm = 30 - INTEGER :: idbgnp, itmxnp, jvrfy1, jvrfy2, jvrfy3, jvrfy4, ldbgnp - INTEGER :: lformh, lvlder, lverfy, msgnp , nlnf, nlnj, nlnx - INTEGER :: nncnln, nsave, nload, ksave - INTEGER :: ipadnp( 12 ), IPSVNP( mxparm ) - COMMON / NPPAR1/ IPSVNP, idbgnp, itmxnp, jvrfy1, jvrfy2, jvrfy3, - * jvrfy4, ldbgnp, lformh, lvlder, lverfy, msgnp, - * nlnf, nlnj, nlnx, nncnln, nsave, nload, ksave, - * IPADNP - lvlder = 2 - inform = 0 - RETURN - END - - subroutine npoptn( string ) - character*(*) string - RETURN - END - diff --git a/src/octave/cutest_connames.m b/src/octave/cutest_connames.m index 9a6ae94..5e75ab2 100644 --- a/src/octave/cutest_connames.m +++ b/src/octave/cutest_connames.m @@ -2,4 +2,4 @@ % Return constraint names. % Usage: cnames = cutest_connames() varargout = cell(1,nargout); - [varargout{:}] = mcutest('connames',varargin{:}); + [varargout{:}] = ocutest('connames',varargin{:}); diff --git a/src/octave/cutest_cons.m b/src/octave/cutest_cons.m index f80daa0..59df3ab 100644 --- a/src/octave/cutest_cons.m +++ b/src/octave/cutest_cons.m @@ -4,4 +4,4 @@ % Usage: c = cutest_cons(x) or [c,J] = cutest_cons(x) % ci = cutest_cons(x,i) or [ci,gi] = cutest_cons(x,i) varargout = cell(1,nargout); - [varargout{:}] = mcutest('cons',varargin{:}); + [varargout{:}] = ocutest('cons',varargin{:}); diff --git a/src/octave/cutest_dims.m b/src/octave/cutest_dims.m index f48371f..05d668c 100644 --- a/src/octave/cutest_dims.m +++ b/src/octave/cutest_dims.m @@ -2,4 +2,4 @@ % Return problem dimensions % Usage: [nvar,ncon] = cutest_dims() varargout = cell(1,nargout); - [varargout{:}] = mcutest('dims',varargin{:}); + [varargout{:}] = ocutest('dims',varargin{:}); diff --git a/src/octave/cutest_grad.m b/src/octave/cutest_grad.m index 942ae6b..bf09339 100644 --- a/src/octave/cutest_grad.m +++ b/src/octave/cutest_grad.m @@ -2,4 +2,4 @@ % Return objective function gradient or gradient of i-th constraint % Usage: g = cutest_grad(x) or g = cutest_grad(x,i) varargout = cell(1,nargout); - [varargout{:}] = mcutest('grad',varargin{:}); + [varargout{:}] = ocutest('grad',varargin{:}); diff --git a/src/octave/cutest_gradhess.m b/src/octave/cutest_gradhess.m index 65deb02..328bc46 100644 --- a/src/octave/cutest_gradhess.m +++ b/src/octave/cutest_gradhess.m @@ -9,4 +9,4 @@ % jtrans = true : returns the transpose Jacobian in J % jtrans = false: returns the Jacobian in J varargout = cell(1,nargout); - [varargout{:}] = mcutest('gradhess',varargin{:}); + [varargout{:}] = ocutest('gradhess',varargin{:}); diff --git a/src/octave/cutest_gradsphess.m b/src/octave/cutest_gradsphess.m index 4eebd04..283ed74 100644 --- a/src/octave/cutest_gradsphess.m +++ b/src/octave/cutest_gradsphess.m @@ -7,4 +7,4 @@ % gradf = true : returns the gradient of the objective in g % false: returns the gradient of the Lagrangian in g varargout = cell(1,nargout); - [varargout{:}] = mcutest('gradsphess',varargin{:}); + [varargout{:}] = ocutest('gradsphess',varargin{:}); diff --git a/src/octave/cutest_hess.m b/src/octave/cutest_hess.m index 53926ef..0e3d996 100644 --- a/src/octave/cutest_hess.m +++ b/src/octave/cutest_hess.m @@ -6,4 +6,4 @@ % Usage: H = cutest_hess( x ) if the problem has no general constraints, or % H = cutest_hess( x, v ) otherwise. varargout = cell(1,nargout); - [varargout{:}] = mcutest('hess',varargin{:}); + [varargout{:}] = ocutest('hess',varargin{:}); diff --git a/src/octave/cutest_hprod.m b/src/octave/cutest_hprod.m index 0718f5c..28f53a0 100644 --- a/src/octave/cutest_hprod.m +++ b/src/octave/cutest_hprod.m @@ -6,4 +6,4 @@ % r = cutest_hprod( x, p ) Same, for unconstrained problems % r = cutest_hprod( p ) assumes H(x,v) was computed previously varargout = cell(1,nargout); - [varargout{:}] = mcutest('hprod',varargin{:}); + [varargout{:}] = ocutest('hprod',varargin{:}); diff --git a/src/octave/cutest_ihess.m b/src/octave/cutest_ihess.m index 79b61ac..56fb855 100644 --- a/src/octave/cutest_ihess.m +++ b/src/octave/cutest_ihess.m @@ -3,4 +3,4 @@ % function index is ignored if the problem is unconstrained. % Usage: Hi = cutest_ihess( x, i ). varargout = cell(1,nargout); - [varargout{:}] = mcutest('ihess',varargin{:}); + [varargout{:}] = ocutest('ihess',varargin{:}); diff --git a/src/octave/cutest_isphess.m b/src/octave/cutest_isphess.m index dca310b..17e8ccc 100644 --- a/src/octave/cutest_isphess.m +++ b/src/octave/cutest_isphess.m @@ -3,4 +3,4 @@ % function index is ignored if the problem is unconstrained. % Usage: Hi = cutest_isphess( x, i ). varargout = cell(1,nargout); - [varargout{:}] = mcutest('isphess',varargin{:}); + [varargout{:}] = ocutest('isphess',varargin{:}); diff --git a/src/octave/cutest_jprod.m b/src/octave/cutest_jprod.m index fe763bb..d2d7512 100644 --- a/src/octave/cutest_jprod.m +++ b/src/octave/cutest_jprod.m @@ -3,4 +3,4 @@ % Usage: r = cutest_jprod( x, p ) --> recomputes J(x) % r = cutest_jprod( p ) --> assumes J(x) was computed previously varargout = cell(1,nargout); - [varargout{:}] = mcutest('Jprod',varargin{:}); + [varargout{:}] = ocutest('Jprod',varargin{:}); diff --git a/src/octave/cutest_jtprod.m b/src/octave/cutest_jtprod.m index 40d5b78..b594668 100644 --- a/src/octave/cutest_jtprod.m +++ b/src/octave/cutest_jtprod.m @@ -3,4 +3,4 @@ % Usage: r = cutest_jtprod( x, p ) --> recomputes J(x) % r = cutest_jtprod( p ) --> assumes J(x) was computed previously varargout = cell(1,nargout); - [varargout{:}] = mcutest('Jtprod',varargin{:}); + [varargout{:}] = ocutest('Jtprod',varargin{:}); diff --git a/src/octave/cutest_lag.m b/src/octave/cutest_lag.m index 800d1bc..4a3d881 100644 --- a/src/octave/cutest_lag.m +++ b/src/octave/cutest_lag.m @@ -2,4 +2,4 @@ % Return Lagrangian function value and gradient if requested. % Usage: f = cutest_lag(x,y) or [f,g] = cutest_lag(x,y) varargout = cell(1,nargout); - [varargout{:}] = mcutest('lag',varargin{:}); + [varargout{:}] = ocutest('lag',varargin{:}); diff --git a/src/octave/cutest_lagjac.m b/src/octave/cutest_lagjac.m index 814a5c6..c95f315 100644 --- a/src/octave/cutest_lagjac.m +++ b/src/octave/cutest_lagjac.m @@ -2,4 +2,4 @@ % Return the gradient of the objective or Lagrangian and Jacobian % [g,J] = cutest_lagjac(x) or [g,J] = cutest_lagjac(x,v) varargout = cell(1,nargout); - [varargout{:}] = mcutest('lagjac',varargin{:}); + [varargout{:}] = ocutest('lagjac',varargin{:}); diff --git a/src/octave/cutest_obj.m b/src/octave/cutest_obj.m index a11b365..fbf1b97 100644 --- a/src/octave/cutest_obj.m +++ b/src/octave/cutest_obj.m @@ -4,4 +4,4 @@ % Usage: f = cutest_obj(x) or [f,g] = cutest_obj(x) varargout = cell(1,nargout); - [varargout{:}] = mcutest('obj',varargin{:}); + [varargout{:}] = ocutest('obj',varargin{:}); diff --git a/src/octave/cutest_objcons.m b/src/octave/cutest_objcons.m index b47d051..c1c04f4 100644 --- a/src/octave/cutest_objcons.m +++ b/src/octave/cutest_objcons.m @@ -3,5 +3,5 @@ % Evaluate objective function value and constraint bodies. % Usage: [f,c] = cutest_objcons(x) varargout = cell(1,nargout); - [varargout{:}] = mcutest('objcons',varargin{:}); + [varargout{:}] = ocutest('objcons',varargin{:}); diff --git a/src/octave/cutest_scons.m b/src/octave/cutest_scons.m index affb811..cefc513 100644 --- a/src/octave/cutest_scons.m +++ b/src/octave/cutest_scons.m @@ -4,4 +4,4 @@ % Usage: [c,J] = cutest_scons(x) % [ci, sgci] = cutest_scons( prob.x, i ) varargout = cell(1,nargout); - [varargout{:}] = mcutest('scons',varargin{:}); + [varargout{:}] = ocutest('scons',varargin{:}); diff --git a/src/octave/cutest_setup.m b/src/octave/cutest_setup.m index 8b33ca6..851db31 100644 --- a/src/octave/cutest_setup.m +++ b/src/octave/cutest_setup.m @@ -7,6 +7,6 @@ % 1 (first derivatives required) % 2 (first and derivatives required, default) varargout = cell(1,nargout); - [varargout{:}] = mcutest('setup',varargin{:}); + [varargout{:}] = ocutest('setup',varargin{:}); diff --git a/src/octave/cutest_sgrad.m b/src/octave/cutest_sgrad.m index e7bb45f..51d3113 100644 --- a/src/octave/cutest_sgrad.m +++ b/src/octave/cutest_sgrad.m @@ -3,4 +3,4 @@ % sparse gradient of i-th constraint % Usage: sg = cutest_sgrad(x) or sg = cutest_sgrad(x,i) varargout = cell(1,nargout); - [varargout{:}] = mcutest('sgrad',varargin{:}); + [varargout{:}] = ocutest('sgrad',varargin{:}); diff --git a/src/octave/cutest_slagjac.m b/src/octave/cutest_slagjac.m index fecb839..6f38458 100644 --- a/src/octave/cutest_slagjac.m +++ b/src/octave/cutest_slagjac.m @@ -3,4 +3,4 @@ % function or the Lagrangian. % Usage: [g,J] = cutest_slagjac(x) or [g,J] = cutest_slagjac(x,v) varargout = cell(1,nargout); - [varargout{:}] = mcutest('slagjac',varargin{:}); + [varargout{:}] = ocutest('slagjac',varargin{:}); diff --git a/src/octave/cutest_sobj.m b/src/octave/cutest_sobj.m index 60c1246..ed22a17 100644 --- a/src/octave/cutest_sobj.m +++ b/src/octave/cutest_sobj.m @@ -2,4 +2,4 @@ % Return function value and sparse gradient if requested. % Usage: f = cutest_sobj(x) or [f,sg] = cutest_sobj(x) varargout = cell(1,nargout); - [varargout{:}] = mcutest('sobj',varargin{:}); + [varargout{:}] = ocutest('sobj',varargin{:}); diff --git a/src/octave/cutest_sphess.m b/src/octave/cutest_sphess.m index c33d9af..d2317d2 100644 --- a/src/octave/cutest_sphess.m +++ b/src/octave/cutest_sphess.m @@ -6,4 +6,4 @@ % Usage: H = cutest_sphess( x ) if the problem has no general constraints, or % H = cutest_sphess( x, v ) otherwise. varargout = cell(1,nargout); - [varargout{:}] = mcutest('sphess',varargin{:}); + [varargout{:}] = ocutest('sphess',varargin{:}); diff --git a/src/octave/cutest_terminate.m b/src/octave/cutest_terminate.m index 165edb7..8ab019c 100644 --- a/src/octave/cutest_terminate.m +++ b/src/octave/cutest_terminate.m @@ -3,4 +3,4 @@ % Usage: cutest_terminate() varargout = cell(1,nargout); - [varargout{:}] = mcutest('terminate',varargin{:}); + [varargout{:}] = ocutest('terminate',varargin{:}); diff --git a/src/octave/cutest_varnames.m b/src/octave/cutest_varnames.m index 83903b8..5eb159d 100644 --- a/src/octave/cutest_varnames.m +++ b/src/octave/cutest_varnames.m @@ -2,4 +2,4 @@ % Return variable names. % Usage: vnames = cutest_varnames() varargout = cell(1,nargout); - [varargout{:}] = mcutest('varnames',varargin{:}); + [varargout{:}] = ocutest('varnames',varargin{:}); diff --git a/src/octave/makemaster b/src/octave/makemaster index 7223303..8c690bd 100644 --- a/src/octave/makemaster +++ b/src/octave/makemaster @@ -2,92 +2,42 @@ # copied and modified from makefile for MATLAB, written # by N. Gould, D. Orban and Ph. L. Toint. -# This version for Octave: Romana Jezek, 2023 +# Adapted for Octave by Romana Jezek, 2023 -# package - -PACKAGE = OCTAVE -package = octave - -SHELL = /bin/$(BINSHELL) - -# Mex compiler - -MEX = mkoctfile --mex -v - -# compiler flags - -OCTAVEINC = -I/usr/include/$(OCTAVE_VERSION)/octave/ -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(OCTAVEINC) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(OCTAVEINC) +# include standard CUTEst makefile defaults before package-specifics -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include $(CCFFLAGS) +include $(CUTEST)/src/makedefs/defaults -MFFLAGS = $(MBASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -#MFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) -MFLAGS = -g $(OCTAVEINC) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# names of random libraries +# package name -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -MLC = $(OBJ)/libcutest_octave.a -MLCS = $(OBJS)/libcutest_octave.a -MLCD = $(OBJD)/libcutest_octave.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +PACKAGE = OCTAVE_CUTEST +package = octave -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) +# package -MARR = $(AR) $(ARREPFLAGS) $(MLC) -MRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(MLC) +SHELL = /bin/$(BINSHELL) -# Derived type dependencies +# Octave compiler -MAT_BASIC = $(MLC)(gtools.o) +#OCT = mkoctfile --mex -v +OCT = mkoctfile --mex -# compilation agenda +# compiler flags -GEN77 = $(OBJ)/gen77.o $(OBJ)/gen77_main.o -GEN90 = $(OBJ)/gen90.o $(OBJ)/gen90_main.o -GENC = $(OBJ)/genc.o $(OBJ)/genc_main.o +OCTAVEINC = -I/usr/include/$(OCTAVE_VERSION)/octave/ +OFLAGS = -g $(OCTAVEINC) -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o +# include standard CUTEst makefile definitions -SUCC = precision version) compiled successfully +include $(CUTEST)/src/makedefs/definitions # main compilations and runs @@ -97,12 +47,10 @@ all: $(package) $(package): $(package)_$(PRECIS) @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -#$(package)_single: $(OBJS)/utools.o $(OBJS)/ctools.o $(OBJS)/mcutest.o -#$(package)_double: $(OBJD)/utools.o $(OBJD)/ctools.o $(OBJD)/mcutest.o -$(package)_single: $(OBJS)/mcutest.o -$(package)_double: $(OBJD)/mcutest.o +$(package)_single: $(OBJS)/ocutest.o +$(package)_double: $(OBJD)/ocutest.o -# dependent packages +# compile tools tools: ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ @@ -116,61 +64,15 @@ ctools: # individual compilations -# utools - -utools.o: $(OBJ)/utools.o - -$(OBJ)/utools.o: utools $(MAT_BASIC) utools.F - @printf ' %-9s %-15s\t\t' "Compiling" "utools" - $(SED) -f $(SEDS) utools.F > $(OBJ)/utools.F - cd $(OBJ) ; $(MEX) -c $(MFLAGS) utools.F - $(RM) $(OBJ)/utools.F - @printf '[ OK ]\n' - -# ctools - -ctools.o: $(OBJ)/ctools.o - -$(OBJ)/ctools.o: ctools $(MAT_BASIC) ctools.F - @printf ' %-9s %-15s\t\t' "Compiling" "ctools" - $(SED) -f $(SEDS) ctools.F > $(OBJ)/ctools.F - cd $(OBJ) ; $(MEX) -c $(MFLAGS) ctools.F - $(RM) $(OBJ)/ctools.F - @printf '[ OK ]\n' - -# mcutest - -mcutest.o: $(OBJ)/mcutest.o - -$(OBJ)/mcutest.o: tools mcutest.c - @printf ' %-9s %-15s\t\t' "Compiling" "mcutest" - $(CP) mcutest.c $(OBJ)/mcutest.c - cd $(OBJ) ; $(MEX) -c $(MFLAGS) -I$(CUTEST)/include mcutest.c - $(RM) $(OBJ)/mcutest.c - @printf '[ OK ]\n' +# ocutest -# main copying utilities +ocutest.o: $(OBJ)/ocutest.o -gtools.o: $(MLC)(gtools.o) - -$(MLC)(gtools.o): gtools.F - @printf ' %-9s %-15s\t\t' "Compiling" "gtools" - $(CP) gtools.F $(OBJ)/gtools.F - cd $(OBJ) ; $(MEX) $(MFLAGS) -c gtools.F - cd $(OBJ) ; $(MARR) gtools.o - $(RM) $(OBJ)/utools.o $(OBJ)/ctools.o +$(OBJ)/ocutest.o: ocutest.c + @printf ' %-9s %-15s\t\t' "Compiling" "ocutest" + $(CP) ocutest.c $(OBJ)/ocutest.c + cd $(OBJ) ; $(OCT) -c $(OFLAGS) -I$(CUTEST)/include ocutest.c + $(RM) $(OBJ)/ocutest.c @printf '[ OK ]\n' -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' diff --git a/src/octave/mcutest.c b/src/octave/ocutest.c similarity index 100% rename from src/octave/mcutest.c rename to src/octave/ocutest.c diff --git a/src/osqp/makemaster b/src/osqp/makemaster index 7dc3df0..22b362c 100644 --- a/src/osqp/makemaster +++ b/src/osqp/makemaster @@ -1,144 +1,39 @@ # Main body of the installation makefile for CUTEst OSQP interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 15 XII 2017 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = OSQP -package = osqp - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -I$(CUTEST)/include/osqp -CFLAGSN = $(CCBASIC) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -I$(CUTEST)/include/osqp -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -I$(CUTEST)/include/osqp $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used +include $(CUTEST)/src/makedefs/defaults -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# Archive manipulation strings +# package name -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +PACKAGE = OSQP +package = osqp -# run example tests +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -run_test: tools test_cutest $(OBJ)/$(package)_test.o $(OBJ)/$(package)_main.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(CC) -o run_test $(package)_main.o \ - $(OBJ)/$(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +EXTRAINCLUDES = -I$(CUTEST)/include/osqp -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# include standard CUTEst makefile definitions -# individual compilations +include $(CUTEST)/src/makedefs/definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(CP) ../$(package)/$(package)_test.c $(OBJ)/$(package)_test.c - cd $(OBJ); $(CC) -o $(package)_test.o $(CFLAGS) \ - $(package)_test.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_test.o $(CFLAGSN) $(package)_test.c ) - $(RM) $(OBJ)/$(package)_test.c - @printf '[ OK ]\n' +# include compilation and run instructions -# CUTEst interface main programs +include $(CUTEST)/src/makedefs/instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(CP) ../$(package)/$(package)_main.c $(OBJ)/$(package)_main.c -# $(SED) -f $(SEDS) ../$(package)/$(package)_main.c > \ -# $(OBJ)/$(package)_main.c - -cd $(OBJ); $(CC) -o $(package)_main.o $(CFLAGS) $(package)_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_main.o $(CFLAGSN) $(package)_main.c ) - $(RM) $(OBJ)/$(package)_main.c - @printf '[ OK ]\n' +# select specific run test -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_qp_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/osqp/osqp_main.c b/src/osqp/osqp_main.c index 9512981..1bf32b3 100644 --- a/src/osqp/osqp_main.c +++ b/src/osqp/osqp_main.c @@ -1,3 +1,4 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-05 AT 08:20 GMT */ /* =========================================== * CUTEst interface to OSQP @@ -21,6 +22,7 @@ extern "C" { /* To prevent C++ compilers from mangling symbols */ #endif #include "cutest.h" +#include "cutest_routines.h" #define MAXLINE 256 @@ -30,12 +32,12 @@ integer CUTEst_nnza; /* number of nonzeros in Jacobian */ integer CUTEst_nnzh; /* number of nonzeros in upper triangular part of the Hessian of the Lagrangian */ -void coo2csc(integer n, integer nz, doublereal *coo_val, integer *coo_row, +void coo2csc(integer n, integer nz, rp_ *coo_val, integer *coo_row, integer *coo_col, c_float *csr_val, c_int *csr_col, c_int *row_start); void sort(c_int *ind, c_float *val, c_int start, c_int end); -void getinfo( integer, integer, doublereal*, doublereal*, - doublereal*, doublereal*, logical*, logical*, +void getinfo( integer, integer, rp_*, rp_*, + rp_*, rp_*, logical*, logical*, VarTypes* ); /* main program for calls to OSQP */ @@ -54,9 +56,9 @@ int MAINENTRY(void) { integer ncon_dummy, nb, ncon_total, nnza_dummy, nnzh_dummy, a_ne; integer *A_row, *A_col, *H_row, *H_col; - doublereal f; - doublereal *x, *x0, *xl, *xu, *A_val, *H_val; - doublereal *y = NULL, *y0 = NULL, *c = NULL, *cl = NULL, *cu = NULL; + rp_ f; + rp_ *x, *x0, *xl, *xu, *A_val, *H_val; + rp_ *y = NULL, *y0 = NULL, *c = NULL, *cl = NULL, *cu = NULL; logical *equatn = NULL, *linear = NULL; @@ -70,10 +72,10 @@ int MAINENTRY(void) { integer e_order = 0, l_order = 0, v_order = 0; logical constrained = FALSE_; - doublereal calls[7], cpu[4]; + rp_ calls[7], cpu[4]; integer nlin = 0, nbnds = 0, neq = 0; - double r_string; - doublereal dummy; + rp_ r_string; + rp_ dummy; int i_string; integer ExitCode; int i, j, m, n, nc ; @@ -81,8 +83,8 @@ int MAINENTRY(void) { FILE *spec, *solution, *results ; - doublereal h, fxp, fxm, approx, derr, xi; - doublereal *cxp, *cxm, *g; + rp_ h, fxp, fxm, approx, derr, xi; + rp_ *cxp, *cxm, *g; int nerr = 0; char s [MAXLINE+1] ; @@ -96,7 +98,7 @@ int MAINENTRY(void) { /* determine problem size */ - CUTEST_cdimen( &status, &funit, &CUTEst_nvar, &CUTEst_ncon); + CUTEST_cdimen_r( &status, &funit, &CUTEst_nvar, &CUTEst_ncon); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -113,27 +115,27 @@ int MAINENTRY(void) { /* reserve memory for variables, bounds, and multipliers */ /* and call appropriate initialization routine for CUTEst */ - MALLOC(x, CUTEst_nvar, doublereal); - MALLOC(xl, CUTEst_nvar, doublereal); - MALLOC(xu, CUTEst_nvar, doublereal); + MALLOC(x, CUTEst_nvar, rp_); + MALLOC(xl, CUTEst_nvar, rp_); + MALLOC(xu, CUTEst_nvar, rp_); if (constrained) { MALLOC(equatn, CUTEst_ncon+1, logical); MALLOC(linear, CUTEst_ncon+1, logical); - MALLOC(y, CUTEst_ncon, doublereal); - MALLOC(cl, CUTEst_ncon, doublereal); - MALLOC(cu, CUTEst_ncon, doublereal); - CUTEST_csetup( &status, &funit, &iout, &io_buffer, - &CUTEst_nvar, &CUTEst_ncon, x, xl, xu, - y, cl, cu, equatn, linear, - &e_order, &l_order, &v_order ); + MALLOC(y, CUTEst_ncon, rp_); + MALLOC(cl, CUTEst_ncon, rp_); + MALLOC(cu, CUTEst_ncon, rp_); + CUTEST_csetup_r( &status, &funit, &iout, &io_buffer, + &CUTEst_nvar, &CUTEst_ncon, x, xl, xu, + y, cl, cu, equatn, linear, + &e_order, &l_order, &v_order ); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } FREE(y); } else { - CUTEST_usetup( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, - x, xl, xu); + CUTEST_usetup_r( &status, &funit, &iout, &io_buffer, &CUTEst_nvar, + x, xl, xu); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -153,14 +155,14 @@ int MAINENTRY(void) { MALLOC(Cnames, CUTEst_ncon, char*); /* Array of strings */ for (i = 0; i < CUTEst_ncon; i++) MALLOC(Cnames[i], FSTRING_LEN+1, char); - CUTEST_cnames( &status, &CUTEst_nvar, &CUTEst_ncon, - pname, xnames, cnames); + CUTEST_cnames_r( &status, &CUTEst_nvar, &CUTEst_ncon, + pname, xnames, cnames); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } } else { - CUTEST_unames( &status, &CUTEst_nvar, pname, xnames); + CUTEST_unames_r( &status, &CUTEst_nvar, pname, xnames); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -223,7 +225,7 @@ int MAINENTRY(void) { /* set x0 to zero to determine the constant and derivative terms for the problem functions */ - MALLOC(x0, CUTEst_nvar, doublereal); + MALLOC(x0, CUTEst_nvar, rp_); for (i = 0; i < CUTEst_nvar; i++) { x0[i] = 0.0; } @@ -231,14 +233,14 @@ int MAINENTRY(void) { /* evaluate the problem functions at x0 */ if (constrained) { - MALLOC(c, CUTEst_ncon, doublereal); - CUTEST_cfn( &status, &CUTEst_nvar, &CUTEst_ncon, x0, &f, c); + MALLOC(c, CUTEst_ncon, rp_); + CUTEST_cfn_r( &status, &CUTEst_nvar, &CUTEst_ncon, x0, &f, c); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); } } else { - CUTEST_ufn( &status, &CUTEst_nvar, x0, &f); + CUTEST_ufn_r( &status, &CUTEst_nvar, x0, &f); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -293,9 +295,9 @@ int MAINENTRY(void) { /* determine the number of nonzeros in the Hessian and, if needed, Jacobian */ - CUTEST_cdimsh( &status, &CUTEst_nnzh ); - MALLOC(g, CUTEst_nvar, doublereal); - MALLOC( H_val, CUTEst_nnzh, doublereal ); + CUTEST_cdimsh_r( &status, &CUTEst_nnzh ); + MALLOC(g, CUTEst_nvar, rp_); + MALLOC( H_val, CUTEst_nnzh, rp_ ); MALLOC( H_row, CUTEst_nnzh, integer ); MALLOC( H_col, CUTEst_nnzh, integer ); @@ -311,7 +313,7 @@ int MAINENTRY(void) { if (constrained) { /* Determine the number of nonzeros in Jacobian */ - CUTEST_cdimsj( &status, &CUTEst_nnza ); + CUTEST_cdimsj_r( &status, &CUTEst_nnza ); if( status ) { printf("** CUTEst error, status = %d, aborting\n", status); @@ -321,19 +323,19 @@ int MAINENTRY(void) { /* set y0 to zero to determine the derivative terms for the problem functions */ - MALLOC(y0, CUTEst_ncon, doublereal); + MALLOC(y0, CUTEst_ncon, rp_); for (i = 0; i < CUTEst_ncon; i++) { y0[i] = 0.0; } - MALLOC( A_val, CUTEst_nnza + nb, doublereal ); + MALLOC( A_val, CUTEst_nnza + nb, rp_ ); MALLOC( A_row, CUTEst_nnza + nb, integer ); MALLOC( A_col, CUTEst_nnza + nb, integer ); grlagf = FALSE_; /* Here, dummys will be set to nnza/nnzh again */ - CUTEST_csgrsh( &status, &CUTEst_nvar, &CUTEst_ncon, x0, y0, &grlagf, - &nnza_dummy, &CUTEst_nnza, A_val, A_col, A_row, - &nnzh_dummy, &CUTEst_nnzh, H_val, H_row, H_col ); + CUTEST_csgrsh_r( &status, &CUTEst_nvar, &CUTEst_ncon, x0, y0, &grlagf, + &nnza_dummy, &CUTEst_nnza, A_val, A_col, A_row, + &nnzh_dummy, &CUTEst_nnzh, H_val, H_row, H_col ); /* printf(" h_nnz = %d %d\n", nnzh_dummy, CUTEst_nnzh ); */ @@ -370,8 +372,8 @@ int MAINENTRY(void) { } } } else { - CUTEST_ugrsh( &status, &CUTEst_nvar, x0, g, - &nnzh_dummy, &CUTEst_nnzh, H_val, H_row, H_col ); + CUTEST_ugrsh_r( &status, &CUTEst_nvar, x0, g, + &nnzh_dummy, &CUTEst_nnzh, H_val, H_row, H_col ); } /* Convert H to 0-based indexing */ @@ -473,7 +475,7 @@ int MAINENTRY(void) { /* define Solver settings as default */ OSQPSettings * settings = (OSQPSettings *)c_malloc(sizeof(OSQPSettings)); - set_default_settings(settings); + osqp_set_default_settings(settings); /* Parameter settings are overwritten using any values stored in the OSQP.SPC file. The format of the file is parameter name at the start @@ -483,6 +485,12 @@ int MAINENTRY(void) { $OSQP/include/types.h for the parameter names and descriptions and $OSQP/include/constants.h for default values */ +#ifdef CUTEST_SINGLE + char pg[ ]="%g"; +#else + char pg[ ]="%lg"; +#endif + spec = fopen ("OSQP.SPC", "r") ; if ( spec != NULL ) { @@ -495,14 +503,14 @@ int MAINENTRY(void) { sl = strlen("rho") ; if (strncmp (s, "rho", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->rho = r_string ; continue ; } sl = strlen("sigma") ; if (strncmp (s, "sigma", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->sigma = r_string ; continue ; } @@ -531,7 +539,7 @@ int MAINENTRY(void) { sl = strlen("adaptive_rho_tolerance") ; if (strncmp (s, "adaptive_rho_tolerance", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->adaptive_rho_tolerance = r_string ; continue ; } @@ -539,7 +547,7 @@ int MAINENTRY(void) { sl = strlen("adaptive_rho_fraction") ; if (strncmp (s, "adaptive_rho_fraction", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->adaptive_rho_fraction = r_string ; continue ; } @@ -555,35 +563,35 @@ int MAINENTRY(void) { sl = strlen("eps_abs") ; if (strncmp (s, "eps_abs", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->eps_abs = r_string ; continue ; } sl = strlen("eps_rel") ; if (strncmp (s, "eps_rel", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->eps_rel = r_string ; continue ; } sl = strlen("eps_prim_inf") ; if (strncmp (s, "eps_prim_inf", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->eps_prim_inf = r_string ; continue ; } sl = strlen("eps_dual_inf") ; if (strncmp (s, "eps_dual_inf", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->eps_dual_inf = r_string ; continue ; } sl = strlen("alpha") ; if (strncmp (s, "alpha", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->alpha = r_string ; continue ; } @@ -598,7 +606,7 @@ int MAINENTRY(void) { sl = strlen("delta") ; if (strncmp (s, "delta", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->delta = r_string ; continue ; } @@ -649,7 +657,7 @@ int MAINENTRY(void) { sl = strlen("time_limit") ; if (strncmp (s, "time_limit", sl) == 0) { - sscanf (s+sl, "%lg", &r_string ); + sscanf (s+sl, pg, &r_string ); settings->time_limit = r_string ; continue ; } @@ -708,7 +716,7 @@ int MAINENTRY(void) { /* compute the residual A x */ - MALLOC( c, data->m, doublereal); + MALLOC( c, data->m, rp_); for (i = 0 ; i < data->m ; i++) c[i]=0.0; for (j = 0 ; j < data->n ; j++) { for (i = osqp_A_p[j] ; i < osqp_A_p[j+1] ; i++) { @@ -751,7 +759,7 @@ int MAINENTRY(void) { /* Get CUTEst statistics */ - CUTEST_creport( &status, calls, cpu); + CUTEST_creport_r( &status, calls, cpu); if (status) { printf("CUTEst error.\nAborting.\n"); exit(2); @@ -806,9 +814,9 @@ int MAINENTRY(void) { /* free CUTEst workspace */ if (constrained) { - CUTEST_cterminate( &status ); + CUTEST_cterminate_r( &status ); } else { - CUTEST_uterminate( &status ); + CUTEST_uterminate_r( &status ); } /* Cleanup */ @@ -829,7 +837,7 @@ int MAINENTRY(void) { for i=0:nnz-1 to compact sparse column format(row,val)[j] for j=ptr[i]:ptr[i+1]-1 and i=0:n-1 */ -void coo2csc(integer n, integer nz, doublereal *coo_val, integer *coo_row, +void coo2csc(integer n, integer nz, rp_ *coo_val, integer *coo_row, integer *coo_col, c_float *csr_val, c_int *csr_row, c_int *col_start) { @@ -890,8 +898,8 @@ void sort(c_int *ind, c_float *val, c_int start, c_int end) /* obtain information about the problem */ -void getinfo( integer n, integer m, doublereal *xl, doublereal *xu, - doublereal *cl, doublereal *cu, logical *equatn, +void getinfo( integer n, integer m, rp_ *xl, rp_ *xu, + rp_ *cl, rp_ *cu, logical *equatn, logical *linear, VarTypes *vartypes ) { int i; diff --git a/src/osqp/osqp_test.c b/src/osqp/osqp_test.c index 38035b5..70de0af 100644 --- a/src/osqp/osqp_test.c +++ b/src/osqp/osqp_test.c @@ -26,7 +26,7 @@ /* set default settings */ -void set_default_settings(OSQPSettings * settings) { +void osqp_set_default_settings(OSQPSettings * settings) { settings->scaling = SCALING; #if EMBEDDED != 1 settings->adaptive_rho = ADAPTIVE_RHO; @@ -56,7 +56,7 @@ void set_default_settings(OSQPSettings * settings) { settings->warm_start = WARM_START; #ifdef PROFILING settings->time_limit = TIME_LIMIT; -#ifdef PROFILING +#endif } /* dummy setup */ diff --git a/src/pds/makemaster b/src/pds/makemaster index aaca55c..dafa4c1 100644 --- a/src/pds/makemaster +++ b/src/pds/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst PDS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-29 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = PDS -package = pds - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = PDS +package = pds -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/pds/pds_main.f b/src/pds/pds_main.F similarity index 77% rename from src/pds/pds_main.f rename to src/pds/pds_main.F index fe5d28b..233c368 100644 --- a/src/pds/pds_main.f +++ b/src/pds/pds_main.F @@ -1,6 +1,12 @@ -C ( Last modified on 5 Jan 2013 at 14:30:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 16:00 GMT. - PROGRAM PDSMA +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM PDSMA + + USE CUTEST_KINDS_precision + IMPLICIT NONE C C PDS test driver for problems derived from SIF files. C @@ -8,25 +14,27 @@ PROGRAM PDSMA C January 1995, substantially modified September 1996 C Revised for CUTEst, Nick Gould, January 2013 - INTEGER :: i, cnt, debug, error, unique, maxitr, n - INTEGER :: ifact, type, resize, sss, status - INTEGER, PARAMETER :: input = 55, out = 6, inspec = 46 - INTEGER, PARAMETER :: indr = 46, res = 56, sch = 48 - INTEGER, PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: i, cnt, debug, error, unique, maxitr, n + INTEGER ( KIND = ip_ ) :: ifact, type, resize, sss, status + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: inspec = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: indr = 46, res = 56, sch = 48 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 C Nick - what are these? Presumably they relate to the dimension n? -CTOY INTEGER, PARAMETER :: dim = 10, imax = 2000 -CMED INTEGER, PARAMETER :: dim = 20, imax = 4000 - INTEGER, PARAMETER :: dim = 30, imax = 6000 - INTEGER, PARAMETER :: limit = ( dim + 2 ) * imax - DOUBLE PRECISION factor, fbest, scale, tol, length - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19 +CTOY INTEGER ( KIND = ip_ ), PARAMETER :: dim = 10, imax = 2000 +CMED INTEGER ( KIND = ip_ ), PARAMETER :: dim = 20, imax = 4000 + INTEGER ( KIND = ip_ ), PARAMETER :: dim = 30, imax = 6000 + INTEGER ( KIND = ip_ ), PARAMETER :: limit = ( dim + 2 ) * imax + REAL ( KIND = rp_ ) factor, fbest, scale, tol, length + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ CHARACTER ( LEN = 10 ) :: pname LOGICAL :: bounds - INTEGER :: SCHEME( limit ), LIST( limit ), INDEX( limit ) - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - DOUBLE PRECISION WORK( dim ), S( dim * ( dim + 1 ) ) - DOUBLE PRECISION WORK1( - 3 : dim + 1 ), WORK2( - 3 : dim + 1 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU + INTEGER ( KIND = ip_ ) :: SCHEME( limit ), LIST( limit ) + INTEGER ( KIND = ip_ ) :: INDEX( limit ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ) WORK( dim ), S( dim * ( dim + 1 ) ) + REAL ( KIND = rp_ ) WORK1( - 3 : dim + 1 ), WORK2( - 3 : dim + 1 ) + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES EXTERNAL :: pds_evalf @@ -75,7 +83,7 @@ PROGRAM PDSMA C find the problem dimension - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 C allocate workspace @@ -85,13 +93,14 @@ PROGRAM PDSMA C set up SIF data - CALL CUTEST_usetup( status, INPUT, out, io_buffer, N, X, BL, BU ) + CALL CUTEST_usetup_r( status, INPUT, out, io_buffer, + * N, X, BL, BU ) IF ( status /= 0 ) GO TO 910 CLOSE( input ) C obtain variable names - CALL CUTEST_unames( status, n, pname, XNAMES ) + CALL CUTEST_unames_r( status, n, pname, XNAMES ) IF ( status /= 0 ) GO TO 910 C set up algorithmic input data @@ -161,7 +170,7 @@ PROGRAM PDSMA C C Write results on the standard output C - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 WRITE ( out, 2000 ) pname, n, CALLS( 1 ), error, fbest, * CPU( 1 ), CPU( 2 ) @@ -212,11 +221,12 @@ PROGRAM PDSMA END SUBROUTINE PDS_evalf( n, X, f ) - INTEGER :: n - DOUBLE PRECISION :: f, X( n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ufn( status, n, X, f ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: f, X( n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ufn_r( status, n, X, f ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status diff --git a/src/pds/pds_test.F b/src/pds/pds_test.F new file mode 100644 index 0000000..dce7f8a --- /dev/null +++ b/src/pds/pds_test.F @@ -0,0 +1,46 @@ +C THIS VERSION: CUTEST 2.2 - 2023-11-29 AT 16:00 GMT. + +#include "cutest_modules.h" + +C Dummy SEARCH etc testing pds_main interface to CUTEst +C Nick Gould, 5th January 2013 + + SUBROUTINE SEARCH(N,OUT,MAX,SCHEME,INDEX,LIST,UNIQUE,FACTOR,ERROR) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: N, MAX, OUT, UNIQUE, FACTOR, ERROR + INTEGER ( KIND = ip_ ) :: SCHEME(-1:N,-N:((MAX-N*N-3*N-2)/(N+2))) + INTEGER ( KIND = ip_ ) :: INDEX(-N:((MAX-N*N-3*N-2)/(N+2))) + INTEGER ( KIND = ip_ ) :: LIST((MAX-N*N-3*N-2)/(N+2)) + unique = 1 + factor = 1 + error = 0 + RETURN + END + + SUBROUTINE GETSS(N,IN,SSS,SCHEME,FACTOR,RESIZE,ERROR) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: N, IN, SSS, SCHEME(-1:N,SSS) + INTEGER ( KIND = ip_ ) :: RESIZE, ERROR + REAL ( KIND = rp_ ) :: FACTOR + error = 0 + RETURN + END + + SUBROUTINE PDS(N,LPR,TYPE,SCALE,DEBUG,TOL,MAXITR,SSS,FCN,FACTOR, + * SCHEME,RESIZE,S,INDEX,FBEST,LENGTH,COUNT,EDGE,C,PLUS) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: N, LPR, TYPE, DEBUG, MAXITR, SSS, COUNT + INTEGER ( KIND = ip_ ) :: SCHEME(-1:N,SSS), RESIZE, INDEX(N+1) + REAL ( KIND = rp_ ) SCALE, TOL, FACTOR, S(N,N+1), FBEST, LENGTH + REAL ( KIND = rp_ ) EDGE(N), C(-3:N+1), PLUS(-3:N+1) + EXTERNAL :: FCN + CALL FCN( n, S(1,1), FBEST ) + RETURN + END + + SUBROUTINE RESULT(N,COUNT,S,FBEST,INDEX,OUT) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: N, COUNT, INDEX(N+1), OUT + REAL ( KIND = rp_ ) :: S(N,N+1), FBEST + RETURN + END diff --git a/src/pds/pds_test.f b/src/pds/pds_test.f deleted file mode 100644 index 4b2453b..0000000 --- a/src/pds/pds_test.f +++ /dev/null @@ -1,39 +0,0 @@ -C ( Last modified on 5 Jan 2013 at 17:10:00 ) - -C Dummy SEARCH etc testing pds_main interface to CUTEst -C Nick Gould, 5th January 2013 - - SUBROUTINE SEARCH(N,OUT,MAX,SCHEME,INDEX,LIST,UNIQUE,FACTOR,ERROR) - INTEGER :: N, MAX, OUT, UNIQUE, FACTOR, ERROR - INTEGER :: SCHEME(-1:N,-N:((MAX-N*N-3*N-2)/(N+2))) - INTEGER :: INDEX(-N:((MAX-N*N-3*N-2)/(N+2))) - INTEGER :: LIST((MAX-N*N-3*N-2)/(N+2)) - unique = 1 - factor = 1 - error = 0 - RETURN - END - - SUBROUTINE GETSS(N,IN,SSS,SCHEME,FACTOR,RESIZE,ERROR) - INTEGER :: N, IN, SSS, SCHEME(-1:N,SSS), RESIZE, ERROR - DOUBLE PRECISION :: FACTOR - error = 0 - RETURN - END - - SUBROUTINE PDS(N,LPR,TYPE,SCALE,DEBUG,TOL,MAXITR,SSS,FCN,FACTOR, - * SCHEME,RESIZE,S,INDEX,FBEST,LENGTH,COUNT,EDGE,C,PLUS) - INTEGER :: N, LPR, TYPE, DEBUG, MAXITR, SSS - INTEGER :: SCHEME(-1:N,SSS), RESIZE, INDEX(N+1), COUNT - DOUBLE PRECISION SCALE, TOL, FACTOR, S(N,N+1), FBEST, LENGTH - DOUBLE PRECISION EDGE(N), C(-3:N+1), PLUS(-3:N+1) - EXTERNAL :: FCN - CALL FCN( n, S(1,1), FBEST ) - RETURN - END - - SUBROUTINE RESULT(N,COUNT,S,FBEST,INDEX,OUT) - INTEGER :: N, COUNT, INDEX(N+1), OUT - DOUBLE PRECISION :: S(N,N+1), FBEST - RETURN - END diff --git a/src/pennlp/makemaster b/src/pennlp/makemaster index 97a2294..7c2062c 100644 --- a/src/pennlp/makemaster +++ b/src/pennlp/makemaster @@ -1,143 +1,37 @@ # Main body of the installation makefile for CUTEst PENNLP interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 28 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = PENNLP -package = pennlp - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - echo "$(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = PENNLP +package = pennlp -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/pennlp/pennlp_main.f b/src/pennlp/pennlp_main.F similarity index 73% rename from src/pennlp/pennlp_main.f rename to src/pennlp/pennlp_main.F index 25c8fba..57583df 100644 --- a/src/pennlp/pennlp_main.f +++ b/src/pennlp/pennlp_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 28 Feb 2013 at 09:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM PENNLP_main @@ -10,22 +13,23 @@ PROGRAM PENNLP_main C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + USE CUTEST_KINDS_precision IMPLICIT none C Set up parameters, variables and arrays required by constrained tools - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: alloc_stat, status, i, m, m_lin, pennlp_status - INTEGER :: IOPTIONS( 17 ), IRESULTS( 4 ) - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0, half = 5.0D-1 - DOUBLE PRECISION, PARAMETER :: cutest_inf = 1.0D+19 - DOUBLE PRECISION, PARAMETER :: pennlp_inf = 2.0D+38 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) - DOUBLE PRECISION :: DOPTIONS( 13 ), DRESULTS( 5 ) + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, out = 6 + INTEGER ( KIND = ip_ ) :: alloc_stat, status, i, m, m_lin + INTEGER ( KIND = ip_ ) :: pennlp_status + INTEGER ( KIND = ip_ ) :: IOPTIONS( 17 ), IRESULTS( 4 ) + REAL ( KIND = rp_ ), PARAMETER :: cutest_inf = 1.0E+19_rp_ + REAL ( KIND = rp_ ), PARAMETER :: pennlp_inf = 2.0E+38_rp_ + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) + REAL ( KIND = rp_ ) :: DOPTIONS( 13 ), DRESULTS( 5 ) CHARACTER * 10 :: pname - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X_l, X_u, X - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: C_l, C_u, Y + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X_l, X_u, X + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: C_l, C_u, Y LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: X_names EXTERNAL :: PENNLP_evalof, PENNLP_evalog, PENNLP_evaloh @@ -33,7 +37,7 @@ PROGRAM PENNLP_main C common needed to pass assumed size array dimensions - INTEGER :: n, max_nnzg, max_nnzh + INTEGER ( KIND = ip_ ) :: n, max_nnzg, max_nnzh COMMON / PENNLP_common / n, max_nnzg, max_nnzh SAVE / PENNLP_common / @@ -91,7 +95,7 @@ PROGRAM PENNLP_main C Determine the number of variables and constraints - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C Allocate suitable arrays @@ -104,7 +108,7 @@ PROGRAM PENNLP_main C Set up the data structures necessary to hold the group partially C separable function. - CALL CUTEST_csetup( status, input, out, io_buffer, + CALL CUTEST_csetup_r( status, input, out, io_buffer, & n, m, X, X_l, X_u, & Y, C_l, C_u, EQUATN, LINEAR, 0, 2, 0 ) IF ( status /= 0 ) GO TO 910 @@ -132,12 +136,12 @@ PROGRAM PENNLP_main C how many nonzeros are there in the Hessian of the Lagrangian max_nnzg = n - CALL CUTEST_cdimsh( status, max_nnzh ) + CALL CUTEST_cdimsh_r( status, max_nnzh ) IF ( status /= 0 ) GO TO 910 C Determine the name of the problem - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) IF ( status /= 0 ) GO TO 910 C WRITE( out, "( /, ' Problem: ', A10 )" ) pname @@ -153,9 +157,9 @@ PROGRAM PENNLP_main C Output final objective function value and timing information IF ( out .GT. 0 ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( pennlp_status >= 0 .AND. pennlp_status <= 2 ) THEN - CALL CUTEST_varnames( status, n, X_names ) + CALL CUTEST_varnames_r( status, n, X_names ) IF ( status /= 0 ) GO TO 910 WRITE( out,"(' Objective function value:', ES12.4 )" ) & DRESULTS( 1 ) @@ -169,7 +173,7 @@ PROGRAM PENNLP_main & CPU( 1 ), CPU( 2 ) END IF DEALLOCATE( X, X_l, X_u, C_l, C_u, Y, x_names, STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE @@ -205,23 +209,24 @@ SUBROUTINE PENNLP_evalof( X, f ) C compute f(x) - DOUBLE PRECISION :: f - DOUBLE PRECISION :: X( * ) + USE CUTEST_KINDS_precision + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ) :: X( * ) C local variables - INTEGER :: nnzg, status - INTEGER :: G_var( 0 ) - DOUBLE PRECISION :: G_val( 0 ) + INTEGER ( KIND = ip_ ) :: nnzg, status + INTEGER ( KIND = ip_ ) :: G_var( 0 ) + REAL ( KIND = rp_ ) :: G_val( 0 ) C common needed to pass assumed size array dimensions - INTEGER :: n, max_nnzg, max_nnzh + INTEGER ( KIND = ip_ ) :: n, max_nnzg, max_nnzh COMMON / PENNLP_common / n, max_nnzg, max_nnzh C evaluate f - CALL CUTEST_cofsg( status, n, X, f, nnzg, 0, G_val, G_var, + CALL CUTEST_cofsg_r( status, n, X, f, nnzg, 0, G_val, G_var, & .FALSE. ) C check for errors @@ -240,24 +245,25 @@ SUBROUTINE PENNLP_evalog( X, nnzg, G_var, G_val ) C compute nabla_x f(x) in sparse format - INTEGER :: nnzg - INTEGER :: G_var( * ) - DOUBLE PRECISION :: X( * ), G_val( * ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: nnzg + INTEGER ( KIND = ip_ ) :: G_var( * ) + REAL ( KIND = rp_ ) :: X( * ), G_val( * ) C local variables - INTEGER :: status - DOUBLE PRECISION :: f + INTEGER ( KIND = ip_ ) :: status + REAL ( KIND = rp_ ) :: f C common needed to pass assumed size array dimensions - INTEGER :: n, lg, lh + INTEGER ( KIND = ip_ ) :: n, lg, lh COMMON / PENNLP_common / n, lg, lh C evaluate the gradient - CALL CUTEST_cofsg( status, n, X, f, nnzg, lg, G_val, G_var, - & .TRUE. ) + CALL CUTEST_cofsg_r( status, n, X, f, nnzg, lg, G_val, G_var, + & .TRUE. ) C check for errors @@ -275,23 +281,24 @@ SUBROUTINE PENNLP_evaloh( X, nnzh, H_row, H_col, H_val ) C compute nabla_xx f(x) in sparse format - INTEGER :: nnzh - INTEGER :: H_row( * ), H_col( * ) - DOUBLE PRECISION :: X( * ), H_val( * ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: nnzh + INTEGER ( KIND = ip_ ) :: H_row( * ), H_col( * ) + REAL ( KIND = rp_ ) :: X( * ), H_val( * ) C local variables - INTEGER :: status + INTEGER ( KIND = ip_ ) :: status C common needed to pass assumed size array dimensions - INTEGER :: n, lg, lh + INTEGER ( KIND = ip_ ) :: n, lg, lh COMMON / PENNLP_common / n, lg, lh C evaluate the Hessian - CALL CUTEST_cish( status, n, X, 0, - & nnzh, lh, H_val, H_col, H_row ) + CALL CUTEST_cish_r( status, n, X, 0, + & nnzh, lh, H_val, H_col, H_row ) C check for errors @@ -309,25 +316,26 @@ SUBROUTINE PENNLP_evalcf( i, X, ci ) C compute c_i(x) - INTEGER :: i - DOUBLE PRECISION :: ci - DOUBLE PRECISION :: X( * ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: i + REAL ( KIND = rp_ ) :: ci + REAL ( KIND = rp_ ) :: X( * ) C local variables - INTEGER :: nnzgci, status - INTEGER :: GCI_var( 0 ) - DOUBLE PRECISION :: GCI_val( 0 ) + INTEGER ( KIND = ip_ ) :: nnzgci, status + INTEGER ( KIND = ip_ ) :: GCI_var( 0 ) + REAL ( KIND = rp_ ) :: GCI_val( 0 ) C common needed to pass assumed size array dimensions - INTEGER :: n, max_nnzg, max_nnzh + INTEGER ( KIND = ip_ ) :: n, max_nnzg, max_nnzh COMMON / PENNLP_common / n, max_nnzg, max_nnzh C evaluate the constraint function - CALL CUTEST_ccifsg( status, n, i + 1, X, ci, - & nnzgci, 0, GCI_val, GCI_var, .FALSE. ) + CALL CUTEST_ccifsg_r( status, n, i + 1, X, ci, + & nnzgci, 0, GCI_val, GCI_var, .FALSE. ) C check for errors @@ -345,24 +353,25 @@ SUBROUTINE PENNLP_evalcg( i, X, nnzgci, GCI_var, GCI_val ) C compute nabla_x c_i(x) in sparse format - INTEGER :: i, nnzgci - INTEGER :: GCI_var( * ) - DOUBLE PRECISION :: X( * ), GCI_val( * ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: i, nnzgci + INTEGER ( KIND = ip_ ) :: GCI_var( * ) + REAL ( KIND = rp_ ) :: X( * ), GCI_val( * ) C local variables - INTEGER :: status - DOUBLE PRECISION :: ci + INTEGER ( KIND = ip_ ) :: status + REAL ( KIND = rp_ ) :: ci C common needed to pass assumed size array dimensions - INTEGER :: n, lg, lh + INTEGER ( KIND = ip_ ) :: n, lg, lh COMMON / PENNLP_common / n, lg, lh C evaluate the gradient - CALL CUTEST_ccifsg( status, n, i + 1, X, ci, - & nnzgci, lg, GCI_val, GCI_var, .TRUE. ) + CALL CUTEST_ccifsg_r( status, n, i + 1, X, ci, + & nnzgci, lg, GCI_val, GCI_var, .TRUE. ) C check for errors @@ -380,23 +389,24 @@ SUBROUTINE PENNLP_evalch( i, X, nnzh, H_row, H_col, H_val ) C compute nabla_xx c_i(x) in sparse format - INTEGER :: i, nnzh - INTEGER :: H_row( * ), H_col( * ) - DOUBLE PRECISION :: X( * ), H_val( * ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: i, nnzh + INTEGER ( KIND = ip_ ) :: H_row( * ), H_col( * ) + REAL ( KIND = rp_ ) :: X( * ), H_val( * ) C local variables - INTEGER :: status + INTEGER ( KIND = ip_ ) :: status C common needed to pass assumed size array dimensions - INTEGER :: n, lg, lh + INTEGER ( KIND = ip_ ) :: n, lg, lh COMMON / PENNLP_common / n, lg, lh C evaluate the Hessian - CALL CUTEST_cish( status, n, X, i + 1, - & nnzh, lh, H_val, H_col, H_row ) + CALL CUTEST_cish_r( status, n, X, i + 1, + & nnzh, lh, H_val, H_col, H_row ) C check for errors diff --git a/src/pennlp/pennlp_test.f b/src/pennlp/pennlp_test.F similarity index 62% rename from src/pennlp/pennlp_test.f rename to src/pennlp/pennlp_test.F index e829146..b4924df 100644 --- a/src/pennlp/pennlp_test.f +++ b/src/pennlp/pennlp_test.F @@ -1,6 +1,10 @@ -! ( Last modified on 28 Feb 2013 at 15:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" ! Dummy PENNLPF for testing pennlp_main interface to CUTEst + ! Nick Gould, 28th February 2013 SUBROUTINE PENNLPF( n, m_lin, m, nnzg, nnzh, @@ -9,18 +13,18 @@ SUBROUTINE PENNLPF( n, m_lin, m, nnzg, nnzh, & PENNON_evalcf, PENNON_evalcg, PENNON_evalch, & IOPTIONS, DOPTIONS, IRESULTS, DRESULTS, & status ) - INTEGER :: n, m_lin, m, nnzg, nnzh, status - INTEGER :: IOPTIONS( 17 ), IRESULTS( 4 ) - DOUBLE PRECISION, DIMENSION( n ) :: X, X_l, X_u - DOUBLE PRECISION, DIMENSION( m ) :: Y, C_l, C_u - DOUBLE PRECISION :: DOPTIONS( 13 ), DRESULTS( 5 ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, m_lin, m, nnzg, nnzh, status + INTEGER ( KIND = ip_ ) :: IOPTIONS( 17 ), IRESULTS( 4 ) + REAL ( KIND = rp_ ), DIMENSION( n ) :: X, X_l, X_u + REAL ( KIND = rp_ ), DIMENSION( m ) :: Y, C_l, C_u + REAL ( KIND = rp_ ) :: DOPTIONS( 13 ), DRESULTS( 5 ) EXTERNAL :: PENNON_evalof, PENNON_evalog, PENNON_evaloh EXTERNAL :: PENNON_evalcf, PENNON_evalcg, PENNON_evalch -C local variables - DOUBLE PRECISION :: c C automatic arrays - INTEGER :: G_var( nnzg ), H_row( nnzh ), H_col( nnzh ) - DOUBLE PRECISION :: G_val( nnzg ), H_val( nnzh ) + INTEGER ( KIND = ip_ ) :: G_var( nnzg ) + INTEGER ( KIND = ip_ ) :: H_row( nnzh ), H_col( nnzh ) + REAL ( KIND = rp_ ) :: G_val( nnzg ), H_val( nnzh ) C trial calls CALL PENNON_evalof( X, DRESULTS( 1 ) ) CALL PENNON_evalog( X, nnzg, G_var, G_val ) @@ -32,10 +36,10 @@ SUBROUTINE PENNLPF( n, m_lin, m, nnzg, nnzh, IRESULTS( 2 ) = 0 IRESULTS( 3 ) = 0 IRESULTS( 4 ) = 0 - DRESULTS( 2 ) = 1.0D0 + DRESULTS( 2 ) = 1.0_rp_ DRESULTS( 4 ) = Y( 1 ) * DRESULTS( 3 ) DRESULTS( 3 ) = ABS( DRESULTS( 3 ) ) - DRESULTS( 5 ) = 1.0D0 + DRESULTS( 5 ) = 1.0_rp_ status = 5 RETURN END diff --git a/src/praxis/makemaster b/src/praxis/makemaster index 3d674c8..93eda45 100644 --- a/src/praxis/makemaster +++ b/src/praxis/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst PRAXIS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = PRAXIS -package = praxis - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = PRAXIS +package = praxis -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/praxis/praxis_main.f b/src/praxis/praxis_main.F similarity index 71% rename from src/praxis/praxis_main.f rename to src/praxis/praxis_main.F index a300488..1f99e2c 100644 --- a/src/praxis/praxis_main.f +++ b/src/praxis/praxis_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 6 Jan 2013 at 12:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM PRAXIS_main @@ -8,21 +11,21 @@ PROGRAM PRAXIS_main C January 1996. C Revised for CUTEst, Nick Gould, January 2013 - INTEGER :: n, nl, nf, lp, jprint, illcin, ktm, i - INTEGER :: nfmax, jranch, nmx, status + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, nl, nf, lp, jprint, illcin, ktm, i + INTEGER ( KIND = ip_ ) :: nfmax, jranch, nmx, status C Nick - stupid use of common does not allow allocatable arrays - INTEGER, PARAMETER :: nmax = 1000 - INTEGER, PARAMETER :: input = 55, out = 6, inspec = 46 - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION :: dmin, epsmch, fx, h, qd0, qd1, qf1 - DOUBLE PRECISION :: small, t, xldt, xm2, xm4, dseed, scbd - DOUBLE PRECISION, PARAMETER :: one = 1.0D0 + INTEGER ( KIND = ip_ ), PARAMETER :: nmax = 1000 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, inspec = 46 + REAL ( KIND = rp_ ) :: dmin, epsmch, fx, h, qd0, qd1, qf1 + REAL ( KIND = rp_ ) :: small, t, xldt, xm2, xm4, dseed, scbd CHARACTER ( LEN = 10 ) :: pname - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - DOUBLE PRECISION, DIMENSION( nmax ) :: X, D, Q0, Q1 - DOUBLE PRECISION, DIMENSION( nmax, nmax ) :: V + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ), DIMENSION( nmax ) :: X, D, Q0, Q1 + REAL ( KIND = rp_ ), DIMENSION( nmax, nmax ) :: V CHARACTER ( LEN = 10 ), DIMENSION( nmax ) :: XNAMES - DOUBLE PRECISION :: PRAXIS_evalf + REAL ( KIND = rp_ ) :: PRAXIS_evalf EXTERNAL :: PRAXIS_evalf COMMON / CPRAX / V, X, D, Q0, Q1, dmin, epsmch, fx, h, qd0, qd1, * qf1, small, t, xldt, xm2, xm4, dseed, scbd, n, @@ -37,24 +40,24 @@ PROGRAM PRAXIS_main C h is an estimate of the distance from the initial point C to the solution. - h = one + h = 1.0_rp_ C epsmch is the smallest floating point (real or double precision) C number which, when added to one, gives a result greater than one. - epsmch = EPSILON( one ) + epsmch = EPSILON( 1.0_rp_ ) C JRANCH = 1 to use BRENT's random, C JRANCH = 2 to use function DRANDM. jranch = 1 - CALL RANINI( 4.0D+0 ) + CALL RANINI( 4.0_rp_ ) C DSEED is an initial seed for DRANDM, C a subroutine that generates pseudorandom numbers C uniformly distributed on (0,1). - dseed = 1234567.0D+0 + dseed = 1234567.0_rp_ C open the Spec file for the method. @@ -86,7 +89,7 @@ PROGRAM PRAXIS_main C find the problem dimension - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 IF ( n > nmax ) GO TO 990 @@ -96,13 +99,14 @@ PROGRAM PRAXIS_main C set up SIF data - CALL CUTEST_usetup( status, input, out, io_buffer, n, X, Q0, Q1 ) + CALL CUTEST_usetup_r( status, input, out, io_buffer, + * n, X, Q0, Q1 ) IF ( status /= 0 ) GO TO 910 CLOSE( input ) C obtain variable names - CALL CUTEST_unames( status, N, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, N, PNAME, XNAMES ) IF ( status /= 0 ) GO TO 910 C call the optimizer @@ -112,7 +116,7 @@ PROGRAM PRAXIS_main C exit. Unfortunately, PRAXIS does not provide any termination C status to flag a successful call - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 WRITE ( out, 2010 ) DO 40 i = 1, n @@ -148,12 +152,13 @@ PROGRAM PRAXIS_main * ' nmax = ', I0, ', stopping' ) END - DOUBLE PRECISION FUNCTION PRAXIS_evalf( X, n ) - INTEGER :: n - DOUBLE PRECISION X( n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ufn( status, n, X, PRAXIS_evalf ) + REAL ( KIND = rp_ ) FUNCTION PRAXIS_evalf( X, n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) X( n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ufn_r( status, n, X, PRAXIS_evalf ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status diff --git a/src/praxis/praxis_test.F b/src/praxis/praxis_test.F new file mode 100644 index 0000000..94fc56d --- /dev/null +++ b/src/praxis/praxis_test.F @@ -0,0 +1,33 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy PRAXIS etc testing praxis_main interface to CUTEst + +C Nick Gould, 6th January 2013 + + SUBROUTINE PRAXIS( EVALF ) + USE CUTEST_KINDS_precision + EXTERNAL :: EVALF + COMMON / CPRAX / V, X, D, Q0, Q1, dmin, epsmch, fx, h, qd0, qd1, + * qf1, small, t, xldt, xm2, xm4, dseed, scbd, n, + * nl, nf, lp, jprint, nmx, illcin, ktm, nfmax, + * jranch + INTEGER ( KIND = ip_ ), PARAMETER :: nmax = 1000 + INTEGER ( KIND = ip_ ) :: n, nl, nf, lp, jprint, illcin, ktm, i + INTEGER ( KIND = ip_ ) :: nfmax, jranch, nmx, status + REAL ( KIND = rp_ ) :: dmin, epsmch, fx, h, qd0, qd1, qf1 + REAL ( KIND = rp_ ) :: small, t, xldt, xm2, xm4, dseed, scbd + REAL ( KIND = rp_ ), DIMENSION( nmax ) :: X, D, Q0, Q1 + REAL ( KIND = rp_ ), DIMENSION( nmax, nmax ) :: V + REAL ( KIND = rp_ ) :: PRAXIS_evalf + EXTERNAL :: PRAXIS_evalf + fx = PRAXIS_evalf( X( : n ), n ) + RETURN + END + + SUBROUTINE RANINI( rvalue ) + USE CUTEST_KINDS_precision + REAL ( KIND = rp_ ) :: rvalue + RETURN + END diff --git a/src/praxis/praxis_test.f b/src/praxis/praxis_test.f deleted file mode 100644 index b6fca82..0000000 --- a/src/praxis/praxis_test.f +++ /dev/null @@ -1,28 +0,0 @@ -C ( Last modified on 6 Jan 2013 at 12:10:00 ) - -C Dummy PRAXIS etc testing praxis_main interface to CUTEst -C Nick Gould, 6th January 2013 - - SUBROUTINE PRAXIS( EVALF ) - EXTERNAL :: EVALF - COMMON / CPRAX / V, X, D, Q0, Q1, dmin, epsmch, fx, h, qd0, qd1, - * qf1, small, t, xldt, xm2, xm4, dseed, scbd, n, - * nl, nf, lp, jprint, nmx, illcin, ktm, nfmax, - * jranch - INTEGER, PARAMETER :: nmax = 1000 - INTEGER :: n, nl, nf, lp, jprint, illcin, ktm, i - INTEGER :: nfmax, jranch, nmx, status - DOUBLE PRECISION :: dmin, epsmch, fx, h, qd0, qd1, qf1 - DOUBLE PRECISION :: small, t, xldt, xm2, xm4, dseed, scbd - DOUBLE PRECISION, DIMENSION( nmax ) :: X, D, Q0, Q1 - DOUBLE PRECISION, DIMENSION( nmax, nmax ) :: V - DOUBLE PRECISION :: PRAXIS_evalf - EXTERNAL :: PRAXIS_evalf - fx = PRAXIS_evalf( X( : n ), n ) - RETURN - END - - SUBROUTINE RANINI( rvalue ) - DOUBLE PRECISION :: rvalue - RETURN - END diff --git a/src/ql/makemaster b/src/ql/makemaster index 00ffdcb..ed778f7 100644 --- a/src/ql/makemaster +++ b/src/ql/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst QL interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 20 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = QL -package = ql - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = QL +package = ql -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_qp_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/ql/ql_main.f b/src/ql/ql_main.F similarity index 79% rename from src/ql/ql_main.f rename to src/ql/ql_main.F index eb768c7..304b923 100644 --- a/src/ql/ql_main.f +++ b/src/ql/ql_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 20 Feb 2013 at 12:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM LQ_main @@ -12,20 +15,23 @@ PROGRAM LQ_main C Set up parameters, variables and arrays required by constrained tools - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: liwork, lwork, i, j, alloc_stat, status - INTEGER :: n, m, m_e, iprint, ifail, lu, la1, lh1, lj1, m_total - DOUBLE PRECISION :: f, eps, t - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0, half = 5.0D-1 - DOUBLE PRECISION, PARAMETER :: infinity = 1.0D+19 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) + USE CUTEST_KINDS_precision + + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, out = 6 + INTEGER ( KIND = ip_ ) :: liwork, lwork, i, j, alloc_stat, status + INTEGER ( KIND = ip_ ) :: n, m, m_e, iprint, ifail, lu + INTEGER ( KIND = ip_ ) :: la1, lh1, lj1, m_total + REAL ( KIND = rp_ ) :: f, eps, t + REAL ( KIND = rp_ ), PARAMETER :: infinity = 1.0E+19_rp_ + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) CHARACTER * 10 pname - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IWORK - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u, X0 - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: C, C_l, C_u, Y - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: U, B, G, WORK - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : , : ) :: A, H, J_val + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IWORK + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u, U + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: C, C_l, C_u, Y + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X0, B, G, WORK + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , : ) :: A, H + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , : ) :: J_val LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: X_names @@ -37,7 +43,7 @@ PROGRAM LQ_main C Determine the number of variables and constraints - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C Set workspace dimensions @@ -56,7 +62,7 @@ PROGRAM LQ_main C Set up the data structures necessary to hold the group partially C separable function. - CALL CUTEST_csetup( status, input, out, io_buffer, + CALL CUTEST_csetup_r( status, input, out, io_buffer, & n, m, X, X_l, X_u, & Y, C_l, C_u, EQUATN, LINEAR, 1, 0, 0 ) IF ( status /= 0 ) GO TO 910 @@ -78,7 +84,7 @@ PROGRAM LQ_main C Determine the name of the problem - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) IF ( status /= 0 ) GO TO 910 C WRITE( out, "( /, ' Problem: ', A10 )" ) pname @@ -91,23 +97,23 @@ PROGRAM LQ_main C Set X0 to zero to determine the constant terms for the problem functions - X0 = zero + X0 = 0.0_rp_ C Evaluate the constant terms of the objective (f) and constraint C functions (C) - CALL CUTEST_cfn( status, n, m, X0, f, C( : m ) ) + CALL CUTEST_cfn_r( status, n, m, X0, f, C( : m ) ) IF ( status /= 0 ) GO TO 910 C Evaluate the linear terms of the constraint functions - CALL CUTEST_cgr( status, n, m, X0, Y, .FALSE., G, .FALSE., + CALL CUTEST_cgr_r( status, n, m, X0, Y, .FALSE., G, .FALSE., & lj1, n, J_val ) IF ( status /= 0 ) GO TO 910 C Evaluate the Hessian of the Lagrangian function at the initial point - CALL CUTEST_cdh( status, n, m, X0, Y, lh1, H ) + CALL CUTEST_cdh_r( status, n, m, X0, Y, lh1, H ) IF ( status /= 0 ) GO TO 910 DEALLOCATE( X0, LINEAR ) @@ -169,23 +175,23 @@ PROGRAM LQ_main C Final objective function value - f = zero + f = 0.0_rp_ IF ( ifail == 0 ) THEN DO i = 1, n - t = zero + t = 0.0_rp_ DO j = 1, n t = t + H( i, j ) * X( j ) ENDDO - f = f + ( half * t + G( i ) ) * X( i ) + f = f + ( 0.5_rp_ * t + G( i ) ) * X( i ) ENDDO ENDIF C Output final objective function value and timing information IF ( out .GT. 0 ) THEN - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( ifail == 0 ) THEN - CALL CUTEST_varnames( status, n, X_names ) + CALL CUTEST_varnames_r( status, n, X_names ) IF ( status /= 0 ) GO TO 910 WRITE( out,"(' Objective function value:', ES12.4 )" ) f WRITE ( out, "( /, ' Solution:', @@ -200,7 +206,7 @@ PROGRAM LQ_main END IF DEALLOCATE( X, X_l, X_u, U, G, A, H, WORK, IWORK, STAT = status ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP 910 CONTINUE diff --git a/src/ql/ql_test.F b/src/ql/ql_test.F new file mode 100644 index 0000000..2b22315 --- /dev/null +++ b/src/ql/ql_test.F @@ -0,0 +1,22 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +! Dummy QL for testing ql_main interface to CUTEst + +! Nick Gould, 20th February 2013 + + SUBROUTINE QL( m, me, mmax, n, nmax, mnn, C, D, A, B, + & XL, XU, X, U, eps, mode, iout, ifail, iprint, + & WAR, lwar, IWAR, liwar ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: m, me, iout, mode, ifail, iprint + INTEGER ( KIND = ip_ ) :: nmax, mmax, n, mnn, lwar, liwar + INTEGER ( KIND = ip_ ) :: IWAR( liwar ) + REAL ( KIND = rp_ ) :: eps + REAL ( KIND = rp_ ) :: C( nmax, n ), D( n ), B( mmax ), U( mnn ) + REAL ( KIND = rp_ ) :: XL( n ), XU( n ), X( n ), WAR( lwar ) + REAL ( KIND = rp_ ) :: A( mmax, n ) + ifail = 1 + RETURN + END diff --git a/src/ql/ql_test.f b/src/ql/ql_test.f deleted file mode 100644 index c247e69..0000000 --- a/src/ql/ql_test.f +++ /dev/null @@ -1,17 +0,0 @@ -! ( Last modified on 20 Feb 2013 at 15:50:00 ) - -! Dummy QL for testing ql_main interface to CUTEst -! Nick Gould, 20th February 2013 - - SUBROUTINE QL( m, me, mmax, n, nmax, mnn, C, D, A, B, - & XL, XU, X, U, eps, mode, iout, ifail, iprint, - & WAR, lwar, IWAR, liwar ) - INTEGER :: m, me, iout, mode, ifail, iprint - INTEGER :: nmax, mmax, n, mnn, lwar, liwar - INTEGER :: IWAR( liwar ) - DOUBLE PRECISION :: eps - DOUBLE PRECISION :: C( nmax, n ), D( n ), A( mmax, n ), B( mmax ) - DOUBLE PRECISION :: XL( n ), XU( n ),X( n ), U( mnn ), WAR( lwar ) - ifail = 1 - RETURN - END diff --git a/src/qplib/makemaster b/src/qplib/makemaster index b29fadc..c4c6723 100644 --- a/src/qplib/makemaster +++ b/src/qplib/makemaster @@ -1,131 +1,37 @@ # Main body of the installation makefile for CUTEst QPLIB interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 7 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = QPLIB -package = qplib - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -#all: qplib -all: tools $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +PACKAGE = QPLIB +package = qplib -# run example tests +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -run_test: tools test_cutest_constrained $(package) - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test < ../$(package)/c_test.input \ - >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - cat ../$(package)/ALLINITC.aug - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +# include standard CUTEst makefile definitions -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/qplib/qplib_main.f90 b/src/qplib/qplib_main.F90 similarity index 88% rename from src/qplib/qplib_main.f90 rename to src/qplib/qplib_main.F90 index 81ce69d..2456026 100644 --- a/src/qplib/qplib_main.f90 +++ b/src/qplib/qplib_main.F90 @@ -1,4 +1,6 @@ -! THIS VERSION: CUTEST 1.1 - 16/01/2014 AT 10:15 GMT. +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 14:20 GMT. + +#include "cutest_modules.h" !-*-*-*-*-*-*- C U T E S T q p l i b _ m a i n P R O G R A M -*-*-*-*-*- @@ -10,41 +12,34 @@ PROGRAM CUTEST_qplib_main ! History - ! fortran 2003 version released January 2014 - USE CUTEST_LQP_double + USE CUTEST_LQP_precision + USE CUTEST_KINDS_precision IMPLICIT NONE -!-------------------- -! P r e c i s i o n -!-------------------- - - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - INTEGER, PARAMETER :: sp = KIND( 1.0E+0 ) - INTEGER, PARAMETER :: dp = KIND( 1.0D+0 ) - - REAL( KIND = sp ), PARAMETER :: teneps_s = 10.0_sp * EPSILON( 1.0_sp ) - REAL( KIND = dp ), PARAMETER :: teneps_d = 10.0_dp * EPSILON( 1.0_dp ) + REAL( KIND = sp_ ), PARAMETER :: teneps_s = 10.0_sp_ * EPSILON( 1.0_sp_ ) + REAL( KIND = dp_ ), PARAMETER :: teneps_d = 10.0_dp_ * EPSILON( 1.0_dp_ ) !---------------------- ! P a r a m e t e r s !---------------------- - INTEGER, PARAMETER :: input = 55 - INTEGER, PARAMETER :: input_spec = 46 - INTEGER, PARAMETER :: standard_out = 6 - INTEGER, PARAMETER :: qplib_out = 61 - INTEGER, PARAMETER :: qplib_out_dummy = 62 - INTEGER, PARAMETER :: buffer = 77 - REAL ( KIND = wp ), PARAMETER :: zero = 0.0_wp - REAL ( KIND = wp ), PARAMETER :: one = 1.0_wp - REAL ( KIND = wp ), PARAMETER :: infinity = ( 10.0_wp ) ** 19 - REAL ( KIND = wp ), PARAMETER :: infinity_used = ( 10.0_wp ) ** 20 - - INTEGER, PARAMETER :: qp = 1 - INTEGER, PARAMETER :: qcqp = 2 - INTEGER, PARAMETER :: bqp = 3 - INTEGER, PARAMETER :: lp = 4 - INTEGER, PARAMETER :: qcp = 5 + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55 + INTEGER ( KIND = ip_ ), PARAMETER :: input_spec = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: standard_out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: qplib_out = 61 + INTEGER ( KIND = ip_ ), PARAMETER :: qplib_out_dummy = 62 + INTEGER ( KIND = ip_ ), PARAMETER :: buffer = 77 + REAL ( KIND = rp_ ), PARAMETER :: zero = 0.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: one = 1.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: infinity = ( 10.0_rp_ ) ** 19 + REAL ( KIND = rp_ ), PARAMETER :: infinity_used = ( 10.0_rp_ ) ** 20 + + INTEGER ( KIND = ip_ ), PARAMETER :: qp = 1 + INTEGER ( KIND = ip_ ), PARAMETER :: qcqp = 2 + INTEGER ( KIND = ip_ ), PARAMETER :: bqp = 3 + INTEGER ( KIND = ip_ ), PARAMETER :: lp = 4 + INTEGER ( KIND = ip_ ), PARAMETER :: qcp = 5 ! CHARACTER ( len = 16 ) :: char_int_default = REPEAT( ' ', 16 ) ! CHARACTER ( len = 24 ) :: char_val_default = REPEAT( ' ', 24 ) @@ -54,18 +49,18 @@ PROGRAM CUTEST_qplib_main !-------------------------------- INTEGER :: n, m, H_ne, A_ne, status, out - REAL ( KIND = wp ) :: f, h_pert + REAL ( KIND = rp_ ) :: f, h_pert CHARACTER ( len = 10 ) :: p_name - INTEGER, ALLOCATABLE, DIMENSION( : ) :: X_type - INTEGER, ALLOCATABLE, DIMENSION( : ) :: A_row, A_col - INTEGER, ALLOCATABLE, DIMENSION( : ) :: H_row, H_col - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u, Z, G, X0 - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: Y, C_l, C_u - REAL ( KIND = wp ), ALLOCATABLE, DIMENSION( : ) :: A_val, H_val + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: X_type + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: A_row, A_col + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_row, H_col + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, X_l, X_u, Z, G, X0 + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Y, C_l, C_u + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: A_val, H_val CHARACTER ( len = 10 ), ALLOCATABLE, DIMENSION( : ) :: X_names, C_names - INTEGER :: i, int_var, bin_var, l, lh, nehi, nnzh_i - INTEGER :: problem_type = 1 + INTEGER ( KIND = ip_ ) :: i, int_var, bin_var, l, lh, nehi, nnzh_i + INTEGER ( KIND = ip_ ) :: problem_type = 1 LOGICAL :: filexx LOGICAL :: append_dim = .FALSE. LOGICAL :: qplib_wrfile = .FALSE. @@ -74,8 +69,8 @@ PROGRAM CUTEST_qplib_main CHARACTER ( len = 28 ) :: out_p_name CHARACTER ( len = 34 ) :: out_p_name_qplib CHARACTER ( len = 75 ) :: qplib_hi - REAL ( KIND = wp ) :: mode_v -! REAL ( KIND = wp ), DIMENSION( 100 ) :: V + REAL ( KIND = rp_ ) :: mode_v +! REAL ( KIND = rp_ ), DIMENSION( 100 ) :: V out = standard_out @@ -655,15 +650,15 @@ PROGRAM CUTEST_qplib_main FUNCTION MODE( n, V ) IMPLICIT NONE - REAL ( KIND = wp ) :: MODE + REAL ( KIND = rp_ ) :: MODE INTEGER, INTENT( IN ) :: n - REAL ( KIND = wp ), INTENT( IN ), DIMENSION( n ) :: V + REAL ( KIND = rp_ ), INTENT( IN ), DIMENSION( n ) :: V ! find the "mode", i.e., the most commonly-occuring value, of a vector v INTEGER :: i, mode_start, max_len, same, len, m, inform - REAL ( KIND = wp ), DIMENSION( n ) :: V_sorted + REAL ( KIND = rp_ ), DIMENSION( n ) :: V_sorted IF ( n > 0 ) THEN @@ -739,14 +734,14 @@ SUBROUTINE SORT_heapsort_build( n, A, inform ) IMPLICIT NONE INTEGER, INTENT( IN ) :: n INTEGER, INTENT( OUT ) :: inform - REAL ( KIND = wp ), INTENT( INOUT ), DIMENSION( n ) :: A + REAL ( KIND = rp_ ), INTENT( INOUT ), DIMENSION( n ) :: A !----------------------------------------------- ! L o c a l V a r i a b l e s !----------------------------------------------- INTEGER :: i, j, k - REAL ( KIND = wp ) :: rin + REAL ( KIND = rp_ ) :: rin ! Add the elements to the heap one at a time @@ -812,14 +807,14 @@ SUBROUTINE SORT_heapsort_smallest( m, A, inform ) IMPLICIT NONE INTEGER, INTENT( IN ) :: m INTEGER, INTENT( OUT ) :: inform - REAL ( KIND = wp ), INTENT( INOUT ), DIMENSION( m ) :: A + REAL ( KIND = rp_ ), INTENT( INOUT ), DIMENSION( m ) :: A !----------------------------------------------- ! L o c a l V a r i a b l e s !----------------------------------------------- INTEGER :: i, j - REAL ( KIND = wp ) :: rin, rout + REAL ( KIND = rp_ ) :: rin, rout ! Add the element rin to the heap, extract and assign to rout ! the value of the smallest member of the resulting set, and @@ -894,13 +889,13 @@ END FUNCTION TRIM_INT FUNCTION TRIM_VALUE( value ) CHARACTER ( LEN = 24 ) :: TRIM_VALUE - REAL ( KIND = wp ) :: value + REAL ( KIND = rp_ ) :: value ! write a real value into 24 characters trimming as much as possible ! without losing precision INTEGER :: i, i_start, i_point, i_end, j, k, l, zs - REAL ( KIND = wp ) :: minus_value + REAL ( KIND = rp_ ) :: minus_value LOGICAL :: zeros CHARACTER ( LEN = 22 ) :: field22 CHARACTER ( LEN = 23 ) :: field @@ -909,128 +904,128 @@ FUNCTION TRIM_VALUE( value ) ! cram value into 23 characters !write(6,*) value - IF ( value == 0.0_dp ) THEN + IF ( value == 0.0_dp_ ) THEN field = "0.0 " - ELSE IF ( SIGN( 1.0_dp, value ) > 0.0_dp ) THEN - IF ( value >= ( 10.0_dp ) ** 100 ) THEN + ELSE IF ( SIGN( 1.0_dp_, value ) > 0.0_dp_ ) THEN + IF ( value >= ( 10.0_dp_ ) ** 100 ) THEN WRITE( field24, "( ES24.15E3 )" ) value field = field24( 1 : 20 ) // field24( 22 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** 16 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 16 ) THEN WRITE( field24, "( ES24.15 )" ) value field = field24( 1 : 21 ) // field24( 23 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** 15 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 15 ) THEN WRITE( field, "( F23.0 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 14 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 14 ) THEN WRITE( field, "( F23.1 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 13 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 13 ) THEN WRITE( field, "( F23.2 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 12 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 12 ) THEN WRITE( field, "( F23.3 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 11 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 11 ) THEN WRITE( field, "( F23.4 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 10 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 10 ) THEN WRITE( field, "( F23.5 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 9 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 9 ) THEN WRITE( field, "( F23.6 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 8 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 8 ) THEN WRITE( field, "( F23.7 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 7 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 7 ) THEN WRITE( field, "( F23.8 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 6 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 6 ) THEN WRITE( field, "( F23.9 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 5 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 5 ) THEN WRITE( field, "( F23.10 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 4 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 4 ) THEN WRITE( field, "( F23.11 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 3 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 3 ) THEN WRITE( field, "( F23.12 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 2 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 2 ) THEN WRITE( field, "( F23.13 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 1 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 1 ) THEN WRITE( field, "( F23.14 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** 0 ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** 0 ) THEN WRITE( field, "( F23.15 )" ) value - ELSE IF ( value >= ( 10.0_dp ) ** ( - 1 ) ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 1 ) ) THEN WRITE( field24, "( F24.16 )" ) value field = field24( 2 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** ( - 2 ) ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 2 ) ) THEN WRITE( field24, "( F24.17 )" ) value field = field24( 2 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** ( - 3 ) ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 3 ) ) THEN WRITE( field24, "( F24.18 )" ) value field = field24( 2 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** ( - 4 ) ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 4 ) ) THEN WRITE( field24, "( F24.16 )" ) value field = field24( 2 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** ( - 9 ) ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 9 ) ) THEN WRITE( field24, "( ES24.15 )" ) value field = field24( 1 : 22 ) // field24( 24 : 24 ) - ELSE IF ( value >= ( 10.0_dp ) ** ( - 99 ) ) THEN + ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 99 ) ) THEN WRITE( field, "( ES23.15 )" ) value -! ELSE IF ( value >= ( 10.0_dp ) ** ( - 999 ) ) THEN +! ELSE IF ( value >= ( 10.0_dp_ ) ** ( - 999 ) ) THEN ! WRITE( field, "( ES23.15E3 )" ) value ELSE WRITE( field, "( ES23.15E4 )" ) value END IF ELSE minus_value = - value - IF ( ABS( minus_value - 1.0_dp ) <= teneps_d ) minus_value = 1.0_dp - IF ( minus_value >= ( 10.0_dp ) ** 100 ) THEN + IF ( ABS( minus_value - 1.0_dp_ ) <= teneps_d ) minus_value = 1.0_dp_ + IF ( minus_value >= ( 10.0_dp_ ) ** 100 ) THEN WRITE( field, "( ES23.15E3 )" ) minus_value field22 = field( 1 : 19 ) // field( 21 : 23 ) - ELSE IF ( minus_value >= ( 10.0_dp ) ** 16 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 16 ) THEN WRITE( field, "( ES23.15 )" ) minus_value field22 = field( 1 : 20 ) // field( 22 : 23 ) - ELSE IF ( minus_value >= ( 10.0_dp ) ** 15 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 15 ) THEN WRITE( field22, "( F22.0 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 14 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 14 ) THEN WRITE( field22, "( F22.1 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 13 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 13 ) THEN WRITE( field22, "( F22.2 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 12 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 12 ) THEN WRITE( field22, "( F22.3 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 11 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 11 ) THEN WRITE( field22, "( F22.4 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 10 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 10 ) THEN WRITE( field22, "( F22.5 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 9 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 9 ) THEN WRITE( field22, "( F22.6 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 8 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 8 ) THEN WRITE( field22, "( F22.7 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 7 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 7 ) THEN WRITE( field22, "( F22.8 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 6 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 6 ) THEN WRITE( field22, "( F22.9 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 5 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 5 ) THEN WRITE( field22, "( F22.10 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 4 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 4 ) THEN WRITE( field22, "( F22.11 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 3 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 3 ) THEN WRITE( field22, "( F22.12 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 2 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 2 ) THEN WRITE( field22, "( F22.13 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 1 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 1 ) THEN WRITE( field22, "( F22.14 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** 0 ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** 0 ) THEN WRITE( field22, "( F22.15 )" ) minus_value - ELSE IF ( minus_value >= ( 10.0_dp ) ** ( - 1 ) ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** ( - 1 ) ) THEN WRITE( field, "( F23.16 )" ) minus_value field22 = field( 2 : 23 ) - ELSE IF ( minus_value >= ( 10.0_dp ) ** ( - 2 ) ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** ( - 2 ) ) THEN WRITE( field, "( F23.17 )" ) minus_value field22 = field( 2 : 23 ) - ELSE IF ( minus_value >= ( 10.0_dp ) ** ( - 3 ) ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** ( - 3 ) ) THEN WRITE( field, "( F23.18 )" ) minus_value field22 = field( 2 : 23 ) - ELSE IF ( minus_value >= ( 10.0_dp ) ** ( - 4 ) ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** ( - 4 ) ) THEN WRITE( field, "( F23.15 )" ) minus_value field22 = field( 2 : 23 ) - ELSE IF ( minus_value >= ( 10.0_dp ) ** ( - 9 ) ) THEN + ELSE IF ( minus_value >= ( 10.0_dp_ ) ** ( - 9 ) ) THEN WRITE( field, "( ES23.15 )" ) minus_value field22 = field( 1 : 21 ) // field( 23 : 23 ) - ELSE IF ( minus_value > ( 10.0_dp ) ** ( - 99 ) ) THEN + ELSE IF ( minus_value > ( 10.0_dp_ ) ** ( - 99 ) ) THEN WRITE( field22, "( ES22.15 )" ) minus_value -! ELSE IF ( minus_value > ( 10.0_dp ) ** ( - 999 ) ) THEN +! ELSE IF ( minus_value > ( 10.0_dp_ ) ** ( - 999 ) ) THEN ! WRITE( field22, "( ES22.15E3 )" ) minus_value ELSE WRITE( field22, "( ES22.15E4 )" ) minus_value @@ -1106,7 +1101,7 @@ FUNCTION TRIM_VALUE( value ) END IF ! field24 = REPEAT( ' ', 24 ) -! IF ( value > - 10.0_wp .AND. value < 10.0_wp ) THEN +! IF ( value > - 10.0_rp_ .AND. value < 10.0_rp_ ) THEN ! WRITE( field24, "( F19.16 )" ) value ! ELSE ! WRITE( field24, "( ES23.16 )" ) value diff --git a/src/ral_nlls/makemaster b/src/ral_nlls/makemaster index e0e8157..1878e73 100644 --- a/src/ral_nlls/makemaster +++ b/src/ral_nlls/makemaster @@ -1,171 +1,60 @@ # Main body of the installation makefile for CUTEst RAL_NLLS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 6 X 2015 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-16 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = RAL_NLLS -package = ral_nlls - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -#FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) \ -# -I$(SQIC)/mod $(F90) $(USUAL) -#FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) \ -# -I$(SQIC)/mod $(F90) $(SPECIAL) -#FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod $(F90) -#FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod \ -# $(F77) $(USUAL) -#FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod \ -# $(F77) $(SPECIAL) -#FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod \ -# $(F77) $(USUAL) -#RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +include $(CUTEST)/src/makedefs/defaults -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -DARR = $(AR) $(ARREPFLAGS) $(DLC) +# package name -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -#$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs +PACKAGE = RAL_NLLS +package = ral_nlls -all: $(package) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# basic packages +# include standard CUTEst makefile definitions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -$(package)_double: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -#$(package)_double: $(OBJ)/$(package)_main.o +include $(CUTEST)/src/makedefs/definitions -# run example tests +# include compilation and run instructions -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - echo "$(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test -# - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +include $(CUTEST)/src/makedefs/instructions -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations +# select specific run test -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +run_test: run_constrained_test -# CUTEst interface main programs +# non-standard package compilation instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 +$(OBJ)/$(package)_main.o: $(OBJ)/$(package)_test.o \ + ../$(package)/$(package)_main.F90 @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ + $(CP) ../$(package)/$(package)_main.F90 $(OBJ)/$(package)_main.F90 + cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(F90FLAGS) $(CPPFLAGS) \ + $(package)_main.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 $(OBJ)/*.mod + $(FORTRAN) -o $(package)_main.o $(F90FLAGSN) $(CPPFLAGS) \ + $(package)_main.F90 ) + $(RM) $(OBJ)/$(package)_main.F90 $(OBJ)/*.mod @printf '[ OK ]\n' -$(OBJ)/$(package)_dummy.o: ../$(package)/$(package)_dummy.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_dummy" - $(SED) -f $(SEDS) ../$(package)/$(package)_dummy.f90 > \ - $(OBJ)/$(package)_dummy.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_dummy.o $(FFLAGS) \ - $(package)_dummy.f90 \ +$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" + $(CP) ../$(package)/$(package)_test.F90 $(OBJ)/$(package)_test.F90 + cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(F90FLAGS) $(CPPFLAGS) \ + $(package)_test.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_dummy.o $(FFLAGS77N) \ - $(package)_dummy.f90 ) - $(RM) $(OBJ)/$(package)_dummy.f90 $(OBJ)/$(package)_dummy.o + $(FORTRAN) -o $(package)_test.o $(F90FLAGSN) $(CPPFLAGS) \ + $(package)_test.F90 ) + $(RM) $(OBJ)/$(package)_test.F90 $(RMOBFILE) $(package)_main.o @printf '[ OK ]\n' -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' - diff --git a/src/ral_nlls/ral_nlls_dummy.F90 b/src/ral_nlls/ral_nlls_dummy.F90 new file mode 120000 index 0000000..fd10aa3 --- /dev/null +++ b/src/ral_nlls/ral_nlls_dummy.F90 @@ -0,0 +1 @@ +ral_nlls_test.F90 \ No newline at end of file diff --git a/src/ral_nlls/ral_nlls_dummy.f90 b/src/ral_nlls/ral_nlls_dummy.f90 deleted file mode 120000 index 25b615b..0000000 --- a/src/ral_nlls/ral_nlls_dummy.f90 +++ /dev/null @@ -1 +0,0 @@ -ral_nlls_test.f90 \ No newline at end of file diff --git a/src/ral_nlls/ral_nlls_main.f90 b/src/ral_nlls/ral_nlls_main.F90 similarity index 75% rename from src/ral_nlls/ral_nlls_main.f90 rename to src/ral_nlls/ral_nlls_main.F90 index 42ef916..cf6ec1e 100644 --- a/src/ral_nlls/ral_nlls_main.f90 +++ b/src/ral_nlls/ral_nlls_main.F90 @@ -1,23 +1,32 @@ -! ( Last modified on 25 Jan 2016 at 09:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 15:20 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" +#ifdef CUTEST_SINGLE +#define RAL_NLLS_precision RAL_NLLS_single +#else +#define RAL_NLLS_precision RAL_NLLS_double +#endif PROGRAM RAL_NLLS_main - USE ISO_C_BINDING - USE RAL_NLLS_DOUBLE ! RAL_NLLS test driver for problems derived from SIF files ! Nick Gould, October 2015 + USE CUTEST_KINDS_precision + USE RAL_NLLS_precision + IMPLICIT NONE - type, extends( params_base_type ) :: user_type + TYPE, EXTENDS( params_base_type ) :: user_type ! still empty - end type user_type + END TYPE user_type - INTEGER :: status, i, m, n - REAL( c_double ), DIMENSION( : ), ALLOCATABLE :: X, X_l, X_u - REAL( c_double ), DIMENSION( : ), ALLOCATABLE :: Y, C_l, C_u, F - type( user_type ), target :: params + INTEGER ( KIND = ip_ ) :: status, i, m, n + REAL( KIND = rpc_ ), DIMENSION( : ), ALLOCATABLE :: X, X_l, X_u + REAL( KIND = rpc_ ), DIMENSION( : ), ALLOCATABLE :: Y, C_l, C_u, F + TYPE( user_type ), target :: params TYPE( Nlls_inform ) :: inform TYPE( Nlls_options ) :: control LOGICAL, DIMENSION( : ), ALLOCATABLE :: EQUATN, LINEAR @@ -25,13 +34,13 @@ PROGRAM RAL_NLLS_main CHARACTER ( LEN = 20 ) :: summary_file = REPEAT( ' ', 20 ) CHARACTER ( LEN = 20 ) :: iter_summary_file = REPEAT( ' ', 20 ) CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAMES, CNAMES - REAL( c_double ), DIMENSION( 4 ) :: CPU - REAL( c_double ), DIMENSION( 7 ) :: CALLS - INTEGER :: io_buffer = 11 - INTEGER :: summary_unit, iter_summary_unit, iores - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 + REAL( KIND = rpc_ ), DIMENSION( 4 ) :: CPU + REAL( KIND = rpc_ ), DIMENSION( 7 ) :: CALLS + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: summary_unit, iter_summary_unit, iores + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46, out = 6 LOGICAL :: filexx - INTEGER :: fnevals, jacevals, hessevals, localiter + INTEGER ( KIND = ip_ ) :: fnevals, jacevals, hessevals, localiter ! open the relevant file @@ -40,7 +49,7 @@ PROGRAM RAL_NLLS_main ! compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 ! allocate space @@ -53,8 +62,8 @@ PROGRAM RAL_NLLS_main ! set up the data structures necessary to hold the problem functions. - CALL CUTEST_csetup( status, input, out, io_buffer, n, m, & - X, X_l, X_u, Y, C_l, C_u, EQUATN, LINEAR, 0, 0, 0 ) + CALL CUTEST_csetup_r( status, input, out, io_buffer, n, m, & + X, X_l, X_u, Y, C_l, C_u, EQUATN, LINEAR, 0, 0, 0 ) IF ( status /= 0 ) GO TO 910 CLOSE( input ) @@ -136,7 +145,7 @@ PROGRAM RAL_NLLS_main & '. Stopping ' )" ) iores, summary_file STOP END IF - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) WRITE( summary_unit, "( A10 )" ) pname END IF @@ -154,7 +163,7 @@ PROGRAM RAL_NLLS_main & '. Stopping ' )" ) iores, iter_summary_file STOP END IF - CALL CUTEST_probname( status, pname ) + CALL CUTEST_probname_r( status, pname ) WRITE( iter_summary_unit, "( A10 )" ) pname END IF @@ -163,7 +172,7 @@ PROGRAM RAL_NLLS_main ! call the minimizer CALL NLLS_SOLVE( n, m, X, eval_F, eval_J, eval_HF, & - params, control, inform ) + params, control, inform ) WRITE( out , "( A, I0, A, I0)") 'status = ', inform%status, & ' iter = ', inform%iter @@ -171,11 +180,11 @@ PROGRAM RAL_NLLS_main ! output report - CALL CUTEST_creport( status, CALLS, CPU ) + CALL CUTEST_creport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 ALLOCATE( F( m ), VNAMES( n ), CNAMES( m ), STAT = status ) - CALL CUTEST_cnames( status, n, m, pname, VNAMES, CNAMES ) + CALL CUTEST_cnames_r( status, n, m, pname, VNAMES, CNAMES ) CALL eval_F( status, n, m, X, F, params) WRITE( out, "( /, ' The variables:', /, & @@ -236,7 +245,7 @@ PROGRAM RAL_NLLS_main DEALLOCATE( X, F, VNAMES, CNAMES, STAT = status ) IF ( status /= 0 ) GO TO 910 - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) STOP ! error returns @@ -256,57 +265,59 @@ PROGRAM RAL_NLLS_main CONTAINS SUBROUTINE eval_F( status, n, m, X, f, params ) - USE ISO_C_BINDING - use :: ral_nlls_double, only : params_base_type - integer, intent(out) :: status - integer, intent(in) :: n, m - REAL ( c_double ), dimension(*), intent(in) :: X - REAL ( c_double ), dimension(*), intent(out) :: f - class(params_base_type), intent(in) :: params - REAL ( c_double ) :: obj + USE CUTEST_KINDS_precision + USE RAL_NLLS_precision, ONLY : params_base_type + + INTEGER ( KIND = ip_), INTENT( out ) :: status + INTEGER ( KIND = ip_), INTENT( in ) :: n, m + REAL ( KIND = rpc_ ), dimension(*), intent(in) :: X + REAL ( KIND = rpc_ ), dimension(*), intent(out) :: f + CLASS ( params_base_type ), intent(in) :: params + REAL ( KIND = rpc_ ) :: obj ! evaluate the residuals F - CALL CUTEST_cfn( status, n, m, X, obj, f ) + CALL CUTEST_cfn_r( status, n, m, X, obj, f ) END SUBROUTINE eval_F SUBROUTINE eval_J( status, n, m, X, J, params) - USE ISO_C_BINDING - use :: ral_nlls_double, only : params_base_type - - INTEGER ( c_int ), INTENT( OUT ) :: status - INTEGER ( c_int ), INTENT( IN ) :: n, m - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: X - REAL ( c_double ), DIMENSION( * ), INTENT( OUT ) :: J - class( params_base_type ), intent(in) :: params - REAL ( c_double ), DIMENSION( n ) :: G - REAL ( c_double ), DIMENSION( m ) :: Y - REAL ( c_double ), DIMENSION( m , n ) :: Jmatrix + USE CUTEST_KINDS_precision + USE RAL_NLLS_precision, ONLY : params_base_type + + INTEGER ( KIND = ipc_), INTENT( OUT ) :: status + INTEGER ( KIND = ipc_ ), INTENT( IN ) :: n, m + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( IN ) :: X + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( OUT ) :: J + CLASS ( params_base_type ), intent(in) :: params + REAL ( KIND = rpc_ ), DIMENSION( n ) :: G + REAL ( KIND = rpc_ ), DIMENSION( m ) :: Y + REAL ( KIND = rpc_ ), DIMENSION( m , n ) :: Jmatrix ! evaluate the residual Jacobian J - CALL CUTEST_cgr( status, n, m, X, Y, .FALSE., G, .FALSE., m, n, Jmatrix ) + CALL CUTEST_cgr_r( status, n, m, X, Y, .FALSE., G, .FALSE., & + m, n, Jmatrix ) ! convert the Jacobian to a vector.... - J(1:m*n) = reshape(Jmatrix, (/n*m/) ) + J( 1 : m * n ) = RESHAPE( Jmatrix, (/ n * m /) ) RETURN END SUBROUTINE eval_J SUBROUTINE eval_HF( status, n, m, X, F, H, params ) - USE ISO_C_BINDING - use :: ral_nlls_double, only : params_base_type + USE CUTEST_KINDS_precision + USE RAL_NLLS_precision, ONLY : params_base_type - INTEGER ( c_int ), INTENT( OUT ) :: status - INTEGER ( c_int ), INTENT( IN ) :: n, m - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: X - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: F - REAL ( c_double ), DIMENSION( * ), INTENT( OUT ) :: H - class( params_base_type ), intent(in) :: params - real ( c_double ), dimension(n,n) :: Hmatrix + INTEGER ( KIND = ipc_ ), INTENT( OUT ) :: status + INTEGER ( KIND = ipc_ ), INTENT( IN ) :: n, m + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( IN ) :: X + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( IN ) :: F + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( OUT ) :: H + CLASS ( params_base_type ), INTENT( IN ) :: params + REAL ( KIND = rpc_ ), DIMENSION( n, n ) :: Hmatrix ! evaluate the product H = sum F_i Hessian F_i - CALL CUTEST_cdhc( status, n, m, X, F, n, Hmatrix ) - H(1:n*n) = reshape(Hmatrix, (/n*n/) ) + CALL CUTEST_cdhc_r( status, n, m, X, F, n, Hmatrix ) + H( 1 : n * n ) = RESHAPE( Hmatrix, (/ n * n /) ) RETURN END SUBROUTINE eval_HF diff --git a/src/ral_nlls/ral_nlls_test.F90 b/src/ral_nlls/ral_nlls_test.F90 new file mode 100644 index 0000000..5050dd6 --- /dev/null +++ b/src/ral_nlls/ral_nlls_test.F90 @@ -0,0 +1,282 @@ +! THIS VERSION: CUTEST 2.2 - 2023-11-16 AT 16:00 GMT. + +#include "cutest_modules.h" +#ifdef CUTEST_SINGLE +#define RAL_NLLS_precision RAL_NLLS_single +#else +#define RAL_NLLS_precision RAL_NLLS_double +#endif + +! Dummy RAL_NLLS for testing ral_nlls_main interface to CUTEst +! Nick Gould, 6th October 2015 + + MODULE RAL_NLLS_internal + + USE CUTEST_KINDS_precision + + IMPLICIT NONE + + PRIVATE + + INTEGER, PARAMETER :: long = SELECTED_INT_KIND( 8 ) + + REAL ( KIND = rp_ ), PARAMETER :: zero = 0.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: one = 1.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: two = 2.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: half = 0.5_rp_ + REAL ( KIND = rp_ ), PARAMETER :: sixteenth = 0.0625_rp_ + REAL ( KIND = rp_ ), PARAMETER :: point9 = 0.9_rp_ + REAL ( KIND = rp_ ), PARAMETER :: ten = 10.0_rp_ + REAL ( KIND = rp_ ), PARAMETER :: tenm3 = ten ** ( - 3 ) + REAL ( KIND = rp_ ), PARAMETER :: tenm5 = ten ** ( - 5 ) + REAL ( KIND = rp_ ), PARAMETER :: tenm8 = ten ** ( - 8 ) + REAL ( KIND = rp_ ), PARAMETER :: epsmch = EPSILON( one ) + REAL ( KIND = rp_ ), PARAMETER :: hundred = 100.0_rp_ + + TYPE, public :: Nlls_options + INTEGER ( KIND = ip_ ) :: error = 6 + INTEGER ( KIND = ip_ ) :: out = 6 + INTEGER ( KIND = ip_ ) :: print_level = 0 + INTEGER ( KIND = ip_ ) :: maxit = 100 + INTEGER ( KIND = ip_ ) :: model = 1 + INTEGER ( KIND = ip_ ) :: nlls_method = 1 + INTEGER ( KIND = ip_ ) :: lls_solver = 1 + REAL ( KIND = rp_ ) :: stop_g_absolute = tenm5 + REAL ( KIND = rp_ ) :: stop_g_relative = tenm8 + INTEGER ( KIND = ip_ ) :: relative_tr_radius = 0 + REAL ( KIND = rp_ ) :: initial_radius_scale = 1.0!tenm3 + REAL ( KIND = rp_ ) :: initial_radius = hundred + REAL ( KIND = rp_ ) :: maximum_radius = ten ** 8 + REAL ( KIND = rp_ ) :: eta_successful = ten ** ( - 8 ) + REAL ( KIND = rp_ ) :: eta_very_successful = point9 + REAL ( KIND = rp_ ) :: eta_too_successful = two + REAL ( KIND = rp_ ) :: radius_increase = two + REAL ( KIND = rp_ ) :: radius_reduce = half + REAL ( KIND = rp_ ) :: radius_reduce_max = sixteenth + INTEGER ( KIND = ip_ ) :: tr_update_strategy = 1 + REAL ( KIND = rp_ ) :: hybrid_switch = 0.1_rp_ + logical :: exact_second_derivatives = .true. + LOGICAL :: subproblem_eig_fact = .FALSE. + INTEGER ( KIND = ip_ ) :: more_sorensen_maxits = 500 + REAL ( KIND = rp_) :: more_sorensen_shift = ten ** ( - 8 ) + REAL ( KIND = rp_) :: more_sorensen_tiny = ten * epsmch + REAL ( KIND = rp_) :: more_sorensen_tol = ten ** ( - 6 ) + + REAL ( KIND = rp_) :: hybrid_tol = 0.02_rp_ + INTEGER ( KIND = ip_ ) :: hybrid_switch_its = 3 + + logical :: output_progress_vectors = .false. + + END TYPE Nlls_options + + TYPE, public :: NLLS_inform + INTEGER ( KIND = ip_ ) :: status = 0 + INTEGER ( KIND = ip_ ) :: alloc_status = 0 + INTEGER ( KIND = ip_ ) :: iter = 0 + INTEGER ( KIND = ip_ ) :: f_eval = 0 + INTEGER ( KIND = ip_ ) :: g_eval = 0 + INTEGER ( KIND = ip_ ) :: h_eval = 0 + INTEGER ( KIND = ip_ ) :: convergence_normf = 0 + INTEGER ( KIND = ip_ ) :: convergence_normg = 0 + REAL( KIND = rp_ ), allocatable :: resvec(:) + REAL( KIND = rp_ ), allocatable :: gradvec(:) + REAL ( KIND = rp_ ) :: obj = HUGE( one ) + REAL ( KIND = rp_ ) :: norm_g = HUGE( one ) + REAL ( KIND = rp_ ) :: scaled_g = HUGE( one ) + INTEGER ( KIND = ip_ ) :: external_return = 0 + character ( len = 80 ) :: external_name = REPEAT( ' ', 80 ) +! REAL( KIND = rpc_) :: obj = HUGE( 1.0_KIND = rpc_) + END TYPE NLLS_inform + + TYPE, PUBLIC :: params_base_type + ! deliberately empty + END TYPE PARAMS_base_type + + ABSTRACT INTERFACE + SUBROUTINE eval_f_type(status, n, m, x, f, params) + USE CUTEST_KINDS_precision + import :: params_base_type + implicit none + INTEGER ( KIND = ip_ ), intent(out) :: status + INTEGER ( KIND = ip_ ), intent(in) :: n,m + REAL ( KIND = rpc_), dimension(*), intent(in) :: x + REAL ( KIND = rpc_), dimension(*), intent(out) :: f + class(params_base_type), intent(in) :: params + END SUBROUTINE eval_f_type + END INTERFACE + + ABSTRACT INTERFACE + SUBROUTINE eval_j_type(status, n, m, x, J, params) + USE CUTEST_KINDS_precision + import :: params_base_type + implicit none + INTEGER ( KIND = ip_ ), intent(out) :: status + INTEGER ( KIND = ip_ ), intent(in) :: n,m + REAL ( KIND = rpc_), dimension(*), intent(in) :: x + REAL ( KIND = rpc_), dimension(*), intent(out) :: J + class(params_base_type), intent(in) :: params + END SUBROUTINE eval_j_type + END INTERFACE + + ABSTRACT INTERFACE + SUBROUTINE eval_hf_type(status, n, m, x, f, h, params) + USE CUTEST_KINDS_precision + import :: params_base_type + implicit none + INTEGER ( KIND = ip_ ), intent(out) :: status + INTEGER ( KIND = ip_ ), intent(in) :: n,m + REAL ( KIND = rpc_), dimension(*), intent(in) :: x + REAL ( KIND = rpc_), dimension(*), intent(in) :: f + REAL ( KIND = rpc_), dimension(*), intent(out) :: h + class(params_base_type), intent(in) :: params + END SUBROUTINE eval_hf_type + END INTERFACE + + CONTAINS + + ! nothing! + + END MODULE RAL_NLLS_internal + + MODULE RAL_NLLS_precision + + USE CUTEST_KINDS_precision + USE RAL_NLLS_internal + + IMPLICIT NONE + + PRIVATE + + INTEGER ( KIND = ip_ ), PARAMETER :: error_dimensions = - 1 + INTEGER ( KIND = ip_ ), PARAMETER :: error_workspace = - 2 + INTEGER ( KIND = ip_ ), PARAMETER :: error_eval_F = - 3 + INTEGER ( KIND = ip_ ), PARAMETER :: error_eval_J = - 4 + INTEGER ( KIND = ip_ ), PARAMETER :: error_eval_HF = - 5 + + ABSTRACT INTERFACE + SUBROUTINE eval_F_type( status, n, m, X, F , params ) + USE CUTEST_KINDS_precision + IMPORT :: params_base_type + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: status + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n, m + REAL ( KIND = rpc_), DIMENSION( * ), INTENT( IN ) :: X + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( OUT ) :: F + class( params_base_type ), intent( in ) :: params + END SUBROUTINE eval_F_type + END INTERFACE + + ABSTRACT INTERFACE + SUBROUTINE eval_j_type( status, n, m, X, J, params ) + USE CUTEST_KINDS_precision + IMPORT :: params_base_type + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: status + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n, m + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( IN ) :: X + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( OUT ) :: J + class( params_base_type ), intent( in ) :: params + END SUBROUTINE eval_j_type + END INTERFACE + + ABSTRACT INTERFACE + SUBROUTINE eval_HF_type( status, n, m, X, F, H, params ) + USE CUTEST_KINDS_precision + IMPORT :: params_base_type + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: status + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n, m + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( IN ) :: X + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( IN ) :: F + REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( OUT ) :: H + class( params_base_type ), intent( in ) :: params + END SUBROUTINE eval_HF_type + END INTERFACE + + PUBLIC :: NLLS_solve + PUBLIC :: NLLS_options, NLLS_inform + PUBLIC :: params_base_type + + CONTAINS + + SUBROUTINE NLLS_solve( n, m, X, eval_F, eval_J, eval_HF, & + params, options, inform ) + +! ----------------------------------------------------------------------------- +! RAL_NLLS, a fortran subroutine for finding a first-order critical +! point (most likely, a local minimizer) of the nonlinear least-squares +! objective function 1/2 ||F(x)||_2^2. + +! Authors: RAL NA Group (Iain Duff, Nick Gould, Jonathan Hogg, Tyrone Rees, +! Jennifer Scott) +! ----------------------------------------------------------------------------- + +! Dummy arguments + + INTEGER ( KIND = ip_ ), INTENT( IN ) :: n, m + REAL( KIND = rpc_ ), DIMENSION( n ), INTENT( INOUT ) :: X + TYPE( Nlls_inform ), INTENT( OUT ) :: inform + TYPE( Nlls_options ), INTENT( IN ) :: options + class( params_base_type ) :: params + PROCEDURE( eval_f_type ) :: eval_F + PROCEDURE( eval_j_type ) :: eval_J + PROCEDURE( eval_hf_type ) :: eval_HF + +! Interface blocks + +! Local variables + + INTEGER ( KIND = ip_ ) :: status, start_f, end_f, start_j, start_h, w_end +! INTEGER ( KIND = ip_ ) :: len_work_int, len_work_real +! INTEGER ( KIND = ip_ ) ALLOCATABLE :: Work_int( : ) + REAL( KIND = rpc_ ), ALLOCATABLE :: Work_real( : ) + +! check input dimensions + + IF ( m <= 0 .OR. n <= 0 ) THEN + status = error_dimensions + GO TO 990 + END IF + + start_f = 1 + start_j = start_f + m + end_f = start_j - 1 + start_h = start_j + n * m + w_end = start_h + n * n - 1 + +! partition the workspace +! allocate(Work_int(10)) + allocate(Work_real(w_end)) + +! evaluate F + + CALL eval_F( status, n, m, X, WORK_real( start_f ), params ) + IF ( status /= 0 ) THEN + status = error_eval_F + GO TO 990 + END IF + INFORM%obj = 0.5_rpc_ * DOT_PRODUCT( WORK_real( start_f : end_f ), & + WORK_real( start_f : end_F ) ) + +! evaluate J + + CALL eval_J( status, n, m, X, WORK_real( start_j ), params ) + IF ( status /= 0 ) THEN + status = error_eval_J + GO TO 990 + END IF + +! evaluate HF + + CALL eval_HF( status, n, m, X, WORK_real( start_f ), & + WORK_real( start_h ), params ) + IF ( status /= 0 ) THEN + status = ERROR_eval_HF + GO TO 990 + END IF + + 990 CONTINUE + inform%status = status + RETURN + END SUBROUTINE NLLS_solve + + END MODULE RAL_NLLS_precision + + diff --git a/src/ral_nlls/ral_nlls_test.f90 b/src/ral_nlls/ral_nlls_test.f90 deleted file mode 100644 index a74fdb2..0000000 --- a/src/ral_nlls/ral_nlls_test.f90 +++ /dev/null @@ -1,294 +0,0 @@ -! Dummy RAL_NLLS for testing ral_nlls_main interface to CUTEst -! Nick Gould, 6th October 2015 - - MODULE ral_nlls_internal - - USE iso_c_binding - - implicit none - - private - - INTEGER, PARAMETER :: wp = KIND( 1.0d0 ) - INTEGER, PARAMETER :: long = SELECTED_INT_KIND( 8 ) - - real (kind = wp), parameter :: tenm3 = 1.0e-3 - real (kind = wp), parameter :: tenm5 = 1.0e-5 - real (kind = wp), parameter :: tenm8 = 1.0e-8 - real (kind = wp), parameter :: epsmch = epsilon(1.0_wp) - real (kind = wp), parameter :: hundred = 100.0 - real (kind = wp), parameter :: ten = 10.0 - real (kind = wp), parameter :: point9 = 0.9 - real (kind = wp), parameter :: zero = 0.0 - real (kind = wp), parameter :: one = 1.0 - real (kind = wp), parameter :: two = 2.0 - real (kind = wp), parameter :: half = 0.5 - real (kind = wp), parameter :: sixteenth = 0.0625 - - TYPE, public :: Nlls_options - INTEGER :: error = 6 - INTEGER :: out = 6 - INTEGER :: print_level = 0 - INTEGER :: maxit = 100 - INTEGER :: model = 1 - INTEGER :: nlls_method = 1 - INTEGER :: lls_solver = 1 - REAL ( KIND = wp ) :: stop_g_absolute = tenm5 - REAL ( KIND = wp ) :: stop_g_relative = tenm8 - INTEGER :: relative_tr_radius = 0 - REAL ( KIND = wp ) :: initial_radius_scale = 1.0!tenm3 - REAL ( KIND = wp ) :: initial_radius = hundred - REAL ( KIND = wp ) :: maximum_radius = ten ** 8 - REAL ( KIND = wp ) :: eta_successful = ten ** ( - 8 ) - REAL ( KIND = wp ) :: eta_very_successful = point9 - REAL ( KIND = wp ) :: eta_too_successful = two - REAL ( KIND = wp ) :: radius_increase = two - REAL ( KIND = wp ) :: radius_reduce = half - REAL ( KIND = wp ) :: radius_reduce_max = sixteenth - integer :: tr_update_strategy = 1 - real ( kind = wp ) :: hybrid_switch = 0.1_wp - logical :: exact_second_derivatives = .true. - LOGICAL :: subproblem_eig_fact = .FALSE. - integer :: more_sorensen_maxits = 500 - real(wp) :: more_sorensen_shift = 1e-8 - real(wp) :: more_sorensen_tiny = 10.0 * epsmch - real(wp) :: more_sorensen_tol = 1e-6 - - real(wp) :: hybrid_tol = 0.02 - integer :: hybrid_switch_its = 3 - - logical :: output_progress_vectors = .false. - - END TYPE Nlls_options - - TYPE, public :: NLLS_inform - INTEGER :: status = 0 - INTEGER :: alloc_status = 0 - INTEGER :: iter = 0 - INTEGER :: f_eval = 0 - INTEGER :: g_eval = 0 - INTEGER :: h_eval = 0 - integer :: convergence_normf = 0 - integer :: convergence_normg = 0 - real(wp), allocatable :: resvec(:) - real(wp), allocatable :: gradvec(:) - REAL ( KIND = wp ) :: obj = HUGE( one ) - REAL ( KIND = wp ) :: norm_g = HUGE( one ) - REAL ( KIND = wp ) :: scaled_g = HUGE( one ) - INTEGER :: external_return = 0 - character ( len = 80 ) :: external_name = REPEAT( ' ', 80 ) -! REAL( c_double ) :: obj = HUGE( 1.0_c_double ) - END TYPE NLLS_inform - - type, public :: params_base_type - ! deliberately empty - end type params_base_type - - abstract interface - subroutine eval_f_type(status, n, m, x, f, params) - USE ISO_C_BINDING - import :: params_base_type - implicit none - integer, intent(out) :: status - integer, intent(in) :: n,m - REAL ( c_double ), dimension(*), intent(in) :: x - REAL ( c_double ), dimension(*), intent(out) :: f - class(params_base_type), intent(in) :: params - end subroutine eval_f_type - end interface - - abstract interface - subroutine eval_j_type(status, n, m, x, J, params) - USE ISO_C_BINDING - import :: params_base_type - implicit none - integer, intent(out) :: status - integer, intent(in) :: n,m - REAL ( c_double ), dimension(*), intent(in) :: x - REAL ( c_double ), dimension(*), intent(out) :: J - class(params_base_type), intent(in) :: params - end subroutine eval_j_type - end interface - - abstract interface - subroutine eval_hf_type(status, n, m, x, f, h, params) - USE ISO_C_BINDING - import :: params_base_type - implicit none - integer, intent(out) :: status - integer, intent(in) :: n,m - REAL ( c_double ), dimension(*), intent(in) :: x - REAL ( c_double ), dimension(*), intent(in) :: f - REAL ( c_double ), dimension(*), intent(out) :: h - class(params_base_type), intent(in) :: params - end subroutine eval_hf_type - end interface - - -contains - - ! nothing! - - END MODULE ral_nlls_internal - - MODULE RAL_NLLS_DOUBLE - - USE ISO_C_BINDING - use ral_nlls_internal - - IMPLICIT none - - private - -!!$ INTEGER, PARAMETER :: wp = KIND( 1.0d0 ) -!!$ INTEGER, PARAMETER :: long = SELECTED_INT_KIND( 8 ) -!!$ - INTEGER, PARAMETER :: error_dimensions = - 1 - INTEGER, PARAMETER :: error_workspace = - 2 - INTEGER, PARAMETER :: error_eval_F = - 3 - INTEGER, PARAMETER :: error_eval_J = - 4 - INTEGER, PARAMETER :: error_eval_HF = - 5 -!!$ -!!$ real (kind = wp), parameter :: tenm3 = 1.0e-3 -!!$ real (kind = wp), parameter :: tenm5 = 1.0e-5 -!!$ real (kind = wp), parameter :: tenm8 = 1.0e-8 -!!$ real (kind = wp), parameter :: epsmch = epsilon(1.0_wp) -!!$ real (kind = wp), parameter :: hundred = 100.0 -!!$ real (kind = wp), parameter :: ten = 10.0 -!!$ real (kind = wp), parameter :: point9 = 0.9 -!!$ real (kind = wp), parameter :: zero = 0.0 -!!$ real (kind = wp), parameter :: one = 1.0 -!!$ real (kind = wp), parameter :: two = 2.0 -!!$ real (kind = wp), parameter :: half = 0.5 -!!$ real (kind = wp), parameter :: sixteenth = 0.0625 - - - ABSTRACT INTERFACE - SUBROUTINE eval_F_type( status, n, m, X, F , params ) - USE ISO_C_BINDING - import :: params_base_type - implicit none - INTEGER, INTENT( OUT ) :: status - INTEGER, INTENT( IN ) :: n, m - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: X - REAL ( c_double ), DIMENSION( * ), INTENT( OUT ) :: F - class( params_base_type ), intent( in ) :: params - END SUBROUTINE eval_F_type - END INTERFACE - - ABSTRACT INTERFACE - SUBROUTINE eval_j_type( status, n, m, X, J, params ) - USE ISO_C_BINDING - import :: params_base_type - INTEGER ( c_int ), INTENT( OUT ) :: status - INTEGER ( c_int ), INTENT( IN ) :: n, m - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: X - REAL ( c_double ), DIMENSION( * ), INTENT( OUT ) :: J - class( params_base_type ), intent( in ) :: params - END SUBROUTINE eval_j_type - END INTERFACE - - ABSTRACT INTERFACE - SUBROUTINE eval_HF_type( status, n, m, X, F, H, params ) - USE ISO_C_BINDING - import :: params_base_type - INTEGER ( c_int ), INTENT( OUT ) :: status - INTEGER ( c_int ), INTENT( IN ) :: n, m - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: X - REAL ( c_double ), DIMENSION( * ), INTENT( IN ) :: F - REAL ( c_double ), DIMENSION( * ), INTENT( OUT ) :: H - class( params_base_type ), intent( in ) :: params - END SUBROUTINE eval_HF_type - END INTERFACE - - public :: nlls_solve - public :: nlls_options, nlls_inform - public :: params_base_type - - -CONTAINS - - SUBROUTINE NLLS_SOLVE( n, m, X, eval_F, eval_J, eval_HF, & - params, options, inform ) - -! ----------------------------------------------------------------------------- -! RAL_NLLS, a fortran subroutine for finding a first-order critical -! point (most likely, a local minimizer) of the nonlinear least-squares -! objective function 1/2 ||F(x)||_2^2. - -! Authors: RAL NA Group (Iain Duff, Nick Gould, Jonathan Hogg, Tyrone Rees, -! Jennifer Scott) -! ----------------------------------------------------------------------------- - -! Dummy arguments - - INTEGER( c_int ), INTENT( IN ) :: n, m - REAL( c_double ), DIMENSION( n ), INTENT( INOUT ) :: X - TYPE( Nlls_inform ), INTENT( OUT ) :: inform - TYPE( Nlls_options ), INTENT( IN ) :: options - class( params_base_type ) :: params - procedure( eval_f_type ) :: eval_F - procedure( eval_j_type ) :: eval_J - procedure( eval_hf_type ) :: eval_HF - -! Interface blocks - -! Local variables - - INTEGER :: status, start_f, end_f, start_j, start_h, w_end -! INTEGER :: len_work_int, len_work_real - ! INTEGER( c_int ), allocatable :: Work_int( : ) - REAL( c_double ), allocatable :: Work_real( : ) - -! check input dimensions - - IF ( m <= 0 .OR. n <= 0 ) THEN - status = error_dimensions - GO TO 990 - END IF - - start_f = 1 - start_j = start_f + m - end_f = start_j - 1 - start_h = start_j + n * m - w_end = start_h + n * n - 1 - -! partition the workspace -! allocate(Work_int(10)) - allocate(Work_real(w_end)) - -! evaluate F - - CALL eval_F( status, n, m, X, WORK_real( start_f ), params ) - IF ( status /= 0 ) THEN - status = error_eval_F - GO TO 990 - END IF - inform%obj = 0.5_c_double * DOT_PRODUCT( WORK_real( start_f : end_f ), & - WORK_real( start_f : end_f ) ) - -! evaluate J - - CALL eval_J( status, n, m, X, WORK_real( start_j ), params ) - IF ( status /= 0 ) THEN - status = error_eval_J - GO TO 990 - END IF - -! evaluate HF - - CALL eval_HF( status, n, m, X, WORK_real( start_f ), & - WORK_real( start_h ), params ) - IF ( status /= 0 ) THEN - status = error_eval_HF - GO TO 990 - END IF - - 990 CONTINUE - inform%status = status - RETURN - END SUBROUTINE NLLS_SOLVE - - END MODULE RAL_NLLS_DOUBLE - - diff --git a/src/snopt/makemaster b/src/snopt/makemaster index 7b74e98..b1e311d 100644 --- a/src/snopt/makemaster +++ b/src/snopt/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst SNOPT interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 14 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = SNOPT -package = snopt - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = SNOPT +package = snopt -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/snopt/snopt_main.f b/src/snopt/snopt_main.F similarity index 75% rename from src/snopt/snopt_main.f rename to src/snopt/snopt_main.F index f5e0999..868d792 100644 --- a/src/snopt/snopt_main.f +++ b/src/snopt/snopt_main.F @@ -1,41 +1,36 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. - program SNOPT_main +#include "cutest_modules.h" +#include "cutest_routines.h" - implicit none - - character*8 :: start, probnm - character*10 :: pName - - integer :: lenrw, leniw, lencw, minrw, miniw, mincw, - & lenru, leniu, lencu, - & lG, liGfun, ljGvar, llocG, nlocG - integer :: m, n, ne, nb, nnCon, nnJac, nnObj, iObj, - & neG, inform, nS, nInf, nNames - integer :: j, jslack, neq, nlc, status - - double precision :: ObjAdd, sInf, Obj, cpu(4), calls(7) - - - integer, allocatable :: iu(:), iw(:) - double precision, allocatable :: ru(:), rw(:) - character*8, allocatable :: cu(:), cw(:) - - integer, allocatable :: hs(:), indA(:), locA(:) - double precision, allocatable :: x(:), bl(:), bu(:), rc(:), y(:), - & c(:), Aval(:) - character*8, allocatable :: Names(:) - character*10, allocatable :: vname(:), cname(:) - logical, allocatable :: equatn(:), linear(:) - - - integer, parameter :: iPrint = 15, iSpecs = 4, - & iSumm = 6, nout = 6, - & input = 55, io_buffer = 11 - - double precision, parameter :: zero = 0.0d+0, big = 1.0d+20 + program SNOPT_main - external :: SNOPT_evalcj, SNOPT_evalfg + use CUTEST_KINDS_precision + implicit none + character*8 :: start, probnm + character*10 :: pName + integer ( kind = ip_ ) :: lenrw, leniw, lencw, minrw, miniw, mincw + integer ( kind = ip_ ) :: lenru, leniu, lencu + integer ( kind = ip_ ) :: lG, liGfun, ljGvar, llocG, nlocG + integer ( kind = ip_ ) :: m, n, ne, nb, nnCon, nnJac, nnObj, iObj + integer ( kind = ip_ ) :: neG, inform, nS, nInf, nNames + integer ( kind = ip_ ) :: j, jslack, neq, nlc, status + real ( kind = rp_ ) :: ObjAdd, sInf, Obj, cpu(4), calls(7) + integer ( kind = ip_ ), allocatable :: iu(:), iw(:) + real ( kind = rp_ ), allocatable :: ru(:), rw(:) + character*8, allocatable :: cu(:), cw(:) + integer ( kind = ip_ ), allocatable :: hs(:), indA(:), locA(:) + real ( kind = rp_ ), allocatable :: x(:), bl(:), bu(:), rc(:) + real ( kind = rp_ ), allocatable :: y(:), c(:), Aval(:) + character*8, allocatable :: Names(:) + character*10, allocatable :: vname(:), cname(:) + logical, allocatable :: equatn(:), linear(:) + integer ( kind = ip_ ), parameter :: iPrint = 15, iSpecs = 4 + integer ( kind = ip_ ), parameter :: iSumm = 6, nout = 6 + integer ( kind = ip_ ), parameter :: input = 55, io_buffer = 11 + real ( kind = rp_ ), parameter :: big = 1.0e+20_rp_ + external :: SNOPT_evalcj, SNOPT_evalfg status = 0 inform = 0 @@ -47,14 +42,12 @@ program SNOPT_main & status = 'old' ) rewind ( input ) - * --------------------------- * Compute problem dimensions. * --------------------------- - call CUTEST_cdimen( status, input, n, m ) + call CUTEST_cdimen_r( status, input, n, m ) if ( status /= 0 ) go to 920 - * --------------- * Allocate space. * --------------- @@ -69,24 +62,22 @@ program SNOPT_main & STAT=status ) if ( status /= 0 ) go to 990 - * ----------------------------- * Start setting up the problem. * ----------------------------- - call CUTEST_csetup ( status, input, nout, io_buffer, n, m, - & x, bl, bu, y, bl(n+1), bu(n+1), equatn, - & linear, 0, 2, 1 ) + call CUTEST_csetup_r( status, input, nout, io_buffer, n, m, + & x, bl, bu, y, bl(n+1), bu(n+1), equatn, + & linear, 0, 2, 1 ) close (input) if ( status /= 0 ) go to 910 - * Compute number of nonlinear variables, and linear/equality constraints. - call CUTEST_cstats ( status, nnObj, nnJac, neq, nlc ) + call CUTEST_cstats_r( status, nnObj, nnJac, neq, nlc ) if ( status /= 0 ) go to 910 * Compute the objective and constraints at x = 0. - rc(1:n) = zero - call CUTEST_cfn ( status, n, m, rc, Obj, c ) + rc(1:n) = 0.0_rp_ + call CUTEST_cfn_r( status, n, m, rc, Obj, c ) if ( status /= 0 ) go to 910 * Compute the number of nonlinear constraints. @@ -94,8 +85,8 @@ program SNOPT_main do j = 1, m if ( equatn(j) ) then - bl(n+j) = zero - bu(n+j) = zero + bl(n+j) = 0.0_rp_ + bu(n+j) = 0.0_rp_ end if end do @@ -104,7 +95,7 @@ program SNOPT_main m = m + 1 bl(n+m) = -big bu(n+m) = big - c(m) = zero + c(m) = 0.0_rp_ end if if ( nnObj < n ) then @@ -113,9 +104,8 @@ program SNOPT_main iObj = 0 end if - * Construct the structures for Jacobian. - call cutest_cdimsj( status, ne ) + call CUTEST_cdimsj_r( status, ne ) if ( status /= 0 ) go to 910 nlocG = nnJac + 1 @@ -143,7 +133,6 @@ program SNOPT_main & iu(liGfun+1), iu(ljGvar+1), ru, x, y, neG ) if ( status /= 0 ) go to 910 - * Set bounds on linear constraints. do j = 1, m jslack = n + j @@ -153,31 +142,30 @@ program SNOPT_main end if * If possible, set slack variables to be nonbasic at zero. - x(jslack) = max( zero, bl(jslack) ) + x(jslack) = max( 0.0_rp_, bl(jslack) ) x(jslack) = min( x( jslack), bu(jslack) ) end do * Set names, initialize some vectors. - call CUTEST_cnames( status, n, m, pname, vname, cname ) + call CUTEST_cnames_r( status, n, m, pname, vname, cname ) if ( status /= 0 ) go to 910 probnm = pname(1:8) - Names(1:n) = vname(1:n) + Names(1:n) = vname(1:n)(1:8) if ( iObj == 0 ) then - Names(n+1:n+m) = cname(1:m) + Names(n+1:n+m) = cname(1:m)(1:8) else - Names(n+1:n+m-1) = cname(1:m-1) + Names(n+1:n+m-1) = cname(1:m-1)(1:8) Names(n+m) = probnm end if nNames = n + m hs(1:nb) = 0 - y(1:nnCon) = zero - ObjAdd = zero + y(1:nnCon) = 0.0_rp_ + ObjAdd = 0.0_rp_ if ( nnObj == 0 ) ObjAdd = Objadd - Obj - * ------------------------------ * Open SNOPT input/output files. * Initialize SNOPT @@ -222,7 +210,7 @@ program SNOPT_main end if - call CUTEST_creport( status, calls, cpu ) + call CUTEST_creport_r( status, calls, cpu ) if ( status /= 0 ) go to 910 write(nout,2000) pname, n, m, calls(1), calls(2), calls(5), @@ -259,8 +247,7 @@ program SNOPT_main if ( status /= 0 ) go to 920 - call CUTEST_cterminate( status ) - + call CUTEST_cterminate_r( status ) stop 920 continue @@ -302,23 +289,24 @@ subroutine buildJac ( status, n, m, nnObj, nnCon, nnJac, ne, & iObj, locA, indA, A, nlocG, locG, & iGfun, jGvar, G, x, y, neG ) + use CUTEST_KINDS_precision implicit none - integer :: status, n, m, nnObj, nnCon, nnJac, ne, neG - integer :: iObj, locA(n+1), indA(ne) - integer :: nlocG, locG(nlocG), iGfun(ne), jGvar(ne) - double precision :: x(n), y(m), A(ne), G(ne) + integer ( kind = ip_ ) :: status + integer ( kind = ip_ ) :: n, m, nnObj, nnCon, nnJac, ne, neG + integer ( kind = ip_ ) :: iObj, locA(n+1), indA(ne) + integer ( kind = ip_ ) :: nlocG, locG(nlocG), iGfun(ne), jGvar(ne) + real ( kind = rp_ ) :: x(n), y(m), A(ne), G(ne) * On entry, * nlocG = nnJac + 1 * On exit, * neG - integer :: i, j, k, l, neA, lj - double precision :: zero = 0.0d+0 + integer ( kind = ip_ ) :: i, j, k, l, neA, lj lj = ne - call cutest_csgr( status, n, m, x, y, .false., ne, lj, - & G, jGvar, iGfun ) + call CUTEST_csgr_r( status, n, m, x, y, .false., ne, lj, + & G, jGvar, iGfun ) if ( status /= 0 ) return * Initialize vectors. @@ -407,7 +395,7 @@ subroutine buildJac ( status, n, m, nnObj, nnCon, nnJac, ne, if (ne .eq. 0) then ne = 1 - A(ne) = zero + A(ne) = 0.0_rp_ indA(ne) = 1 locA(n+1) = ne + 1 end if @@ -418,14 +406,15 @@ subroutine buildJac ( status, n, m, nnObj, nnCon, nnJac, ne, subroutine SNOPT_evalfg ( mode, nnObj, x, fObj, gObj, nState, & cu, lencu, iu, leniu, ru, lenru ) - integer :: mode, nnObj, nState, lencu, leniu, lenru - integer :: iu(leniu) - double precision :: fObj - double precision :: x(nnObj), gObj(nnObj), ru(lenru) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) :: mode, nnObj, nState, lencu, leniu, lenru + integer ( kind = ip_ ) :: iu(leniu) + real ( kind = rp_ ) :: fObj + real ( kind = rp_ ) :: x(nnObj), gObj(nnObj), ru(lenru) character*8 :: cu(lencu) logical :: needG - integer :: status + integer ( kind = ip_ ) :: status if (mode .eq. 0) then needG = .false. @@ -433,7 +422,7 @@ subroutine SNOPT_evalfg ( mode, nnObj, x, fObj, gObj, nState, needG = .true. end if - call cutest_cofg ( status, nnObj, x, fObj, gObj, needG ) + call CUTEST_cofg_r( status, nnObj, x, fObj, gObj, needG ) if ( status .ne. 0 ) THEN write( 6, "( ' CUTEst error, status = ', i0, ', stopping' )") @@ -449,13 +438,14 @@ subroutine SNOPT_evalcj ( mode, nnCon, nnJac, neG, x, & fCon, gCon, nState, & cu, lencu, iu, leniu, ru, lenru ) - integer :: mode, nnCon, nnJac, neG, nState - integer :: lencu, leniu, lenru - integer :: iu(leniu) - double precision :: x(nnJac), fCon(nnCon), gCon(neG), ru(lenru) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) :: mode, nnCon, nnJac, neG, nState + integer ( kind = ip_ ) :: lencu, leniu, lenru + integer ( kind = ip_ ) :: iu(leniu) + real ( kind = rp_ ) :: x(nnJac), fCon(nnCon), gCon(neG), ru(lenru) character*8 :: cu(lencu) - integer :: liGfun, ljGvar, llocG, lG, nlocG + integer ( kind = ip_ ) :: liGfun, ljGvar, llocG, lG, nlocG llocG = iu(1) liGfun = iu(2) @@ -476,21 +466,22 @@ subroutine funcon0 ( mode, nnCon, nnJac, neG, & x, fCon, gCon, nState, & nlocG, locG, iGfun, jGvar, G ) - integer :: mode, nlocG, nnCon, neG, nnJac, nState - integer :: iGfun(neG), jGvar(neG), locG(nlocG) - double precision :: x(nnJac), fCon(nnCon), gCon(neG) - double precision :: G(neG) + use CUTEST_KINDS_precision + integer ( kind = ip_ ) :: mode, nlocG, nnCon, neG, nnJac, nState + integer ( kind = ip_ ) :: iGfun(neG), jGvar(neG), locG(nlocG) + real ( kind = rp_ ) :: x(nnJac), fCon(nnCon), gCon(neG) + real ( kind = rp_ ) :: G(neG) - integer :: j, k, l, nnzJ - integer :: status + integer ( kind = ip_ ) :: j, k, l, nnzJ + integer ( kind = ip_ ) :: status logical :: needG needG = mode .gt. 0 * Evaluate the problem constraints. On input, nnCon > 0. * The Jacobian is stored in sparse format. - call cutest_ccfsg ( status, nnJac, nnCon, x, fCon, nnzj, neG, - & G, jGvar, iGfun, needG ) + call CUTEST_ccfsg_r( status, nnJac, nnCon, x, fCon, nnzj, neG, + & G, jGvar, iGfun, needG ) if ( status .ne. 0 ) go to 910 if ( needG ) then diff --git a/src/snopt/snopt_test.F b/src/snopt/snopt_test.F new file mode 100644 index 0000000..6832731 --- /dev/null +++ b/src/snopt/snopt_test.F @@ -0,0 +1,67 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy SNOPT for testing snopt_main interface to CUTEst + +C Nick Gould, 14th January 2013 + + subroutine snoptb( Start, m, n, ne, nName, + & nnCon, nnObj, nnJac, + & iObj, ObjAdd, Prob, + & fgcon, fgobj, + & Jcol, indJ, locJ, bl, bu, Names, + & hs, x, pi, rc, + & inform, mincw, miniw, minrw, + & nS, nInf, sInf, Obj, + & cu, lencu, iu, leniu, ru, lenru, + & cw, lencw, iw, leniw, rw, lenrw ) + use CUTEST_KINDS_precision + implicit none + external fgcon, fgobj + integer ( kind = ip_ ) inform, iObj, lencu, leniu, lenru, lencw + integer ( kind = ip_ ) leniw, lenrw, mincw, miniw, minrw, m, n + integer ( kind = ip_ ) ne, nName, nS, nInf, nnCon, nnObj, nnJac + integer ( kind = ip_ ) indJ(ne), hs(n+m), locJ(n+1), iu(leniu) + integer ( kind = ip_ ) iw(leniw) + real ( kind = rp_ ) sInf, Obj, ObjAdd, Jcol(ne), bl(n+m), bu(n+m) + real ( kind = rp_ ) x(n+m), pi(m), rc(n+m), ru(lenru), rw(lenrw) + character ( len = 8 ) Start + character ( len = 8 ) Prob, Names(nName), cu(lencu), cw(lencw) + integer ( kind = ip_ ) mode, nstate + mode = 1 + call fgobj( mode, n, x, obj, rc, nstate, cu, lencu, + * iu, leniu, ru, lenru ) + call fgcon( mode, m, n, ne, x, rc, Jcol, nstate, + * cu, lencu, iu, leniu, ru, lenru ) + inform = 1 + return + end + + subroutine snInit( iPrint, iSumm, cw, lencw, iw, leniw, + & rw, lenrw ) + use CUTEST_KINDS_precision + implicit none + integer ( kind = ip_ ) iPrint, iSumm, lencw, leniw, lenrw + integer ( kind = ip_ ) iw(leniw) + real ( kind = rp_ ) rw(lenrw) + character ( len = 8 ) cw(lencw) + integer ( kind = ip_ ), parameter :: ldenj = 105 +C dense derivatives +C iw( ldenj ) = 1 +C sparse derivatives + iw( ldenj ) = 0 + return + end + + subroutine snSpec( iSpecs, inform, cw, lencw, iw, leniw, + & rw, lenrw ) + use CUTEST_KINDS_precision + implicit none + integer ( kind = ip_ ) iSpecs, inform, lencw, leniw, lenrw + integer ( kind = ip_ ) iw(leniw) + real ( kind = rp_ ) rw(lenrw) + character ( len = 8 ) cw(lencw) + inform = 101 + return + end diff --git a/src/snopt/snopt_test.f b/src/snopt/snopt_test.f deleted file mode 100644 index 59422f5..0000000 --- a/src/snopt/snopt_test.f +++ /dev/null @@ -1,64 +0,0 @@ -C ( Last modified on 14 Jan 2013 at 16:00:00 ) - -C Dummy SNOPT for testing snopt_main interface to CUTEst -C Nick Gould, 14th January 2013 - - subroutine snoptb( Start, m, n, ne, nName, - & nnCon, nnObj, nnJac, - & iObj, ObjAdd, Prob, - & fgcon, fgobj, - & Jcol, indJ, locJ, bl, bu, Names, - & hs, x, pi, rc, - & inform, mincw, miniw, minrw, - & nS, nInf, sInf, Obj, - & cu, lencu, iu, leniu, ru, lenru, - & cw, lencw, iw, leniw, rw, lenrw ) - implicit none - external fgcon, fgobj - integer inform, iObj, lencu, leniu, lenru, lencw, leniw, lenrw, - & mincw, miniw, minrw, m, n, ne, nName, nS, nInf, nnCon, - & nnObj, nnJac, indJ(ne), hs(n+m), locJ(n+1), iu(leniu), - & iw(leniw) - double precision sInf, Obj, ObjAdd, Jcol(ne), bl(n+m), bu(n+m), - & x(n+m), pi(m), rc(n+m), ru(lenru), rw(lenrw) - character ( len = 8 ) Start - character ( len = 8 ) Prob, Names(nName), cu(lencu), cw(lencw) - integer mode, nstate - mode = 1 - call fgobj( mode, n, x, obj, rc, nstate, cu, lencu, - * iu, leniu, ru, lenru ) - call fgcon( mode, m, n, ne, x, rc, Jcol, nstate, - * cu, lencu, iu, leniu, ru, lenru ) - return - end - - subroutine s1open( lun, index, state ) - implicit none - integer lun, index - character ( len = 3 ) state - return - end - - subroutine snInit( iPrint, iSumm, cw, lencw, iw, leniw, - & rw, lenrw ) - implicit none - integer iPrint, iSumm, lencw, leniw, lenrw, iw(leniw) - double precision rw(lenrw) - character ( len = 8 ) cw(lencw) - integer, parameter :: ldenj = 105 -C dense derivatives -C iw( ldenj ) = 1 -C sparse derivatives - iw( ldenj ) = 0 - return - end - - subroutine snSpec( iSpecs, inform, cw, lencw, iw, leniw, - & rw, lenrw ) - implicit none - integer iSpecs, inform, lencw, leniw, lenrw, iw(leniw) - double precision rw(lenrw) - character ( len = 8 ) cw(lencw) - inform = 0 - return - end diff --git a/src/spg/makemaster b/src/spg/makemaster index 7d7b63a..1a7ce00 100644 --- a/src/spg/makemaster +++ b/src/spg/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst SPG interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 18 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = SPG -package = spg - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = SPG +package = spg -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/spg/spg_main.f b/src/spg/spg_main.F similarity index 72% rename from src/spg/spg_main.f rename to src/spg/spg_main.F index 705fe23..a71cc71 100644 --- a/src/spg/spg_main.f +++ b/src/spg/spg_main.F @@ -1,4 +1,7 @@ -C ( Last modified on 18 Feb 2013 at 13:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM SPG_main @@ -15,13 +18,15 @@ PROGRAM SPG_main C Set up parameters, variables and arrays required by unconstrained tools - INTEGER, PARAMETER :: input = 55, indr = 46, out = 6 - INTEGER :: inform, iprint, n, iter, maxit, fcnt, maxfc, spginfo - INTEGER :: status - DOUBLE PRECISION :: epsopt, f, gpsupn + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, indr = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + INTEGER ( KIND = ip_ ) :: inform, iprint, n, iter, maxit, fcnt + INTEGER ( KIND = ip_ ) :: status, maxfc, spginfo + REAL ( KIND = rp_ ) :: epsopt, f, gpsupn CHARACTER * 10 :: pname - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X C Open the relevant file @@ -31,7 +36,7 @@ PROGRAM SPG_main C compute problem dimensions - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 C close input so that inip can open it again! CLOSE( input ) @@ -67,13 +72,13 @@ PROGRAM SPG_main C output information - CALL CUTEST_ureport( status, CALLS, CPU ) - CALL CUTEST_probname( status, pname ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) + CALL CUTEST_probname_r( status, pname ) IF ( out .GT. 0 ) WRITE ( out, 2000 ) pname, n, CALLS( 1 ), * CALLS( 2 ), inform, f, CPU( 1 ), CPU( 2 ) DEALLOCATE( X, STAT = status ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -105,27 +110,28 @@ PROGRAM SPG_main subroutine inip(n,x) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer n + integer ( kind = ip_ ) n C ARRAY ARGUMENTS - double precision x(*) + real ( kind = rp_ ) x(*) C PARAMETERS - integer input,iout,nmax + integer ( kind = ip_ ) input, iout, nmax parameter ( nmax = 100000 ) - parameter ( input = 55 ) - parameter ( iout = 6 ) - INTEGER, PARAMETER :: io_buffer = 11 - INTEGER :: status + parameter ( input = 55 ) + parameter ( iout = 6 ) + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + INTEGER ( KIND = ip_ ) :: status C COMMON ARRAYS - double precision l(nmax),u(nmax) + real ( kind = rp_ ) l( nmax ), u( nmax ) C COMMON BLOCKS - common /bounds/ l,u + common /bounds/ l, u save /bounds/ C EXTERNAL SUBROUTINES @@ -133,7 +139,7 @@ subroutine inip(n,x) open(input,file='OUTSDIF.d',form='FORMATTED',status='OLD') rewind( input ) - call CUTEST_usetup(status,input,iout,io_buffer,n,x,l,u) + call CUTEST_usetup_r( status, input, iout, io_buffer, n, x, l, u ) if ( status .ne. 0 ) then write( 6, "( ' CUTEst error, status = ', i0, ', stopping' )" ) * status @@ -149,20 +155,21 @@ subroutine inip(n,x) subroutine evalf(n,x,f,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,n - double precision f + integer ( kind = ip_ ) flag, n + real ( kind = rp_ ) f C ARRAY ARGUMENTS - double precision x(n) + real ( kind = rp_ ) x( n ) C EXTERNAL SUBROUTINES external ufn flag = 0 - call CUTEST_ufn(flag,n,x,f) + call CUTEST_ufn_r( flag, n, x, f ) end @@ -171,19 +178,20 @@ subroutine evalf(n,x,f,flag) subroutine evalg(n,x,g,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,n + integer ( kind = ip_ ) flag,n C ARRAY ARGUMENTS - double precision g(n),x(n) + real ( kind = rp_ ) g( n ), x( n ) C EXTERNAL SUBROUTINES external ugr flag = 0 - call CUTEST_ugr(flag,n,x,g) + call CUTEST_ugr_r( flag, n, x, g ) end @@ -192,23 +200,24 @@ subroutine evalg(n,x,g,flag) subroutine proj(n,x,flag) + use CUTEST_KINDS_precision implicit none C SCALAR ARGUMENTS - integer flag,n + integer ( kind = ip_ ) flag,n C ARRAY ARGUMENTS - double precision x(n) + real ( kind = rp_ ) x(n) C PARAMETERS - integer nmax + integer ( kind = ip_ ) nmax parameter ( nmax = 100000 ) C COMMON ARRAYS - double precision l(nmax),u(nmax) + real ( kind = rp_ ) l(nmax), u(nmax) C LOCAL SCALARS - integer i + integer ( kind = ip_ ) i C COMMON BLOCKS common /bounds/ l,u diff --git a/src/spg/spg_test.F b/src/spg/spg_test.F new file mode 100644 index 0000000..ced2ca7 --- /dev/null +++ b/src/spg/spg_test.F @@ -0,0 +1,25 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +! Dummy SPG for testing spg_main interface to CUTEst + +! Nick Gould, 18th February 2013 + + subroutine spg(n, x, epsopt, maxit, maxfc, iprint, f, gpsupn, + + iter, fcnt, spginfo, inform) + + use CUTEST_KINDS_precision + implicit none + +C SCALAR ARGUMENTS + real ( kind = rp_ ) gpsupn, epsopt, f + integer ( kind = ip_ ) fcnt, inform, iprint, iter + integer ( kind = ip_ ) maxfc, maxit, n, spginfo + +C ARRAY ARGUMENTS + real ( kind = rp_ ) x( n ) + real ( kind = rp_ ) g( n ) + call evalf( n, x, f, inform ) + if ( inform .ne. 0 ) call evalg( n, x, g, inform ) + end diff --git a/src/spg/spg_test.f b/src/spg/spg_test.f deleted file mode 100644 index 54ae096..0000000 --- a/src/spg/spg_test.f +++ /dev/null @@ -1,20 +0,0 @@ -! ( Last modified on 18 Feb 2013 at 13:50:00 ) - -! Dummy SPG for testing spg_main interface to CUTEst -! Nick Gould, 18th February 2013 - - subroutine spg(n,x,epsopt,maxit,maxfc,iprint,f,gpsupn,iter,fcnt, - + spginfo,inform) - - implicit none - -C SCALAR ARGUMENTS - double precision gpsupn,epsopt,f - integer fcnt,inform,iprint,iter,maxfc,maxit,n,spginfo - -C ARRAY ARGUMENTS - double precision x(n) - double precision g(n) - call evalf(n,x,f,inform) - if ( inform .ne. 0 ) call evalg(n,x,g,inform) - end diff --git a/src/spg/u_test.output b/src/spg/u_test.output index 30dba86..09966bd 100644 --- a/src/spg/u_test.output +++ b/src/spg/u_test.output @@ -1,4 +1,3 @@ - -1.0000000000000000E+20 -1.0000000000000000E+20 -1.0000000000000000E+20 -1.0000000000000000E+20 -1.0000000000000000E+20 ************************ CUTEst statistics ************************ diff --git a/src/sqic/makemaster b/src/sqic/makemaster index 00d2f89..945f9df 100644 --- a/src/sqic/makemaster +++ b/src/sqic/makemaster @@ -1,170 +1,37 @@ # Main body of the installation makefile for CUTEst SQIC interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 26 II 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-25 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = SQIC -package = sqic - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -#FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) \ -# -I$(SQIC)/mod $(F90) $(USUAL) -#FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) \ -# -I$(SQIC)/mod $(F90) $(SPECIAL) -#FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod $(F90) -#FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod \ -# $(F77) $(USUAL) -#FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod \ -# $(F77) $(SPECIAL) -#FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod \ -# $(F77) $(USUAL) -#RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) -I$(SQIC)/mod - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -#$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -$(package)_double: $(OBJ)/$(package)_dummy.o $(OBJ)/$(package)_main.o -#$(package)_double: $(OBJ)/$(package)_main.o - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of constrained $(package)" - echo "$(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +PACKAGE = SQIC +package = sqic -# individual compilations +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f90 > \ - $(OBJ)/$(package)_test.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS) \ - $(package)_test.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGSN) $(package)_test.f90 ) - $(RM) $(OBJ)/$(package)_test.f90 - @printf '[ OK ]\n' +# include standard CUTEst makefile definitions -# CUTEst interface main programs +include $(CUTEST)/src/makedefs/definitions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 $(OBJ)/*.mod - @printf '[ OK ]\n' +# include compilation and run instructions -$(OBJ)/$(package)_dummy.o: ../$(package)/$(package)_dummy.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_dummy" - $(SED) -f $(SEDS) ../$(package)/$(package)_dummy.f90 > \ - $(OBJ)/$(package)_dummy.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_dummy.o $(FFLAGS) \ - $(package)_dummy.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_dummy.o $(FFLAGS77N) \ - $(package)_dummy.f90 ) - $(RM) $(OBJ)/$(package)_dummy.f90 $(OBJ)/$(package)_dummy.o - $(RMOBFILE) $(package)_main.o - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_qp_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/sqic/sqic_main.f90 b/src/sqic/sqic_main.F90 similarity index 78% rename from src/sqic/sqic_main.f90 rename to src/sqic/sqic_main.F90 index e2ae019..bdd6868 100644 --- a/src/sqic/sqic_main.f90 +++ b/src/sqic/sqic_main.F90 @@ -1,4 +1,7 @@ -! ( Last modified on 28 Feb 2014 at 08:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-25 AT 14:40 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" program sqic_main @@ -12,25 +15,27 @@ program sqic_main ! updates February 2014, Elizabeth Wong !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - use CUTEst_interface_double + + use CUTEST_KINDS_precision + use CUTEST_INTERFACE_precision implicit none - integer, parameter :: ip = kind( 1 ), rp = kind( 1.0D+0 ) - integer(ip), parameter :: iCutest = 55, iOut = 6, io_buffer = 11 - integer(ip), parameter :: iPrint = 9, iSumm = 6, iSpecs = 4 - integer(ip) :: INFO, n, m, nm, nnH, ncObj, neA, lenA, neH, neH2, lenH, nS - integer(ip) :: iObj, nName, status, alloc_stat, j, nInf - real(rp) :: Obj, ObjAdd, sInf - real(rp) :: CPU( 4 ), CALLS( 7 ) + integer(kind=ip_), parameter :: iCutest = 55, iOut = 6, io_buffer = 11 + integer(kind=ip_), parameter :: iPrint = 9, iSumm = 6, iSpecs = 4 + integer(kind=ip_) :: INFO, n, m, nm, nnH, ncObj, neA, lenA, neH, neH2 + integer(kind=ip_) :: iObj, nName, status, alloc_stat, j, nInf, lenH, nS + real(kind=rp_) :: Obj, ObjAdd, sInf + real(kind=rp_) :: CPU( 4 ), CALLS( 7 ) character(8) :: Names(1) character(10) :: Prob character(20) :: filename - integer(ip), pointer :: hs(:), hEtype(:), indA(:), locA(:), jcol2(:) - integer(ip), pointer :: indH(:), locH(:), irow(:), jcol(:), irow2(:) - real(rp), pointer :: bl(:), bu(:), x(:), pi(:), rc(:), cObj(:) - real(rp), pointer :: valA(:), valH(:), zero(:), cval(:), cval2(:), b(:) + integer(kind=ip_), pointer :: hs(:), hEtype(:), indA(:), locA(:), jcol2(:) + integer(kind=ip_), pointer :: indH(:), locH(:), irow(:), jcol(:), irow2(:) + real(kind=rp_), pointer :: bl(:), bu(:), x(:), pi(:), rc(:), cObj(:) + real(kind=rp_), pointer :: valA(:), valH(:), zero(:) + real(kind=rp_), pointer :: cval(:), cval2(:), b(:) logical, pointer :: equation(:), linear(:) character(10), pointer :: vname(:), gname(:) @@ -38,7 +43,7 @@ program sqic_main rewind( iCutest ) ! Get dimensions and allocate space. - call CUTEST_cdimen( status, iCutest, n, m ) + call CUTEST_cdimen_r( status, iCutest, n, m ) if ( status /= 0 ) go to 910 !----------------------------------------------------------------------------- @@ -57,27 +62,27 @@ program sqic_main zero = 0.0 x = 0.0 - call CUTEST_csetup( status, iCutest, iOut, io_buffer, & - n, m, x(1:n), bl(1:n), bu(1:n), & - pi, bl(n+1:nm), bu(n+1:nm), equation, linear, 0, 2, 1 ) + call CUTEST_csetup_r( status, iCutest, iOut, io_buffer, & + n, m, x(1:n), bl(1:n), bu(1:n), pi, & + bl(n+1:nm), bu(n+1:nm), equation, linear, 0, 2, 1 ) if ( status /= 0 ) go to 910 deallocate ( equation, linear ) allocate ( vname(n), gname(m), stat = alloc_stat ) if ( alloc_stat /= 0 ) GO TO 990 - call CUTEST_cnames( status, n, m, Prob, vname, gname ) + call CUTEST_cnames_r( status, n, m, Prob, vname, gname ) if ( status /= 0 ) go to 910 deallocate ( vname, gname ) - call CUTEST_cdimsj( status, lenA ) + call CUTEST_cdimsj_r( status, lenA ) if ( status /= 0 ) go to 910 lenA = lenA - n allocate ( cval(lenA), irow(lenA), jcol(lenA), stat = alloc_stat ) if ( alloc_stat /= 0 ) GO TO 990 - call CUTEST_ccfsg( status, n, m, zero, b, neA, lenA, cval, jcol, irow, & - .true. ) + call CUTEST_ccfsg_r( status, n, m, zero, b, neA, lenA, cval, jcol, irow, & + .true. ) if ( status /= 0 ) go to 910 bl(n+1:nm) = bl(n+1:nm) - b @@ -92,19 +97,19 @@ program sqic_main ! Objective ! cofg returns ObjAdd and cObj. - call CUTEST_cofg( status, n, zero, ObjAdd, cObj, .true. ) + call CUTEST_cofg_r( status, n, zero, ObjAdd, cObj, .true. ) if ( status /= 0 ) go to 910 ! Hessian of the objective ! Stored in the module variables neH, valH, locH, indH. - call CUTEST_cdimsh ( status, lenH ) + call CUTEST_cdimsh_r ( status, lenH ) if ( status /= 0 ) go to 910 if ( lenH > 0 ) then allocate ( cval(lenH), irow(lenH), jcol(lenH), stat = alloc_stat ) if ( alloc_stat /= 0 ) GO TO 990 - call CUTEST_cish ( status, n, zero, 0, neH, lenH, cval, irow, jcol ) + call CUTEST_cish_r ( status, n, zero, 0, neH, lenH, cval, irow, jcol ) if ( status /= 0 ) go to 910 allocate ( cval2(2*lenH), irow2(2*lenH), jcol2(2*lenH) ) @@ -150,13 +155,13 @@ program sqic_main zero = 0.0 x = 0.0 - call CUTEST_usetup ( status, iCutest, iOut, io_buffer, & - n, x(1:n), bl(1:n), bu(1:n) ) + call CUTEST_usetup_r ( status, iCutest, iOut, io_buffer, & + n, x(1:n), bl(1:n), bu(1:n) ) if ( status /= 0 ) go to 910 allocate ( vname(n), stat = alloc_stat ) if ( alloc_stat /= 0 ) GO TO 990 - call CUTEST_unames ( status, n, Prob, vname ) + call CUTEST_unames_r ( status, n, Prob, vname ) if ( status /= 0 ) go to 910 deallocate ( vname ) @@ -167,28 +172,28 @@ program sqic_main do j = 1, n indA(j) = 1 - valA(j) = 1.0_rp + valA(j) = 1.0_rp_ locA(j) = j end do locA(n+1) = neA+1 x(n+1) = 0.0 - bl(n+1) = -1.0D+20 - bu(n+1) = 1.0D+20 + bl(n+1) = -1.0E+20_rp_ + bu(n+1) = 1.0E+20_rp_ ! Objective ! uofg returns ObjAdd and cObj. - call CUTEST_uofg( status, n, zero, ObjAdd, cObj, .true. ) + call CUTEST_uofg_r( status, n, zero, ObjAdd, cObj, .true. ) if ( status /= 0 ) go to 910 ! Hessian of the objective - call CUTEST_udimsh ( status, lenH ) + call CUTEST_udimsh_r( status, lenH ) if ( status /= 0 ) go to 910 if ( lenH > 0 ) then allocate ( cval(lenH), irow(lenH), jcol(lenH), stat = alloc_stat ) if ( alloc_stat /= 0 ) GO TO 990 - call CUTEST_ush( status, n, zero, neH, lenH, cval, irow, jcol ) + call CUTEST_ush_r( status, n, zero, neH, lenH, cval, irow, jcol ) if ( status /= 0 ) go to 910 allocate ( cval2(2*lenH), irow2(2*lenH), jcol2(2*lenH) ) @@ -245,8 +250,7 @@ program sqic_main neH, indH, locH, valH, & nS, nInf, sInf, Obj ) - - call CUTEST_creport( status, CALLS, CPU ) + call CUTEST_creport_r( status, CALLS, CPU ) WRITE ( iOut, 2000 ) Prob, n, m, CALLS( 1 ), CALLS( 2 ), & CALLS( 5 ), CALLS( 6 ), info, Obj, CPU( 1 ), CPU( 2 ) @@ -260,7 +264,7 @@ program sqic_main close ( iPrint ) close ( iCutest ) - call CUTEST_cterminate( status ) + call CUTEST_cterminate_r( status ) stop 910 CONTINUE diff --git a/src/sqic/sqic_test.f90 b/src/sqic/sqic_test.F90 similarity index 50% rename from src/sqic/sqic_test.f90 rename to src/sqic/sqic_test.F90 index 6d4fe80..7942a9b 100644 --- a/src/sqic/sqic_test.f90 +++ b/src/sqic/sqic_test.F90 @@ -1,4 +1,6 @@ -! ( Last modified on 28 Feb 2014 at 09:50:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-25 AT 14:40 GMT. + +#include "cutest_modules.h" ! slimline CUTEst interface sqic_main to SQIC ! Nick Gould, February 2014 @@ -10,12 +12,12 @@ !============================================================================= subroutine crd2spr ( n, ne, cval, irow, jcol, val, ind, loc ) + use CUTEST_KINDS_precision implicit none - integer, parameter :: ip = kind( 1 ), rp = kind( 1.0D+0 ) - integer(ip), intent(in) :: n, ne, irow(ne), jcol(ne) - real(rp), intent(in) :: cval(ne) - integer(ip), intent(out) :: ind(ne), loc(n+1) - real(rp), intent(out) :: val(ne) + integer(kind=ip_), intent(in) :: n, ne, irow(ne), jcol(ne) + real(kind=rp_), intent(in) :: cval(ne) + integer(kind=ip_), intent(out) :: ind(ne), loc(n+1) + real(kind=rp_), intent(out) :: val(ne) end subroutine crd2spr subroutine ctSQIC ( Start, INFO, iPrint, iSumm, iSpecs, name, & @@ -23,20 +25,21 @@ subroutine ctSQIC ( Start, INFO, iPrint, iSumm, iSpecs, name, & neA, indA, locA, valA, bl, bu, ncObj, cObj, & nNames, Names, hEtype, hs, x, pi, rc, & neH, indH, locH, valH, nS, nInf, sInf, Obj ) + use CUTEST_KINDS_precision implicit none - integer, parameter :: ip = kind( 1 ), rp = kind( 1.0D+0 ) character*(*), intent(in) :: Start - integer(ip), intent(in) :: iPrint, iSumm, iSpecs - integer(ip), intent(inout) :: nInf - integer(ip), intent(out) :: INFO, nS - real(rp), intent(out) :: sInf, Obj + integer(kind=ip_), intent(in) :: iPrint, iSumm, iSpecs + integer(kind=ip_), intent(inout) :: nInf + integer(kind=ip_), intent(out) :: INFO, nS + real(kind=rp_), intent(out) :: sInf, Obj character(8), intent(in) :: name - integer(ip), intent(in) :: m, n, nnH, ncObj, neA, iObj, nNames, neH - real(rp), intent(in) :: ObjAdd - character(8), target :: Names(nNames) - integer(ip), target :: locA(n+1), indA(neA), locH(nnH+1), indH(neH) - integer(ip), target :: hEtype(n+m), hs(n+m) - real(rp), target :: cObj(ncObj), bl(n+m), bu(n+m), valA(neA) - real(rp), target :: valH(neH), x(n+m), pi(m), rc(n+m) + integer(kind=ip_), intent(in) :: m, n, nnH, ncObj, neA, iObj, nNames, neH + real(kind=rp_), intent(in) :: ObjAdd + character(8), target :: Names(nNames) + integer(kind=ip_), target :: locA(n+1), indA(neA), locH(nnH+1), indH(neH) + integer(kind=ip_), target :: hEtype(n+m), hs(n+m) + real(kind=rp_), target :: cObj(ncObj), bl(n+m), bu(n+m), valA(neA) + real(kind=rp_), target :: valH(neH), x(n+m), pi(m), rc(n+m) + Obj = 0.0_rp_ end subroutine ctSQIC diff --git a/src/stats/makemaster b/src/stats/makemaster index 72da57a..e1650d6 100644 --- a/src/stats/makemaster +++ b/src/stats/makemaster @@ -1,81 +1,34 @@ # Main body of the installation makefile for CUTEst STATS interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-23 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = STATS -package = stats - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a +include $(CUTEST)/src/makedefs/defaults -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# Libraries used +# package name -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda +PACKAGE = STATS +package = stats -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o -C_TEST = c_elfun.o c_group.o c_range.o +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -SUCC = precision version) compiled successfully +# include standard CUTEst makefile definitions -# main compilations and runs +include $(CUTEST)/src/makedefs/definitions -all: $(package) +# include compilation and run instructions -# basic packages +include $(CUTEST)/src/makedefs/instructions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +# select specific run test # run example tests @@ -95,42 +48,6 @@ run_test: tools test_cutest $(OBJ)/$(package)_main.o cat ../$(package)/c_test.output rm $(OBJ)/run_test ../$(package)/OUTSDIF.d -test_cutest: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f90 > \ - $(OBJ)/$(package)_main.f90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ - $(package)_main.f90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.f90 ) - $(RM) $(OBJ)/$(package)_main.f90 - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/stats/stats_main.f90 b/src/stats/stats_main.F90 similarity index 85% rename from src/stats/stats_main.f90 rename to src/stats/stats_main.F90 index abc3b59..d82b00f 100644 --- a/src/stats/stats_main.f90 +++ b/src/stats/stats_main.F90 @@ -1,50 +1,56 @@ -! ( Last modified on 7 Jan 2013 at 09:20:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-11-23 AT 10:00 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" Program STATS_main + USE CUTEST_KINDS_precision + + Implicit None + ! Statistics-collecting package for gathering information on ! variables and constraints from SIF problems. ! D. Orban, August 2005 ! CUTEst evolution Nick Gould January 2013 - Implicit None - - INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - ! Information pertaining to variables Type :: CUTEst_var_type - Integer :: nvar - Integer :: nfixed, nbelow, nabove, n2sided, nfree, nbnds + Integer ( KIND = ip_ ) :: nvar + Integer ( KIND = ip_ ) :: nfixed, nbelow, nabove, n2sided, nfree, nbnds End Type CUTEst_var_type ! Information pertaining to constraints Type :: CUTEst_con_type - Integer :: ncon - Integer :: nlle, nlge, nlrange, nleq, nlin - Integer :: nnlle, nnlge, nnlrange, nnleq, nnlin + Integer ( KIND = ip_ ) :: ncon + Integer ( KIND = ip_ ) :: nlle, nlge, nlrange, nleq, nlin + Integer ( KIND = ip_ ) :: nnlle, nnlge, nnlrange, nnleq, nnlin End Type CUTEst_con_type Type :: CUTEst_db_type - Integer :: nfr, nfx, n1s, n2s! # free, fixed, 1-sided, 2-sided bounds - Integer :: m1sl, m2sl, meql ! # 1 and 2-sided ineq, equalities (linear) - Integer :: m1sg, m2sg, meqg ! # 1 and 2-sided ineq, equalities (general) +! # free, fixed, 1-sided, 2-sided bounds + Integer ( KIND = ip_ ) :: nfr, nfx, n1s, n2s +! # 1 and 2-sided ineq, equalities (linear) + Integer ( KIND = ip_ ) :: m1sl, m2sl, meql +! # 1 and 2-sided ineq, equalities (general) + Integer ( KIND = ip_ ) :: m1sg, m2sg, meqg Character( Len = 86 ) :: var_str Character( Len = 76 ) :: lcon_str, gcon_str Character( Len = 99 ) :: classf_db_str End Type CUTEst_db_type ! Dynamic allocation flag - Integer :: alloc_stat, status + Integer ( KIND = ip_ ) :: alloc_stat, status - Integer, Parameter :: input = 47, out = 6 - INTEGER :: io_buffer = 11 - Integer :: i + Integer ( KIND = ip_ ), Parameter :: input = 47, out = 6 + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + Integer ( KIND = ip_ ) :: i - Real( Kind = wp ), Dimension( : ), Allocatable :: x, bl, bu, v, cl, cu - DOUBLE PRECISION, PARAMETER :: infty = 9.0D+19 + Real( Kind = rp_ ), Dimension( : ), Allocatable :: x, bl, bu, v, cl, cu + Real( Kind = rp_ ), PARAMETER :: infty = REAL( 9.0D+19, KIND = rp_ ) Character( len = 10 ) :: pname - Integer :: e_order, l_order, v_order + Integer ( KIND = ip_ ) :: e_order, l_order, v_order Logical, Dimension( : ), Allocatable :: equatn, linear Logical :: constrained @@ -59,7 +65,7 @@ Program STATS_main ! Get problem dimensions and determine which tools to use - Call CUTEST_cdimen( status, input, vars%nvar, cons%ncon ) + Call CUTEST_cdimen_r( status, input, vars%nvar, cons%ncon ) If( cons%ncon < 0 ) Then Close( input ) Write( out, '(A)' ) 'Error reading OUTSDIF.d' @@ -119,9 +125,10 @@ Program STATS_main ! If all ok, initialize problem data - Call CUTEST_csetup( status, input, out, io_buffer, vars%nvar, cons%ncon, & - x, bl, bu, v, cl, cu, equatn, linear, & - e_order, l_order, v_order ) + Call CUTEST_csetup_r( status, input, out, io_buffer, & + vars%nvar, cons%ncon, & + x, bl, bu, v, cl, cu, equatn, linear, & + e_order, l_order, v_order ) Else Allocate( equatn( 1 ), STAT = alloc_stat ) If( alloc_stat /= 0 ) Then @@ -133,12 +140,12 @@ Program STATS_main Write( out, 3000 ) 'LINEAR', 1 Goto 900 End If - Call CUTEST_usetup( status, input, out, io_buffer, vars%nvar, x, bl, bu ) + Call CUTEST_usetup_r( status, input, out, io_buffer, vars%nvar, x, bl, bu ) Endif ! Obtain problem name. - Call CUTEST_probname( status, pname ) + Call CUTEST_probname_r( status, pname ) ! Initialize data on variables @@ -268,7 +275,7 @@ Program STATS_main ! Close the problem file Close( input ) - CALL CUTEST_cterminate( status ) + CALL CUTEST_cterminate_r( status ) ! Free allocated memory @@ -287,7 +294,7 @@ Program STATS_main Stop - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP ! Non-executable statements. diff --git a/src/stenmin/makemaster b/src/stenmin/makemaster index e1d07c3..412a221 100644 --- a/src/stenmin/makemaster +++ b/src/stenmin/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst STENMIN interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-26 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = STENMIN -package = stenmin - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = STENMIN +package = stenmin -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/stenmin/stenmin_main.f b/src/stenmin/stenmin_main.F similarity index 68% rename from src/stenmin/stenmin_main.f rename to src/stenmin/stenmin_main.F index 264884f..9b7fb45 100644 --- a/src/stenmin/stenmin_main.f +++ b/src/stenmin/stenmin_main.F @@ -1,26 +1,35 @@ -C ( Last modified on 7 Jan 2013 at 08:20:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-26 AT 15:30 GMT. - PROGRAM STENMIN_main +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM STENMIN_main + + USE CUTEST_KINDS_precision C STENMIN test driver for problems derived from SIF files. C Ph. Toint, January 1996, for CGT Productions. C Revised for CUTEst, Nick Gould, January 2013 - INTEGER :: n, nz, lirn, licn, ilim, method, grdflg, hsnflg, ndigit - INTEGER :: nnzh, msg, lwrk, liwrk, termcd, inform, i, status - INTEGER, PARAMETER :: input = 55, out = 6, inspec = 46 - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION :: fscale, gradtl, steptl, fpls, stepmx, gnorm - DOUBLE PRECISION :: typxvl - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19, zero = 0.0D+0 + INTEGER ( KIND = ip_ ) :: n, nz, lirn, licn, ilim, method, grdflg + INTEGER ( KIND = ip_ ) :: hsnflg, ndigit, i, status + INTEGER ( KIND = ip_ ) :: nnzh, msg, lwrk, liwrk, termcd, inform + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, inspec = 46 + REAL ( KIND = rp_ ) :: fscale, gradtl, steptl, fpls, stepmx, gnorm + REAL ( KIND = rp_ ) :: typxvl + REAL ( KIND = rp_ ), PARAMETER :: biginf = REAL( 9.0D+19, rp_ ) + REAL ( KIND = rp_ ), PARAMETER :: zero = 0.0_rp_ LOGICAL :: bounds CHARACTER ( LEN = 10 ) :: pname - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IRN, ICN, IWRK - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, TYPX, VECTOR - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: XPLS, GPLS - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: HESS, WRK + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IRN, ICN + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IWRK + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, TYPX + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: VECTOR + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: XPLS, GPLS + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: HESS, WRK CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES EXTERNAL :: STENMIN_evalf, STENMIN_evalg, STENMIN_evalsh @@ -57,7 +66,7 @@ PROGRAM STENMIN_main C find the problem dimension - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 C allocate workspace @@ -68,18 +77,18 @@ PROGRAM STENMIN_main C set up SIF data - CALL CUTEST_usetup( status, INPUT, out, io_buffer, + CALL CUTEST_usetup_r( status, INPUT, out, io_buffer, * n, X, XPLS, GPLS ) IF ( status /= 0 ) GO TO 910 C obtain variable names - CALL CUTEST_unames( status, n, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, n, PNAME, XNAMES ) IF ( status /= 0 ) GO TO 910 C compute the number of nonzeros in the Hessian - CALL CUTEST_udimsh( status, nnzh ) + CALL CUTEST_udimsh_r( status, nnzh ) IF ( status /= 0 ) GO TO 910 lirn = 2 * nnzh @@ -114,7 +123,7 @@ PROGRAM STENMIN_main * out, method, grdflg, hsnflg, ndigit, msg, XPLS, * FPLS, GPLS, HESS, WRK, lwrk, IWRK, liwrk, termcd, * VECTOR, INFORM ) - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 gnorm = zero @@ -129,7 +138,7 @@ PROGRAM STENMIN_main WRITE ( out, 2000 ) pname, n, CALLS( 1 ), CALLS( 2 ), CALLS( 3 ), * termcd, fpls, CPU( 1 ), CPU( 2 ) CLOSE( INPUT ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -165,15 +174,16 @@ PROGRAM STENMIN_main END SUBROUTINE STENMIN_evalf( n, X, f ) - INTEGER :: n - DOUBLE PRECISION :: f, X( n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: f, X( n ) C Interface for STENMIN (Chow, Schnabel, Eskow, 1993) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ufn( status, n, X, f ) - IF ( status .NE. 0 ) THEN + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ufn_r( status, n, X, f ) + IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status STOP @@ -182,12 +192,13 @@ SUBROUTINE STENMIN_evalf( n, X, f ) END SUBROUTINE STENMIN_evalg( n, X, G ) - INTEGER :: n - DOUBLE PRECISION :: X( n ), G( n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ugr( status, n, X, G ) - IF ( status .NE. 0 ) THEN + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: X( n ), G( n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ugr_r( status, n, X, G ) + IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status STOP @@ -196,14 +207,15 @@ SUBROUTINE STENMIN_evalg( n, X, G ) END SUBROUTINE STENMIN_evalsh( n, X, nnzh, lh, H_val, H_row, H_col ) - INTEGER :: n, lh, nnzh - INTEGER :: H_row( lh ), H_col( lh ) - DOUBLE PRECISION :: X( n ) - DOUBLE PRECISION :: H_val( lh ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ush( status, n, X, nnzh, lh, H_val, H_row, H_col ) - IF ( status .NE. 0 ) THEN + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, lh, nnzh + INTEGER ( KIND = ip_ ) :: H_row( lh ), H_col( lh ) + REAL ( KIND = rp_ ) :: X( n ) + REAL ( KIND = rp_ ) :: H_val( lh ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ush_r( status, n, X, nnzh, lh, H_val, H_row, H_col ) + IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status STOP diff --git a/src/stenmin/stenmin_test.F b/src/stenmin/stenmin_test.F new file mode 100644 index 0000000..45db291 --- /dev/null +++ b/src/stenmin/stenmin_test.F @@ -0,0 +1,29 @@ +C THIS VERSION: CUTEST 2.2 - 2023-11-26 AT 15:30 GMT. + +#include "cutest_modules.h" + + SUBROUTINE STUMCD( n, X, npairs, IRN, lirn, ICN, licn, EVALF, + * EVALG, EVALSH, TYPX, fscale, gradtl, steptl, + * ilim, stepmx, ipr, method, grdflg, hsnflg, + * ndigit, msg, XPLS, fpls, GPLS, HESS, WRK, + * lwrk, IWRK, liwrk, termcd, VECTOR, inform ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, npairs, lirn, licn, ilim, ipr, method + INTEGER ( KIND = ip_ ) :: grdflg, hsnflg, ndigit, msg, lwrk, liwrk + INTEGER ( KIND = ip_ ) :: inform, termcd + REAL ( KIND = rp_ ) :: fscale, gradtl,steptl, stepmx, fpls + INTEGER ( KIND = ip_ ) :: IRN( lirn ), ICN( licn ), IWRK( liwrk ) + REAL ( KIND = rp_ ) :: X( N ), TYPX( N ) + REAL ( KIND = rp_ ) :: XPLS( n ), GPLS( n ), HESS( licn ) + REAL ( KIND = rp_ ) :: WRK( lwrk ), VECTOR( n ) + EXTERNAL :: EVALF, EVALG, EVALSH + INTEGER ( KIND = ip_ ) :: i + DO 10 i = 1, n + XPLS( i ) = X( i ) + 10 CONTINUE + CALL EVALF( n, XPLS, fpls ) + CALL EVALG( n, X, GPLS ) + CALL EVALSH( n, XPLS, npairs, lirn, HESS, IRN, ICN ) + termcd = 0 + RETURN + END diff --git a/src/stenmin/stenmin_test.f b/src/stenmin/stenmin_test.f deleted file mode 100644 index b5f99f2..0000000 --- a/src/stenmin/stenmin_test.f +++ /dev/null @@ -1,23 +0,0 @@ - SUBROUTINE STUMCD( n, X, npairs, IRN, lirn, ICN, licn, EVALF, - * EVALG, EVALSH, TYPX, fscale, gradtl, steptl, - * ilim, stepmx, ipr, method, grdflg, hsnflg, - * ndigit, msg, XPLS, fpls, GPLS, HESS, WRK, - * lwrk, IWRK, liwrk, termcd, VECTOR, inform ) - INTEGER :: n, npairs, lirn, licn, ilim, ipr, method, inform - INTEGER :: grdflg, hsnflg, ndigit, msg, lwrk, liwrk, termcd - DOUBLE PRECISION :: fscale, gradtl,steptl, stepmx, fpls - INTEGER :: IRN( lirn ), ICN( licn ), IWRK( liwrk ) - DOUBLE PRECISION :: X( N ), TYPX( N ) - DOUBLE PRECISION :: XPLS( n ), GPLS( n ), HESS( licn ) - DOUBLE PRECISION :: WRK( lwrk ), VECTOR( n ) - EXTERNAL :: EVALF, EVALG, EVALSH - INTEGER :: i - DO 10 i = 1, n - XPLS( i ) = X( i ) - 10 CONTINUE - CALL EVALF( n, XPLS, fpls ) - CALL EVALG( n, X, GPLS ) - CALL EVALSH( n, XPLS, npairs, lirn, HESS, IRN, ICN ) - termcd = 0 - RETURN - END diff --git a/src/tao/README.TAO b/src/tao/README.TAO index 5406d7c..13c184c 100644 --- a/src/tao/README.TAO +++ b/src/tao/README.TAO @@ -3,28 +3,39 @@ ************************************************** Requirements: -Before you can run the 'sdtao' or 'tao' CUTEst scripts, you must have: -1. TAO 1.10 installed on your system (see http://www.mcs.anl.gov/tao), - which also requires +Before you can run the 'runcutest' CUTEst scripts, you must have: -2. PETSc 3.1 (http://www.mcs.anl.gov/petsc) - -3. and an implementation of MPI (if you don't have any MPI installed, +1. An implementation of MPI (if you don't have any MPI installed, then you can configure PETSc using --download-mpich=1 option) +2. PETSc 3 (see https://petsc.org/release/install/install_tutorial/) Installing for CUTEst: -1. Install CUTEst, TAO, PETSc, and MPI according to package directions. +1. Install CUTEst, MPI and PETSc according to package directions. + +2. Set environment variables PETSC_DIR, and PETSC_ARCH (See PETSc +documentation for details) + +3. The TAO interface tools require two input files: + + probname.SIF specifies the problem in SIF format + TAO.SPC sets values for TAO run-time parameters -2. Set environment variables TAO_DIR, PETSC_DIR, and PETSC_ARCH (See -PETSc and TAO documentation for details) +If no TAO.SPC file is present in the current directory, the default +version is copied from the $CUTEST/src/tao directory. +This default file is as follows: -[old: 3. CUTEst only builds tao scripts if TAO_DIR environment variable is -set, so you may need to update/reinstall CUTEst] + tron optimization method employed + -1.0 stop if ||g(x)|| <= gatol + -1.0 stop if ||g(x)|| / |f(x)| <= grtol + -1.0 stop if ||g(x)|| / ||g(x_0)|| <= gttol + -1.0 the initial trust-region radius + -1 the maximum number of function evaluations + -1 the maximum number of iterations -4. To run with CUTEst, use the runcutest command with the -p tao option. +To run with CUTEst, use the runcutest command with the -p tao option. See the man page for runcutest for more details of other options. For documentation on TAO, see the TAO website diff --git a/src/tao/TAO.SPC b/src/tao/TAO.SPC new file mode 100644 index 0000000..01a65b1 --- /dev/null +++ b/src/tao/TAO.SPC @@ -0,0 +1,9 @@ + tron optimization method employed + -1.0 stop if ||g(x)|| <= gatol + -1.0 stop if ||g(x)|| / |f(x)| <= grtol + -1.0 stop if ||g(x)|| / ||g(x_0)|| <= gttol + -1.0 the initial trust-region radius + -1.0 the regularization weight for least-squares problems + -1 the maximum number of function evaluations + -1 the maximum number of iterations + 0 print compomnents 1:sol and n-sol+1:n of the solution diff --git a/src/tao/makemaster b/src/tao/makemaster index 76b120e..f85a4be 100644 --- a/src/tao/makemaster +++ b/src/tao/makemaster @@ -1,144 +1,39 @@ # Main body of the installation makefile for CUTEst TAO interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 21 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-06 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = TAO -package = tao - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +include $(CUTEST)/src/makedefs/defaults -# Archive manipulation strings +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# package name -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests +PACKAGE = TAO +package = tao -run_test: - echo " No $(PACKAGE) test program at the moment" +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -run_test_todo: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +EXTRAINCLUDES = -I $(PETSC_DIR)/include -I $(PETSC_DIR)/$(PETSC_ARCH)/include -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# include standard CUTEst makefile definitions -# individual compilations +include $(CUTEST)/src/makedefs/definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +# include compilation and run instructions -# CUTEst interface main programs +include $(CUTEST)/src/makedefs/instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.F - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.F > \ - $(OBJ)/$(package)_main.F - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.F \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.F ) - $(RM) $(OBJ)/$(package)_main.F - @printf '[ OK ]\n' +# select specific run test -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/tao/tao_main.F b/src/tao/tao_main.F index 06ec982..4157160 100644 --- a/src/tao/tao_main.F +++ b/src/tao/tao_main.F @@ -1,702 +1,261 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-06 AT 14:20 GMT. + c Driver program for solving a .SIF example problem with TAO c (after sifdecode has been used on the .SIF file) - program tao_main - implicit none - -#include "finclude/petscsys.h" -#include "finclude/petscvec.h" -#include "finclude/petscmat.h" -#include "finclude/tao_solver.h" - -c *** for statistical information - integer n,nfev,ngrad,nhes - double precision f_val, g_val - common /stats/ n,nfev,ngrad,nhes - common /fstats/ f_val, g_val - SAVE / fstats / - - double precision h_array(1800000) - integer rowindex(1800000), colindex(1800000) - common /hessian/ h_array, rowindex, colindex - - CHARACTER ( LEN = 30 ) :: rfilename = 'TAORES.d' - INTEGER :: rfiledevice = 47 - INTEGER :: io_buffer = 11 - - TAO_SOLVER tao - TAO_APPLICATION myapp - Vec x,xl,xu,g - Mat H - integer infile, outfile - PetscTruth flg - PetscScalar x_array(1), xl_array(1) - PetscScalar xu_array(1),g_array(1) - PetscFortranAddr x_index, xl_index - PetscFortranAddr xu_index, g_index - PetscLogDouble t1,tlimit - PetscReal maxtime - - integer nfree, nbind, iter - double precision f,gnorm,ff,cnorm,xdiff - real calls(4) - real time(4) - - integer i,info,nnzh,reason,na - integer its(100000) - double precision hist(100000) - - double precision gatol,grtol - double precision fatol,frtol,catol,crtol - external FormFunctionGradient, FormHessian, getstats - external FormFunction, FormGradient - external MyTimeMonitor - - LOGICAL :: filexx, is_specfile - INTEGER :: iores - INTEGER :: errout = 6 - CHARACTER ( len = 10 ) :: pname - CHARACTER ( len = 10 ), ALLOCATABLE, DIMENSION( : ) :: xnames - -! If required, open a file for the results - - INQUIRE( FILE = rfilename, EXIST = filexx ) - IF ( filexx ) THEN - OPEN( rfiledevice, FILE = rfilename, FORM = 'FORMATTED', & - & STATUS = 'OLD', POSITION = 'APPEND', IOSTAT = iores ) - ELSE - OPEN( rfiledevice, FILE = rfilename, FORM = 'FORMATTED', & - & STATUS = 'NEW', IOSTAT = iores ) - END IF - IF ( iores /= 0 ) THEN - write( errout, "( ' result file opening error. stopping ' )" ) - STOP - END IF - -c *** absolute and relative gradient tolerances - - call PetscInitialize(PETSC_NULL_CHARACTER,info) - call TaoInitialize(PETSC_NULL_CHARACTER,info) - - f_val = HUGE( 1.0d+0 ) - g_val = HUGE( 1.0d+0 ) - gatol = 1.0d-3 - grtol = 0 - infile = 1 - outfile = 6 -c *** outfile = 6 -> standard output - open (infile,file='OUTSDIF.d',status='old') - - -c *** Get the dimension size - call CUTEST_udimen(info,infile,n) - IF ( info /= 0 ) GO TO 910 - allocate( xnames( n ), STAT =iores ) - - IF ( iores /= 0 ) THEN - write( errout, "( ' allocation error. stopping ' )" ) - STOP - END IF - -c *** create the vectors - call VecCreateSeq(PETSC_COMM_SELF,n,x,info) - call VecDuplicate(x,xl,info) - call VecDuplicate(x,xu,info) - call VecDuplicate(x,g,info) - -c *** Generate the initial point and project into [xl,xu] - -c *** When getting a petsc vector array using fortran, the VecGetArray -c function returns a double precision address x_array and an offset -c where the data begins (x_index). So to get the nth data element -c of x, use x_array(x_index+n) (using 1-based arrays) - - call VecGetArray(x,x_array,x_index,info) - call VecGetArray(xl,xl_array,xl_index,info) - call VecGetArray(xu,xu_array,xu_index,info) - call VecGetArray(g,g_array,g_index,info) - - call CUTEST_usetup(info,infile, outfile, io_buffern, & - & x_array(x_index+1), xl_array(xl_index+1), & - & xu_array(xu_index+1) ) - IF ( info /= 0 ) GO TO 910 - - do i=1,n - if (xl_array(xl_index+i) .gt. xu_array(xu_index+i)) then - print *,'Bad vector bounds' - stop - elseif (x_array(x_index+i) .lt. xl_array(xl_index+i)) then - x_array(x_index+i) = xl_array(xl_index+i) - elseif (x_array(x_index+i) .gt. xu_array(xu_index+i)) then - x_array(x_index+i) = xu_array(x_index+i) - endif - enddo - - CALL CUTEST_unames( info, n, pname, xnames ) - IF ( info /= 0 ) GO TO 910 - WRITE( rfiledevice, "( A10, I6 )", advance = 'no' ) pname, n - -c *** Count the free and binding variables, gradient projection norm - call uofg(n,x_array(x_index+1), f, g_array(g_index+1),.true.) +#include "cutest_modules.h" +#include "cutest_routines.h" - call getstats(n,x_array(x_index+1),xl_array(xl_index+1), & - & xu_array(xu_index+1),g_array(g_index+1),nfree,nbind, & - & gnorm) - - - call VecRestoreArray(x,x_array,x_index,info) - call VecRestoreArray(xl,xl_array,xl_index,info) - call VecRestoreArray(xu,xu_array,xu_index,info) - call VecRestoreArray(g,g_array,g_index,info) - -c *** Get the number of nonzeros and create the hessian - call CUTEST_udimsh(info, nnzh) - IF ( info /= 0 ) GO TO 910 - call MatCreateSeqAIJ(PETSC_COMM_SELF,n,n,2*nnzh/n, & - & PETSC_NULL_INTEGER,H,info) - call MatSetOption(H,MAT_SYMMETRIC,.true.,info) - -! na = 100000 -! call TaoSetConvergenceHistory(tao,hist,its,na,.FALSE.,info) - - write (outfile,1000) n, nfree, n-nfree, nbind - - - call TaoCreate(PETSC_COMM_SELF,'tao_lmvm',tao,info) - call TaoApplicationCreate(PETSC_COMM_SELF,myapp,info) - - call TaoSetTolerances(tao,0.0d0, 0.0d0, 0.0d0, 0.0d0, info) - call TaoSetGradientTolerances(tao,gatol, grtol, 0.0d0, info) - call TaoSetMaximumFunctionEvaluations(tao,200000,info) - call TaoSetMaximumIterates(tao,100000,info) - - call TaoAppSetObjectiveRoutine(myapp, & - & FormFunction,PETSC_NULL_OBJECT,info) - call TaoAppSetGradientRoutine(myapp, & - & FormGradient,PETSC_NULL_OBJECT,info) - call TaoAppSetObjectiveAndGradientRo(myapp, & - & FormFunctionGradient,PETSC_NULL_OBJECT,info) - -* Check for time limit - call PetscOptionsGetReal(PETSC_NULL_CHARACTER,"-time_limit", & - & maxtime, flg, info) - if (flg) then - call PetscGetTime(t1,info) - tlimit = t1 + maxtime - call TaoAppSetMonitor(myapp,MyTimeMonitor,tlimit,info) - endif - - call TaoAppSetHessianMat(myapp,H,H,info) - call TaoAppSetHessianRoutine(myapp,FormHessian,nnzh, & - & info) - - - call TaoAppSetVariableBounds(myapp,xl,xu,info) - call TaoAppSetInitialSolutionVec(myapp,x,info) - - - nfev = 0 - ngrad = 0 - nhes = 0 -* call TaoSetApplication(tao,myapp,info) - call TaoSetOptions(myapp,tao,info) - call TaoSolveApplication(myapp,tao,info) - -c *** Count the free and binding variables again - -c *** When getting a petsc vector array using fortran, the VecGetArray -c function returns a double precision address x_array and an offset -c where the data begins (x_index). So to get the nth data element -c of x, use x_array(x_index+n) (using 1-based arrays) - - call VecGetArray(x,x_array,x_index,info) - call VecGetArray(xl,xl_array,xl_index,info) - call VecGetArray(xu,xu_array,xu_index,info) - call VecGetArray(g,g_array,g_index,info) - - call CUTEST_uofg(info,n,x_array(x_index+1), f, & - & g_array(g_index+1), .true.) - IF ( info /= 0 ) GO TO 910 - call getstats(n,x_array(x_index+1),xl_array(xl_index+1), & - & xu_array(xu_index+1),g_array(g_index+1),nfree,nbind, & - & gnorm) - - call VecRestoreArray(x,x_array,x_index,info) - call VecRestoreArray(xl,xl_array,xl_index,info) - call VecRestoreArray(xu,xu_array,xu_index,info) - call VecRestoreArray(g,g_array,g_index,info) - - - write (outfile,2000) nfree, n-nfree, nbind, nfev, f, gnorm - -! write(6,*) nfev,ngrad,nhes - - call CUTEST_ureport(info,calls,time) - IF ( info /= 0 ) GO TO 910 - write (outfile,3000) time(1), time(2) - call TaoView(tao,info) - - - if (gnorm .le. gatol .or. gnorm .le. grtol*abs(f)) then - write (outfile,4000) - else - write (outfile,5000) gnorm, gatol - endif - -! Get information on termination - call TaoGetSolutionStatus(tao,iter,ff,gnorm,cnorm,xdiff, & - & reason,info) - if (reason .lt. 0) then - print *,'TAO did not terminate successfully' - endif - -! call TaoGetConvergenceHistory(tao, hist, its, na, info) -! write(6,*) 'na',na -! write(6,*) hist(1:na) -! write(6,*) its(1:na) -! call TaoGetTolerances(tao,fatol,frtol,catol,crtol,info) -! write(6,*) fatol,frtol,catol,crtol - -! write(6,*) calls(1), calls(2), calls(3), calls(4) - -! BACKSPACE( rfiledevice ) - IF ( reason >= 0 ) THEN - WRITE( rfiledevice, 2050 ) ff, gnorm, & - & INT( calls(2) ), & - & INT( calls(3) ), INT( calls(4) ), time(2), reason - ELSE - WRITE( rfiledevice, 2050 ) ff, gnorm, & - & - INT( calls(2) ), & - & - INT( calls(3) ), - INT( calls(4) ), - time(2), reason - END IF - CLOSE( rfiledevice ) - - call VecDestroy(x,info) - call VecDestroy(g,info) - call VecDestroy(xl,info) - call VecDestroy(xu,info) - call MatDestroy(H,info) - - call TaoDestroy(tao,info) - call TaoAppDestroy(myapp,info) - - close(outfile) - close(infile) - - call TaoFinalize(info) - call PetscFinalize(info) - - call CUTEST_uterminate( info ) - return + program tao_main - 910 continue - write( errout, "( ' cutest error, status = ', i0, ', stopping' )") - + info - return - - - 1000 format ( - + ' Number of variables ',i12,/, - + ' Number of free variables at x(start) ',i12,/, - + ' Number of active variables at x(start) ',i12,/, - + ' Number of binding variables at x(start) ',i12,/) - 2000 format ( - + ' Number of free variables at x(final) ',i12,/, - + ' Number of active variables at x(final) ',i12,/, - + ' Number of binding variables at x(final) ',i12,/, - + ' Number of function evaluations ',i12,/, - + ' Function value at final iterate ' ,d20.6,/, - + ' Projected gradient at final iterate ' ,d20.6,/) - - 2050 FORMAT( ES16.8, ES9.1, bn, 2I7, I9, ' :', F9.2, I5 ) - - 3000 format ('CPU time (s) for USETUP ',f10.3,/, - + 'CPU time (s) since USETUP',f10.3,/) - - 4000 format (' Exit message CONVERGENCE: GTOL TEST SATISFIED',//) - 5000 format (' Exit message GRADIENT NORM ',f9.6,' > GTOL ',f9.6//) - - - end - - -c ***************************************************** -c *** FormHessian -c *** Calculates the hessian matrix at the -c *** given vector. -c *** -c *** This function is called from withing the tao solver -c *** -c *** IN: tao - pointer to tao solver structure (used in C) -c *** X - the pointer to the PETSc vector -c *** -c *** OUT: H - PETSc matrix holding hessian matrix -c *** Hpre - not used (for preconditioning) -c *** flag - not used -c *** nnzh - max number of nonzeros in the hessian -c *** info - 0 if everything is ok -c ***************************************************** - - subroutine FormHessian(taoapp, X, H, Hpre, flag, nnzh, info) +! ---------------------------------------------------------------------- +! +#include "petsc/finclude/petsctao.h" + use petsctao implicit none -#include "finclude/petscsys.h" -#include "finclude/petscvec.h" -#include "finclude/petscmat.h" -#include "finclude/tao_solver.h" +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! Variable declarations +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! +! See additional variable declarations in the file rosenbrock1f.h + PetscErrorCode ierr ! used to check for functions returning nonzeros + type(tVec) x ! solution vector + type(tMat) H ! hessian matrix + type(tTao) tao ! TAO_SOVER context + PetscBool flg + PetscInt i2,i1 + PetscMPIInt size + PetscReal zero + PetscReal alpha + PetscInt n + common /params/ alpha, n - TAO_APPLICATION taoapp - Vec X - Mat H,Hpre - MatStructure flag - integer nnzh, info - +! Note: Any user-defined Fortran routines (such as FormGradient) +! MUST be declared as external. - double precision h_array(1800000) - integer colindex(1800000),rowindex(1800000) - common /hessian/ h_array, colindex, rowindex + external FormFunctionGradient, FormHessian - integer n,nfev,ngrad,nhes - common /stats/ n,nfev,ngrad,nhes + zero = 0.0d0 + i2 = 2 + i1 = 1 - external ush +! Initialize TAO and PETSc - PetscScalar x_array(1) - PetscScalar z - PetscFortranAddr x_index - integer i + CALL PetscInitialize(ierr) + CALL MPI_Comm_size(PETSC_COMM_WORLD,size,ierr) - - info = 0 - z = 0.0 +! Check not available in fortran +! CALL PetscCheck(size .eq. 1,PETSC_COMM_SELF, PETSC_ERR_WRONG_MPI_SIZE, & +! 'This is a uniprocessor example only') - nhes = nhes + 1 +! Initialize problem parameters + n = 2 + alpha = 99.0d0 -c *** When getting a petsc vector array using fortran, the VecGetArray -c function returns a double precision address x_array and an offset -c where the data begins (x_index). So to get the nth data element -c of x, use x_array(x_index+n) (using 1-based arrays) +! Check for command line arguments to override defaults + Call PetscOptionsGetInt(PETSC_NULL_OPTIONS, & + PETSC_NULL_CHARACTER,'-n',n,flg,ierr) + Call PetscOptionsGetReal(PETSC_NULL_OPTIONS, & + PETSC_NULL_CHARACTER,'-alpha',alpha,flg,ierr) - call VecGetArray(X,x_array,x_index,info) +! Allocate vectors for the solution and gradient + Call VecCreateSeq(PETSC_COMM_SELF,n,x,ierr) -c *** Get sparse hessian at x - call CUTEST_ush(info,n,x_array(x_index+1),nnzh,nnzh,h_array, & - & rowindex,colindex) - IF ( info /= 0 ) RETURN - call VecRestoreArray(X,x_array,x_index,info) +! Allocate storage space for Hessian; + Call MatCreateSeqBAIJ(PETSC_COMM_SELF,i2,n,n,i1, & + PETSC_NULL_INTEGER, H,ierr) -c *** Convert the sparse hessian to the petsc matrix - call MatZeroEntries(H,info) + Call MatSetOption(H,MAT_SYMMETRIC,PETSC_TRUE,ierr) -C *** Insert diagonal values into the sparse Hessian matrix - - do i=1,n - call MatSetValue(H,i-1,i-1,z,INSERT_VALUES, info) - enddo - - do i=1,nnzh - call MatSetValue(H,rowindex(i)-1,colindex(i)-1,h_array(i), & - & INSERT_VALUES, info) - - if (rowindex(i) .ne. colindex(i)) then - call MatSetValue(H,colindex(i)-1,rowindex(i)-1,h_array(i), & - & INSERT_VALUES, info) - endif - enddo +! The TAO code begins here - call MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY,info) - call MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY,info) +! Create TAO solver + Call TaoCreate(PETSC_COMM_SELF,tao,ierr) + Call TaoSetType(tao,TAOLMVM,ierr) - return - end - -c ***************************************************** -c *** FormFunction -c *** Calculates the function at the -c *** given vector. -c *** -c *** This function is called from withing the tao solver -c *** -c *** IN: tao - pointer to tao solver structure (used in C) -c *** X - the pointer to the PETSc vector -c *** dummy - not used -c *** -c *** OUT: f - value of the function at X -c *** info - 0 if everything is ok -c ***************************************************** - - subroutine FormFunction(taoapp,X,f,dummy,info) - implicit none +! Set routines for function, gradient, and hessian evaluation + Call TaoSetObjectiveAndGradient(tao,PETSC_NULL_VEC, & + FormFunctionGradient,0,ierr) + Call TaoSetHessian(tao,H,H,FormHessian,0,ierr) -#include "finclude/petscsys.h" -#include "finclude/petscvec.h" -#include "finclude/petscmat.h" -#include "finclude/tao_solver.h" +! Optional: Set initial guess + Call VecSet(x, zero, ierr) + Call TaoSetSolution(tao, x, ierr) +! Check for TAO command line options + Call TaoSetFromOptions(tao,ierr) - TAO_APPLICATION taoapp - Vec X - double precision f - integer dummy, info - +! SOLVE THE APPLICATION + Call TaoSolve(tao,ierr) - integer n,nfev,ngrad,nhes - double precision f_val, g_val - common /stats/ n,nfev,ngrad,nhes - common /fstats/ f_val, g_val +! TaoView() prints ierr about the TAO solver; the option +! -tao_view +! can alternatively be used to activate this at runtime. +! Call TaoView(tao,PETSC_VIEWER_STDOUT_SELF,ierr) - external ufn +! Free TAO data structures + Call TaoDestroy(tao,ierr) - PetscScalar x_array(1) - PetscFortranAddr x_index +! Free PETSc data structures + Call VecDestroy(x,ierr) + Call MatDestroy(H,ierr) - info = 0 - nfev = nfev + 1 + Call PetscFinalize(ierr) -c *** When getting a petsc vector array using fortran, the VecGetArray -c function returns a double precision address x_array and an offset -c where the data begins (x_index). So to get the nth data element -c of x, use x_array(x_index+n) (using 1-based arrays) + end program tao_main - call VecGetArray(X,x_array,x_index,info) - call CUTEST_ufn(info,n,x_array(x_index+1),f) - IF ( info /= 0 ) RETURN - f_val = f - call VecRestoreArray(X,x_array,x_index,info) +! -------------------------------------------------------------------- +! FormFunctionGradient - Evaluates the function f(X) and gradient G(X) +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! dummy - not used +! +! Output Parameters: +! G - vector containing the newly evaluated gradient +! f - function value - return - end - - -c ***************************************************** -c *** FormGradient -c *** Calculates the gradient at the -c *** given vector. -c *** -c *** This function is called from withing the tao solver -c *** -c *** IN: tao - pointer to tao solver structure (used in C) -c *** X - the pointer to the PETSc vector -c *** dummy - not used -c *** -c *** OUT: G - PETSc vector holding value of gradient at X -c *** info - 0 if everything is ok -c ***************************************************** - - subroutine FormGradient(taoapp,X,G,dummy,info) + subroutine FormFunctionGradient(tao, X, f, G, dummy, ierr) +#include "petsc/finclude/petsctao.h" + use petsctao implicit none -#include "finclude/petscsys.h" -#include "finclude/petscvec.h" -#include "finclude/petscmat.h" -#include "finclude/tao_solver.h" - - - TAO_APPLICATION taoapp - Vec X,G - integer dummy, info - integer i - - integer n,nfev,ngrad,nhes - double precision f_val, g_val - common /stats/ n,nfev,ngrad,nhes - common /fstats/ f_val, g_val - - - external ugr - - PetscScalar x_array(1),g_array(1) - PetscFortranAddr x_index,g_index - - - info = 0 - ngrad = ngrad + 1 - -c *** When getting a petsc vector array using fortran, the VecGetArray -c function returns a double precision address x_array and an offset -c where the data begins (x_index). So to get the nth data element -c of x, use x_array(x_index+n) (using 1-based arrays) - - call VecGetArray(X,x_array,x_index,info) - call VecGetArray(G,g_array,g_index,info) - - call ugr(info,n,x_array(x_index+1),g_array(g_index+1)) - - - g_val = 0.0d0 - do i = 1, n - g_val = g_val + g_array(g_index+i)**2 - end do - g_val = sqrt(g_val) + type(tTao) tao + type(tVec) X,G + PetscReal f + PetscErrorCode ierr + PetscInt dummy + + PetscReal ff,t1,t2 + PetscInt i,nn + PetscReal, pointer :: g_v(:),x_v(:) + PetscReal alpha + PetscInt n + common /params/ alpha, n + + ierr = 0 + nn = n/2 + ff = 0 + +! Get pointers to vector data + Call VecGetArrayReadF90(X,x_v,ierr) + Call VecGetArrayF90(G,g_v,ierr) + +! Compute G(X) + do i=0,nn-1 + t1 = x_v(1+2*i+1) - x_v(1+2*i)*x_v(1+2*i) + t2 = 1.0 - x_v(1 + 2*i) + ff = ff + alpha*t1*t1 + t2*t2 + g_v(1 + 2*i) = -4*alpha*t1*x_v(1 + 2*i) - 2.0*t2 + g_v(1 + 2*i + 1) = 2.0*alpha*t1 + enddo +! Restore vectors + Call VecRestoreArrayReadF90(X,x_v,ierr) + Call VecRestoreArrayF90(G,g_v,ierr) - call VecRestoreArray(X,x_array,x_index,info) - call VecRestoreArray(G,g_array,g_index,info) + f = ff + Call PetscLogFlops(15.0d0*nn,ierr) return - end - - -c ***************************************************** -c *** FormFunctionGradient -c *** Calculates the function and gradient at the -c *** given vector. -c *** -c *** This function is called from withing the tao solver -c *** -c *** IN: tao - pointer to tao solver structure (used in C) -c *** X - the pointer to the PETSc vector -c *** dummy - not used -c *** -c *** OUT: f - value of the function at X -c *** G - PETSc vector holding value of gradient at X -c *** info - 0 if everything is ok -c ***************************************************** - - subroutine FormFunctionGradient(taoapp,X,f,G,dummy,info) + end subroutine FormFunctionGradient + +! +! --------------------------------------------------------------------- +! +! FormHessian - Evaluates Hessian matrix. +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! dummy - optional user-defined context, as set by SNESSetHessian() +! (not used here) +! +! Output Parameters: +! H - Hessian matrix +! PrecH - optionally different preconditioning matrix (not used here) +! flag - flag indicating matrix structure +! ierr - error code +! +! Note: Providing the Hessian may not be necessary. Only some solvers +! require this matrix. + + subroutine FormHessian(tao,X,H,PrecH,dummy,ierr) +#include "petsc/finclude/petsctao.h" + use petsctao implicit none -#include "finclude/petscsys.h" -#include "finclude/petscvec.h" -#include "finclude/petscmat.h" -#include "finclude/tao_solver.h" - - - TAO_APPLICATION taoapp - Vec X,G - double precision f - integer dummy, info - integer i - - - integer n,nfev,ngrad,nhes - double precision f_val, g_val - common /stats/ n,nfev,ngrad,nhes - common /fstats/ f_val, g_val - - - external uofg - - PetscScalar x_array(1),g_array(1) - PetscFortranAddr x_index,g_index - - - info = 0 - nfev = nfev + 1 - ngrad = ngrad + 1 - -c *** When getting a petsc vector array using fortran, the VecGetArray -c function returns a double precision address x_array and an offset -c where the data begins (x_index). So to get the nth data element -c of x, use x_array(x_index+n) (using 1-based arrays) - - call VecGetArray(X,x_array,x_index,info) - call VecGetArray(G,g_array,g_index,info) - - call CUTEST_uofg(info,n,x_array(x_index+1), f, & - & g_array(g_index+1),.true.) - IF ( info /= 0 ) RETURN - f_val = f - g_val = 0.0d0 - do i = 1, n - g_val = g_val + g_array(g_index+i)**2 - end do - g_val = sqrt(g_val) - - call VecRestoreArray(X,x_array,x_index,info) - call VecRestoreArray(G,g_array,g_index,info) +! Input/output variables: + type(tTao) tao + type(tVec) X + type(tMat) H, PrecH + PetscErrorCode ierr + PetscInt dummy + + PetscReal v(0:1,0:1) + PetscBool assembled + +! PETSc's VecGetArray acts differently in Fortran than it does in C. +! Calling VecGetArray((Vec) X, (PetscReal) x_array(0:1), (PetscOffset) x_index, ierr) +! will return an array of doubles referenced by x_array offset by x_index. +! i.e., to reference the kth element of X, use x_array(k + x_index). +! Notice that by declaring the arrays with range (0:1), we are using the C 0-indexing practice. + PetscReal, pointer :: x_v(:) + PetscInt i,nn,ind(0:1),i2 + PetscReal alpha + PetscInt n + common /params/ alpha, n + + ierr = 0 + nn= n/2 + i2 = 2 + +! Zero existing matrix entries + Call MatAssembled(H,assembled,ierr) + if (assembled .eqv. PETSC_TRUE) Call MatZeroEntries(H,ierr) + +! Get a pointer to vector data + + Call VecGetArrayReadF90(X,x_v,ierr) + +! Compute Hessian entries + + do i=0,nn-1 + v(1,1) = 2.0*alpha + v(0,0) = -4.0*alpha*(x_v(1+2*i+1) - 3*x_v(1+2*i)*x_v(1+2*i))+2 + v(1,0) = -4.0*alpha*x_v(1+2*i) + v(0,1) = v(1,0) + ind(0) = 2*i + ind(1) = 2*i + 1 + Call MatSetValues(H,i2,ind,i2,ind,v,INSERT_VALUES,ierr) + enddo - return - end - - -c ***************************************************** -c *** getstats : -c *** calculates the number of free and binding -c *** variables at the given vector -c *** IN: n - number of elements in vector -c *** x - array of vector elements -c *** xl - array of lower bounds -c *** xu - array of upper bounds -c *** g - gradient array -c *** OUT: nfree - number of free variables at x -c *** nbind - number of binding variables at x -c *** gnorm - norm of the gradient vector at x -c ***************************************************** - subroutine getstats(n,x,xl,xu,g,nfree,nbind,gnorm) - implicit none +! Restore vector - integer n,nfree,nbind - double precision x(n), xl(n), xu(n), g(n) - double precision gnorm + Call VecRestoreArrayReadF90(X,x_v,ierr) - integer i +! Assemble matrix - nfree=0 - nbind =0 + Call MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY,ierr) + Call MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY,ierr) -c *** count the free and binding variables - do i=1,n - if (xl(i) .lt. x(i) .and. x(i) .lt. xu(i)) then - nfree = nfree + 1 - elseif ((x(i).eq.xl(i) .and. g(i) .ge. 0) .or. & - & (x(i) .eq. xu(i) .and. g(i) .le. 0) .or. & - & xl(i) .eq. xu(i)) then - nbind = nbind + 1 - endif - enddo + CALL PetscLogFlops(9.0d0*nn,ierr) - -c *** calculate the gradient projection norm - gnorm = 0.0d0 - do i = 1, n - if (xl(i) .ne. xu(i)) then - if (x(i) .eq. xl(i)) then - gnorm = gnorm + min(g(i),0.0d0)**2 - else if (x(i) .eq. xu(i)) then - gnorm = gnorm + max(g(i),0.0d0)**2 - else - gnorm = gnorm + g(i)**2 - end if - end if - end do - gnorm = sqrt(gnorm) - - return - end - - subroutine MyTimeMonitor(tao, tlimit) -#include "finclude/petscsys.h" -#include "finclude/tao_solver.h" -C#include "finclude/petsctime.h" - TAO_SOLVER tao - PetscLogDouble tlimit, now - integer info - INTEGER :: rfiledevice = 47 - - integer iter, reason - double precision f,gnorm,ff,cnorm,xdiff - real calls(4) - real time(2) - - double precision f_val, g_val - common /fstats/ f_val, g_val - - call PetscGetTime(now,info) - if (now .gt. tlimit) then - call CUTEST_ureport(info,calls,time) - WRITE( rfiledevice, - & "( ES16.8, ES9.1, bn, 2I7, I9, ' :', F9.2, I5 )" ) & - & f_val, g_val, - INT( calls(2) ), & - & - INT( calls(3) ), - INT( calls(4) ), - time(2), -8 - - CLOSE( rfiledevice ) - SETERRQ(1,"Time limit reached",info) -! call TaoSetTerminationReason(tao,-8,info) - endif return - - end subroutine MyTimeMonitor - + end subroutine FormHessian + +! +!/*TEST +! +! build: +! requires: !complex +! +! test: +! args: -tao_smonitor -tao_type ntr -tao_gatol 1.e-5 +! requires: !single +! +!TEST*/ diff --git a/src/tao/tao_main.F90 b/src/tao/tao_main.F90 new file mode 100644 index 0000000..26190ec --- /dev/null +++ b/src/tao/tao_main.F90 @@ -0,0 +1,863 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-11 AT 08:00 GMT. + +! Driver program for solving a .SIF example problem with TAO +! (after sifdecode has been used on the .SIF file) + +#include "cutest_modules.h" +#include "cutest_routines.h" + + MODULE CUTEST_TAO + USE CUTEST_KINDS_precision + TYPE, PUBLIC :: TAO_data_type + INTEGER ( KIND = ip_ ) :: n, m, nnzh, nnzj + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_row, H_col + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: J_row, J_col + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: H_val + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: J_val + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Y + END TYPE TAO_data_type + END MODULE CUTEST_TAO + +! -------------------------- M A I N P R O G R A M ------------------------ + + PROGRAM tao_main + +#include "petsc/finclude/petsctao.h" + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! Variable declarations +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + PetscErrorCode ierr ! used to check for functions returning nonzeros + TYPE ( tVec ) :: x ! solution vector + TYPE ( tVec ) :: r ! residual vector + TYPE ( tVec ) :: xl, xu ! vectors of bounds + TYPE ( tMat ) :: H ! Hessian matrix + TYPE ( tMat ) :: J ! Jacobian matrix + TYPE ( tTao ) :: tao ! TAO_SOVER context + TaoType :: tao_method ! solver used + PetscBool flg + PetscMPIInt comm_size + PetscReal, POINTER, DIMENSION( : ) :: x_array, xl_array, xu_array + PetscInt :: n, m, nnzh, nnzj + TYPE ( TAO_data_type ) :: tao_data + EXTERNAL FormFunction, FormGradient, FormFunctionGradient, FormHessian, & + FormResidual, FormJacobian + + INTEGER ( KIND = ip_ ) :: i, jj, l, status + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6, inspec = 46 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + CHARACTER ( LEN = 10 ) :: method = REPEAT( ' ', 10 ) + CHARACTER ( LEN = 10 ) :: pname + CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_ptr, J_ptr + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: Y, C_l, C_u + LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATION, LINEAR + + REAL ( KIND = rp_ ) :: CALLS( 4 ), TIME( 4 ) + PetscReal :: gatol, grtol, gttol, radius, weight + PetscInt :: max_evals, max_its, sol_comp + + LOGICAL :: least_squares, noobj + INTEGER :: iter, reason + REAL ( kind = rp_ ) f_min, g_norm, c_norm, x_diff + +! open the solver specification file to set parameters from a file + + OPEN( inspec, FILE = 'TAO.SPC', FORM = 'FORMATTED', STATUS = 'OLD' ) + +! read input specification data (*) + +! method <-- optimization method employed (**) +! gatol <-- stop if ||g(x)|| <= gatol +! grtol <-- stop if ||g(x)|| / |f(x)| <= grtol +! gttol <-- stop if ||g(x)|| / ||g(x_0)|| <= gttol +! radius <-- the initial trust-region radius +! weight <-- the regularization weight for least-squares problems +! max_evals <-- the maximum number of function evaluations +! max_its <-- the maximum number of iterations +! sol_comp <-- print compomnents 1:sol & n-sol+1:n of the solution (0=none) + +! (*) any negative value keeps default +! (**) may be one of: +! blmvm, bncg, bnls, bntl, bntr, bqnkls, bqnktl, bqnktr, +! bqnls, lmvm, nls, ntl, ntr or tron (brgn to come in future) +! +! see entry TAO"METHOD" on https://petsc.org/main/manualpages/Tao/ +! for details about "method" + + READ ( inspec, "( A10, /, 5( D10.3, / ), I10, /, I10, /, I10 )" ) & + method, gatol, grtol, gttol, radius, weight, & + max_evals, max_its, sol_comp + +! close input file + + CLOSE ( inspec ) + +! initialize TAO and PETSc + + CALL PetscInitialize( ierr ) + CALL MPI_Comm_size( PETSC_COMM_WORLD, comm_size, ierr ) + +! check not available in fortran +! CALL PetscCheck( comm_size == 1, PETSC_COMM_SELF, & +! PETSC_ERR_WRONG_MPI_SIZE, & +! 'This is a uniprocessor example only' ) + +! open the input data file + + OPEN ( input, FILE = 'OUTSDIF.d', FORM = 'FORMATTED', STATUS = 'OLD' ) + REWIND input + +! is a least-squares solver required? Get the dimension size + + SELECT CASE ( TRIM( ADJUSTL( method ) ) ) + CASE( "brgn" ) + least_squares = .TRUE. + CALL CUTEST_cdimen_r( status, input, n, m ) + IF ( status /= 0 ) GO TO 910 + IF ( m <= 0 ) THEN + WRITE( out, "( ' least squares solver invoked for problem with no', & + & ' residuals ... stopping' )" ) + STOP + END IF + tao_data%m = m + CALL CUTEST_cnoobj_r( status, input, noobj ) + IF ( status /= 0 ) GO TO 910 + IF ( .NOT. noobj ) THEN + WRITE( out, "( ' least squares solver invoked for problem', & + & ' with explicit objective ... stopping' )" ) + STOP + END IF + CASE DEFAULT + least_squares = .FALSE. + CALL CUTEST_udimen_r( status, input, n ) + IF ( status /= 0 ) GO TO 910 + END SELECT + tao_data%n = n + +! check for command line arguments to override defaults + + CALL PetscOptionsGetInt( PETSC_NULL_OPTIONS, & + PETSC_NULL_CHARACTER, '-n', n, flg, ierr ) + +! allocate vectors for the solution and its bounds + + CALL VecCreateSeq( PETSC_COMM_SELF, n, x, ierr ) + CALL VecDuplicate( x, xl, ierr ) + CALL VecDuplicate( x, xu, ierr ) + +! create fortran equivalents + + CALL VecGetArrayF90( x, x_array, ierr ) + CALL VecGetArrayF90( xl, xl_array, ierr ) + CALL VecGetArrayF90( xu, xu_array, ierr ) + +! compute the lower and upper bounds on variables and initial values + + IF ( least_squares ) THEN + ALLOCATE( Y( m ), C_l( m ), C_u( m ), EQUATION( m ), LINEAR( m ), & + STAT = status ) + IF ( status /= 0 ) GO TO 910 + CALL CUTEST_csetup( status, input, out, io_buffer, n, m, & + x_array, xl_array, xu_array, & + Y, C_l, C_u, EQUATION, LINEAR, 0, 0, 0 ) + DEALLOCATE( Y, C_l, C_u, EQUATION, LINEAR, STAT = status ) + IF ( status /= 0 ) GO TO 910 + ELSE + CALL CUTEST_usetup_r( status, input, out, io_buffer, & + n, x_array, xl_array, xu_array ) + END IF + IF ( status /= 0 ) GO TO 910 + + DO i = 1, n + IF ( xl_array( i ) > xu_array( i ) ) THEN + WRITE( out, "( ' Bad vector bounds' )" ) + stop + ELSE IF ( x_array( i ) < xl_array( i ) ) THEN + x_array( i ) = xl_array( i ) + ELSE IF ( x_array( i ) > xu_array( i ) ) THEN + x_array( i ) = xu_array( i ) + END IF + END DO + +! record the name of the problem and the variables + + CALL CUTEST_probname_r( status, pname ) + IF ( status /= 0 ) GO TO 910 + ALLOCATE( XNAMES( n ), STAT = status ) + IF ( status /= 0 ) GO TO 910 + CALL CUTEST_varnames_r( status, n, XNAMES ) + IF ( status /= 0 ) GO TO 910 + +! restore the petsc vectors + + CALL VecRestoreArray( x, x_array, ierr ) + +! compute the number of nonzeros in the residual Jacobian, and allocate +! storage space + + IF ( least_squares ) THEN + CALL CUTEST_cdimsj_r( status, nnzj ) + tao_data%nnzj = nnzj + ALLOCATE( tao_data%J_row( nnzj ), tao_data%J_col( nnzj ), & + tao_data%J_val( nnzj ), tao_data%Y( m ), & + J_ptr( m ), STAT = status ) + IF ( status /= 0 ) GO TO 910 + +! find the row and column indices (symmetric storage) + + CALL CUTEST_csgrp( status, n, nnzj, nnzj, & + tao_data%J_row, tao_data%J_col ) + IF ( status /= 0 ) GO TO 910 + +! compute the number of nonzeros in each row (unsymmetric storage) + + J_ptr( : m ) = 0 + DO l = 1, nnzh + i = tao_data%J_row( l ) + IF ( i > 0 ) J_ptr( i ) = J_ptr( i ) + 1 + END DO + +! create the petsc Jacobian + + CALL MatCreateSeqAIJ( PETSC_COMM_SELF, m, n, PETSC_DEFAULT_INTEGER, & + J_ptr, J, ierr ) + DEALLOCATE( J_ptr, STAT = status ) + +! compute the number of nonzeros in the objective Hessian, and allocate +! storage space + + ELSE + CALL CUTEST_udimsh_r( status, nnzh ) + tao_data%nnzh = nnzh + ALLOCATE( tao_data%H_row( nnzh ), tao_data%H_col( nnzh ), & + tao_data%H_val( nnzh ), H_ptr( n ), STAT = status ) + IF ( status /= 0 ) GO TO 910 + +! find the row and column indices (symmetric storage) + + CALL CUTEST_ushp( status, n, nnzh, l, tao_data%H_row, tao_data%H_col ) + IF ( status /= 0 ) GO TO 910 + +! compute the number of nonzeros in each row (unsymmetric storage) + + H_ptr( : n ) = 0 + DO l = 1, nnzh + i = tao_data%H_row( l ) ; jj = tao_data%H_col( l ) + H_ptr( i ) = H_ptr( i ) + 1 + IF ( i /= jj ) H_ptr( jj ) = H_ptr( jj ) + 1 + END DO + +! create the petsc Hessian + + CALL MatCreateSeqAIJ( PETSC_COMM_SELF, n, n, PETSC_DEFAULT_INTEGER, & + H_ptr, H, ierr ) + CALL MatSetOption( H, MAT_SYMMETRIC, PETSC_TRUE, ierr ) + DEALLOCATE( H_ptr, STAT = status ) + END IF + +! ------------------------ +! The TAO code begins here +! ------------------------ + +! Create TAO solver + + CALL TaoCreate( PETSC_COMM_SELF, tao, ierr ) + +! specify the optimization method to be employed + + SELECT CASE ( TRIM( ADJUSTL( method ) ) ) + CASE( "blmvm" ) + tao_method = TAOBLMVM + CASE( "bncg" ) + tao_method = TAOBNCG + CASE( "bnls" ) + tao_method = TAOBNLS + CASE( "bntl" ) + tao_method = TAOBNTL + CASE( "bntr" ) + tao_method = TAOBNTR + CASE( "bqnkls" ) + tao_method = TAOBQNKLS + CASE( "bqnktl" ) + tao_method = TAOBQNKTL + CASE( "bqnktr" ) + tao_method = TAOBQNKTR + CASE( "bqnls" ) + tao_method = TAOBQNLS + CASE( "lmvm" ) + tao_method = TAOLMVM + CASE( "nls" ) + tao_method = TAONLS + CASE( "ntl" ) + tao_method = TAONTL + CASE( "ntr" ) + tao_method = TAONTR + CASE( "tron" ) + tao_method = TAOTRON + CASE( "brgn" ) + tao_method = TAOBRGN + CASE DEFAULT + WRITE( out, "( ' Method ', A, ' not recognised, stopping' )" ) & + TRIM( ADJUSTL( method ) ) + STOP + END SELECT + + CALL TaoSetType( tao, tao_method, ierr ) + +! set algorithmic parameters + + IF ( gatol < 0.0 ) THEN + IF ( grtol < 0.0 ) THEN + IF ( gttol < 0.0 ) THEN + CALL TaoSetTolerances( tao, PETSC_DEFAULT_REAL, & + PETSC_DEFAULT_REAL, & + PETSC_DEFAULT_REAL, ierr ) + ELSE + CALL TaoSetTolerances( tao, PETSC_DEFAULT_REAL, & + PETSC_DEFAULT_REAL, & + gttol, ierr ) + END IF + ELSE + IF ( gttol < 0.0 ) THEN + CALL TaoSetTolerances( tao, PETSC_DEFAULT_REAL, & + grtol, & + PETSC_DEFAULT_REAL, ierr ) + ELSE + CALL TaoSetTolerances( tao, PETSC_DEFAULT_REAL, & + grtol, & + gttol, ierr ) + END IF + END IF + ELSE + IF ( grtol < 0.0 ) THEN + IF ( gttol < 0.0 ) THEN + CALL TaoSetTolerances( tao, gatol, & + PETSC_DEFAULT_REAL, & + PETSC_DEFAULT_REAL, ierr ) + ELSE + CALL TaoSetTolerances( tao, gatol, & + PETSC_DEFAULT_REAL, & + gttol, ierr ) + END IF + ELSE + IF ( gttol < 0.0 ) THEN + CALL TaoSetTolerances( tao, gatol, & + grtol, & + PETSC_DEFAULT_REAL, ierr ) + ELSE + CALL TaoSetTolerances( tao, gatol, & + grtol, & + gttol, ierr ) + END IF + END IF + END IF + + IF ( max_evals >= 0 ) & + CALL TaoSetMaximumFunctionEvaluations( tao, max_evals, ierr ) + IF ( max_its >= 0 ) & + CALL TaoSetMaximumIterations( tao, max_its, ierr ) + IF ( radius > 0.0_rp_ ) & + CALL TaoSetInitialTrustRegionRadius( tao, radius, ierr ) + IF ( least_squares .AND. weight < 0.0 ) & + CALL TaoBRGNSetRegularizerWeight( tao, weight, ierr ) + +! set routines for function, gradient, Hessian, residual and Jacobian +! evaluation as necessary + + IF ( least_squares ) THEN + CALL VecCreateSeq( PETSC_COMM_SELF, m, r, ierr ) + CALL TaoSetResidualRoutine( tao, r, FormResidual, tao_data, ierr ) + CALL TaoSetJacobianResidualRoutine( tao, J, J, & + FormJacobian, tao_data, ierr ) + ELSE + CALL TaoSetObjective( tao, FormFunction, tao_data, ierr ) + CALL TaoSetGradient( tao, PETSC_NULL_VEC, FormGradient, tao_data, ierr ) + CALL TaoSetObjectiveAndGradient( tao, PETSC_NULL_VEC, & + FormFunctionGradient, tao_data, ierr ) + CALL TaoSetHessian( tao, H, H, FormHessian, tao_data, ierr ) + END IF + +! set lower and upper bounds on the variables + + CALL TaoSetVariableBounds( tao, xl, xu, ierr ) + +! optional: Set initial guess + + CALL TaoSetSolution( tao, x, ierr ) + +! Check for TAO command line options + + CALL TaoSetFromOptions( tao, ierr ) + +! Solve the application + + CALL TaoSolve( tao, ierr ) + +! TaoView() prints ierr about the TAO solver; the option +! -tao_view +! can alternatively be used to activate this at runtime. +! CALL TaoView( tao, PETSC_VIEWER_STDOUT_SELF, ierr ) +! Get information on termination + + call TaoGetSolutionStatus( tao, iter, f_min, g_norm, c_norm, x_diff, & + reason, ierr ) + IF ( reason < 0 ) & + WRITE( out, "( 'TAO did not terminate successfully' )" ) + +! print segments of the solution if required + + IF ( sol_comp > 0 ) THEN + CALL TaoGetSolution( tao, x, ierr ) + CALL VecGetArrayF90( x, x_array, ierr ) + WRITE( out, "( /, 79( '*' ), // ' Solution:', //, ' i name ', & + & ' lower value upper ' )" ) + DO i = 1, MIN( n, sol_comp ) + WRITE( out, 2000 ) & + i, XNAMES( i ), xl_array( i ), x_array( i ), xu_array( i ) + END DO + IF ( 2 * sol_comp < n + 1 ) THEN + IF ( 2 * sol_comp < n ) & + WRITE( out, "( ' - - ', 3( 2X, 18( '-' ) ) )" ) + DO i = n - sol_comp + 1, n + WRITE( out, 2000 ) & + i, XNAMES( i ), xl_array( i ), x_array( i ), xu_array( i ) + END DO + END IF + END IF + +! record the evaluation statistics + + CALL CUTEST_ureport_r( status, CALLS, TIME ) + IF ( status /= 0 ) GO TO 910 + + WRITE ( out, "( /, 30( '*' ), ' CUTEst statistics ', 30('*'), //, & + & ' Package used : TAO (', A, ')', /, & + & ' Problem : ', A10, /, & + & ' # variables = ', I10, /, & + & ' # function evaluations = ', F8.2, /, & + & ' # gradient evaluations = ', F8.2, /, & + & ' # Hessian evaluations = ', F8.2, /, & + & ' # iterations = ', I10, /, & + & ' Package exit code = ', I10, /, & + & ' Final f = ', ES20.12, /, & + & ' Final ||g|| = ', ES20.12, /, & + & ' Set up time = ', 0P, F10.2, ' seconds', /, & + & ' Solve time = ', 0P, F10.2, ' seconds', //, & + & 79( '*' ), / )" ) TRIM( ADJUSTL( method ) ), pname, n, & + ( CALLS( i ), i = 1, 3 ), iter, reason, f_min, g_norm, & + TIME( 1 ), TIME( 2 ) + +! free TAO data structures + + CALL TaoDestroy( tao, ierr ) + +! free PETSc and CUTESt data structures + + CALL VecDestroy( x, ierr ) + CALL VecDestroy( xl, ierr ) + CALL VecDestroy( xu, ierr ) + + IF ( least_squares ) THEN + CALL VecDestroy( r, ierr ) + CALL MatDestroy( J, ierr ) + DEALLOCATE( tao_data%J_row, tao_data%J_col, & + tao_data%J_val, tao_data%Y, STAT = status ) + CALL CUTEST_cterminate_r( status ) + ELSE + CALL MatDestroy( H, ierr ) + DEALLOCATE( tao_data%H_row, tao_data%H_col, & + tao_data%H_val, STAT = status ) + CALL CUTEST_uterminate_r( status ) + END IF + + CALL PetscFinalize( ierr ) + + STOP + + 910 CONTINUE + WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) status + STOP + +! non-executable statement + + 2000 FORMAT( I8, 1X, A10, 3ES20.12 ) + + END PROGRAM tao_main + +! -------------------- E N D O F M A I N P R O G R A M ------------------ + + SUBROUTINE FormFunction( tao, X, f, tao_data, ierr ) + +! FormFunctionGradient - Evaluates the function f(X) +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! tao_data - private data +! +! Output Parameters: +! f - function value + +#include "petsc/finclude/petsctao.h" + + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! dummy arguments + + TYPE( tTao ) :: tao + TYPE( tVec ) :: X + PetscReal :: f + PetscErrorCode :: ierr + TYPE ( TAO_data_type ) :: tao_data + +! local variables + + PetscReal, POINTER, DIMENSION( : ) :: x_array + PetscInt :: n + + n = tao_data%n + +! get pointers to vector data + + CALL VecGetArrayReadF90( X, x_array, ierr ) + +! compute g(x) + + CALL CUTEST_ufn_r( ierr, n, x_array, f ) + +! restore vectors + + CALL VecRestoreArrayReadF90( X, x_array, ierr ) + +! CALL PetscLogFlops( 15.0d0*nn, ierr ) + + RETURN + END SUBROUTINE FormFunction + + SUBROUTINE FormGradient( tao, X, G, tao_data, ierr ) + +! FormFunctionGradient - Evaluates the gradient G(X) +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! tao_data - private data +! +! Output Parameters: +! G - vector containing the newly evaluated gradient + +#include "petsc/finclude/petsctao.h" + + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! dummy arguments + + TYPE( tTao ) :: tao + TYPE( tVec ) :: X, G + PetscErrorCode :: ierr + TYPE ( TAO_data_type ) :: tao_data + +! local variables + + PetscReal, POINTER, DIMENSION( : ) :: g_array, x_array + PetscInt :: n + + n = tao_data%n + +! get pointers to vector data + + CALL VecGetArrayReadF90( X, x_array, ierr ) + CALL VecGetArrayF90( G, g_array, ierr ) + +! compute g(x) + + CALL CUTEST_ugr_r( ierr, n, x_array, g_array ) + +! restore vectors + + CALL VecRestoreArrayReadF90( X, x_array, ierr ) + CALL VecRestoreArrayF90( G, g_array, ierr ) + +! CALL PetscLogFlops( 15.0d0*nn, ierr ) + + RETURN + END SUBROUTINE FormGradient + + SUBROUTINE FormFunctionGradient( tao, X, f, G, tao_data, ierr ) + +! FormFunctionGradient - Evaluates the function f(X) and gradient G(X) +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! tao_data - private data +! +! Output Parameters: +! f - function value +! G - vector containing the newly evaluated gradient + +#include "petsc/finclude/petsctao.h" + + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! dummy arguments + + TYPE( tTao ) :: tao + TYPE( tVec ) :: X, G + PetscReal :: f + PetscErrorCode :: ierr + TYPE ( TAO_data_type ) :: tao_data + +! local variables + + PetscReal, POINTER, DIMENSION( : ) :: g_array, x_array + PetscInt :: n + + n = tao_data%n + +! get pointers to vector data + + CALL VecGetArrayReadF90( X, x_array, ierr ) + CALL VecGetArrayF90( G, g_array, ierr ) + +! compute g(x) + + CALL CUTEST_uofg_r( ierr, n, x_array, f, g_array, .TRUE. ) + +! restore vectors + + CALL VecRestoreArrayReadF90( X, x_array, ierr ) + CALL VecRestoreArrayF90( G, g_array, ierr ) + +! CALL PetscLogFlops( 15.0d0*nn, ierr ) + + RETURN + END SUBROUTINE FormFunctionGradient + + SUBROUTINE FormHessian( tao, X, H, PrecH, tao_data, ierr ) + +! FormHessian - Evaluates Hessian matrix. +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! tao_data - private data +! +! Output Parameters: +! H - Hessian matrix +! PrecH - optionally different preconditioning matrix (not used here) +! flag - flag indicating matrix structure +! ierr - error code +! +! Note: Providing the Hessian may not be necessary. Only some solvers +! require this matrix. + +#include "petsc/finclude/petsctao.h" + + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! dummy arguments + + TYPE ( tTao ) :: tao + TYPE ( tVec ) :: X + TYPE ( tMat ) :: H, PrecH + PetscErrorCode ierr + TYPE ( TAO_data_type ) :: tao_data + +! local variables + + PetscReal, POINTER, DIMENSION( : ) :: x_array + PetscInt :: i, j, l, n, nnzh + PetscReal :: val + + n = tao_data%n ; nnzh = tao_data%nnzh + +! get a pointer to vector data + + CALL VecGetArrayReadF90( X, x_array, ierr ) + +! compute Hessian entries at x + + CALL CUTEST_ush_r( ierr, n, x_array, nnzh, nnzh, tao_data%H_val, & + tao_data%H_row, tao_data%H_col ) + IF ( ierr /= 0 ) RETURN + +! restore vector + + CALL VecRestoreArrayReadF90( X, x_array, ierr ) + +! insert the Hessian values into petsc storage + + DO l = 1, nnzh + i = tao_data%H_row( l ) - 1 ; j = tao_data%H_col( l ) - 1 + val = tao_data%H_val( l ) + CALL MatSetValue( H, i, j, val, INSERT_VALUES, ierr ) + IF ( i /= j ) CALL MatSetValue( H, j, i, val, INSERT_VALUES, ierr ) + END DO + +! assemble matrix + + CALL MatAssemblyBegin( H, MAT_FINAL_ASSEMBLY, ierr ) + CALL MatAssemblyEnd( H, MAT_FINAL_ASSEMBLY, ierr ) + +! CALL PetscLogFlops(9.0d0*nn,ierr) + + RETURN + END SUBROUTINE FormHessian + + SUBROUTINE FormResidual( tao, X, R, tao_data, ierr ) + +! FormFunctionGradient - Evaluates the gradient R(X) +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! tao_data - private data +! +! Output Parameters: +! R - vector containing the newly evaluated residual + +#include "petsc/finclude/petsctao.h" + + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! dummy arguments + + TYPE ( tTao ) :: tao + TYPE ( tVec ) :: X, R + PetscErrorCode :: ierr + TYPE ( TAO_data_type ) :: tao_data + +! local variables + + PetscReal :: f + PetscReal, POINTER, DIMENSION( : ) :: r_array, x_array + PetscInt :: n, m + + n = tao_data%n ; m = tao_data%m + +! get pointers to vector data + + CALL VecGetArrayReadF90( X, x_array, ierr ) + CALL VecGetArrayF90( R, r_array, ierr ) + +! compute r(x) + + CALL CUTEST_cfn_r( ierr, n, m, x_array, f, r_array ) + +! restore vectors + + CALL VecRestoreArrayReadF90( X, x_array, ierr ) + CALL VecRestoreArrayF90( R, r_array, ierr ) + +! CALL PetscLogFlops( 15.0d0*nn, ierr ) + + RETURN + END SUBROUTINE FormResidual + + SUBROUTINE FormJacobian( tao, X, J, PrecJ, tao_data, ierr ) + +! FormHessian - Evaluates Jacobian matrix. +! +! Input Parameters: +! tao - the Tao context +! X - input vector +! tao_data - private data +! +! Output Parameters: +! J - Jacobian matrix +! PrecJ - optionally different preconditioning matrix (not used here) +! flag - flag indicating matrix structure +! ierr - error code +! +! Note: Providing the Hessian may not be necessary. Only some solvers +! require this matrix. + +#include "petsc/finclude/petsctao.h" + + USE petsctao + USE CUTEST_KINDS_precision + USE CUTEST_TAO + IMPLICIT NONE + +! dummy arguments + + TYPE ( tTao ) :: tao + TYPE ( tVec ) :: X + TYPE ( tMat ) :: J, PrecJ + PetscErrorCode ierr + TYPE ( TAO_data_type ) :: tao_data + +! local variables + + PetscReal, POINTER, DIMENSION( : ) :: x_array + PetscInt :: i, l, m, n, nnzj + + n = tao_data%n ; m = tao_data%m ; nnzj = tao_data%nnzj + +! get a pointer to vector data + + CALL VecGetArrayReadF90( X, x_array, ierr ) + +! compute Jacobian entries at x + + CALL CUTEST_csgr_r( ierr, n, m, x_array, tao_data%Y, & + .FALSE., nnzj, nnzj, & + tao_data%J_val, tao_data%H_row, tao_data%H_col ) + IF ( ierr /= 0 ) RETURN + +! restore vector + + CALL VecRestoreArrayReadF90( X, x_array, ierr ) + +! insert the Hessian values into petsc storage + + DO l = 1, nnzj + i = tao_data%J_row( l ) - 1 + IF ( i >= 0 ) CALL MatSetValue( J, i, tao_data%J_col( l ) - 1, & + tao_data%J_val( l ), INSERT_VALUES, & + ierr ) + END DO + +! assemble matrix + + CALL MatAssemblyBegin( J, MAT_FINAL_ASSEMBLY, ierr ) + CALL MatAssemblyEnd( J, MAT_FINAL_ASSEMBLY, ierr ) + +! CALL PetscLogFlops(9.0d0*nn,ierr) + + RETURN + END SUBROUTINE FormJacobian + +! +!/*TEST +! +! build: +! requires: !complex +! +! test: +! args: -tao_smonitor -tao_type ntr -tao_gatol 1.e-5 +! requires: !single +! +!TEST*/ diff --git a/src/tenmin/makemaster b/src/tenmin/makemaster index 8d9d7f8..04877f2 100644 --- a/src/tenmin/makemaster +++ b/src/tenmin/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst TENMIN interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-26 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = TENMIN -package = tenmin - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = TENMIN +package = tenmin -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/tenmin/tenmin_main.f b/src/tenmin/tenmin_main.F similarity index 68% rename from src/tenmin/tenmin_main.f rename to src/tenmin/tenmin_main.F index d07d9ac..7983db0 100644 --- a/src/tenmin/tenmin_main.f +++ b/src/tenmin/tenmin_main.F @@ -1,26 +1,32 @@ -C ( Last modified on 5 Jan 2013 at 14:40:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-26 AT 15:10 GMT. - PROGRAM TENMIN_main +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM TENMIN_main + + USE CUTEST_KINDS_precision C TENSOR test driver for problems derived from SIF files. C Ali Bouaricha, CERFACS (April, 1993), updated by Ph. Toint (March 2001) C Revised for CUTEst, Nick Gould, January 2013 - INTEGER :: n, method, itnno, msg, ndigit - INTEGER :: i, ilim, iagflg, iahflg, status - INTEGER, PARAMETER :: input = 55, out = 6, inspec = 46 - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION :: gradtl, steptl, fscale, fpls, stepmx, typx - DOUBLE PRECISION :: gnorm - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19, zero = 0.0D+0 + INTEGER ( KIND = ip_ ) :: n, method, itnno, msg, ndigit + INTEGER ( KIND = ip_ ) :: i, ilim, iagflg, iahflg, status + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11, inspec = 46 + REAL ( KIND = rp_ ) :: gradtl, steptl, fscale, fpls, stepmx, typx + REAL ( KIND = rp_ ) :: gnorm + REAL ( KIND = rp_ ), PARAMETER :: biginf = REAL( 9.0D+19, rp_ ) + REAL ( KIND = rp_ ), PARAMETER :: zero = 0.0_rp_ LOGICAL :: bounds CHARACTER ( LEN = 10 ) :: pname - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IWRK - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, TYPSIZ - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: XPLS, GPLS - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : , :) :: H, WRK + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IWRK + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, TYPSIZ + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: XPLS, GPLS + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , :) :: H, WRK CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES EXTERNAL :: TENMIN_evalf, TENMIN_evalg, TENMIN_evalh @@ -58,7 +64,7 @@ PROGRAM TENMIN_main C find the problem dimension - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 C allocate workspace @@ -70,18 +76,18 @@ PROGRAM TENMIN_main C set up SIF data - CALL CUTEST_usetup( status, INPUT, out, io_buffer, - * n, X, XPLS, GPLS ) + CALL CUTEST_usetup_r( status, INPUT, out, io_buffer, + * n, X, XPLS, GPLS ) C obtain variable names - CALL CUTEST_unames( status, n, pname, XNAMES ) + CALL CUTEST_unames_r( status, n, pname, XNAMES ) IF ( status /= 0 ) GO TO 910 C set up algorithmic input data ndigit = 15 - steptl = 1.0D-5 + steptl = REAL( 1.0D-5, KIND = rp_ ) stepmx = BIGINF bounds = .FALSE. @@ -101,7 +107,7 @@ PROGRAM TENMIN_main C output solution - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 gnorm = zero @@ -116,6 +122,7 @@ PROGRAM TENMIN_main WRITE ( out, 2000 ) pname, n, ( CALLS( i ), i = 1, 3 ), * itnno, fpls, CPU( 1 ), CPU( 2 ) CLOSE( input ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -151,15 +158,16 @@ PROGRAM TENMIN_main END SUBROUTINE TENMIN_evalf( n, X, f ) - INTEGER :: n - DOUBLE PRECISION :: f, X( n ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: f, X( n ) C Interface for TENMIN (Chow, Schnabel, Eskow, 1993) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ufn( status, n, X, f ) - IF ( status .NE. 0 ) THEN + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ufn_r( status, n, X, f ) + IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status STOP @@ -168,12 +176,13 @@ SUBROUTINE TENMIN_evalf( n, X, f ) END SUBROUTINE TENMIN_evalg( n, X, G ) - INTEGER :: n - DOUBLE PRECISION :: X( n ), G( n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_ugr( status, n, X, G ) - IF ( status .NE. 0 ) THEN + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n + REAL ( KIND = rp_ ) :: X( n ), G( n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_ugr_r( status, n, X, G ) + IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status STOP @@ -182,12 +191,13 @@ SUBROUTINE TENMIN_evalg( n, X, G ) END SUBROUTINE TENMIN_evalh( nr, n, X, H ) - INTEGER :: n, nr - DOUBLE PRECISION ::X( n ), H( nr, n ) - INTEGER :: status - INTEGER, PARAMETER :: out = 6 - CALL CUTEST_udh( status, n, X, nr, H ) - IF ( status .NE. 0 ) THEN + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, nr + REAL ( KIND = rp_ ) ::X( n ), H( nr, n ) + INTEGER ( KIND = ip_ ) :: status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + CALL CUTEST_udh_r( status, n, X, nr, H ) + IF ( status /= 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") * status STOP diff --git a/src/tenmin/tenmin_test.f b/src/tenmin/tenmin_test.F similarity index 53% rename from src/tenmin/tenmin_test.f rename to src/tenmin/tenmin_test.F index d06d2ae..7d57ba4 100644 --- a/src/tenmin/tenmin_test.f +++ b/src/tenmin/tenmin_test.F @@ -1,4 +1,6 @@ -C ( Last modified on 5 Jan 2013 at 14:40:00 ) +C THIS VERSION: CUTEST 2.2 - 2023-11-26 AT 15:10 GMT. + +#include "cutest_modules.h" C Dummy TENSOR for testing tenmin_main interface to CUTEst C Nick Gould, 5th January 2013 @@ -7,14 +9,15 @@ SUBROUTINE TENSOR( nr, n, X, EVALF, EVALG, EVALH, TYPSIZ, * fscale, gradtl, steptl, ilim, stepmx, out, * method, iagflg, iahflg, ndigit, msg, XPLS, * fpls, GPLS, H, itnno, WRK, IWRK ) - INTEGER :: nr, n, method, msg, ndigit, ilim, itnno, out - INTEGER :: iagflg, iahflg - DOUBLE PRECISION :: gradtl, steptl, fscale, fpls, stepmx - INTEGER :: IWRK( n ) - DOUBLE PRECISION :: X( n ), TYPSIZ( n ), XPLS( n ), GPLS( n ) - DOUBLE PRECISION :: H( nr, n ), WRK( nr, 8 ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: nr, n, method, msg, ndigit, ilim, itnno + INTEGER ( KIND = ip_ ) :: iagflg, iahflg, out + REAL ( KIND = rp_ ) :: gradtl, steptl, fscale, fpls, stepmx + INTEGER ( KIND = ip_ ) :: IWRK( n ) + REAL ( KIND = rp_ ) :: X( n ), TYPSIZ( n ), XPLS( n ), GPLS( n ) + REAL ( KIND = rp_ ) :: H( nr, n ), WRK( nr, 8 ) EXTERNAL :: EVALF, EVALG, EVALH - INTEGER :: i + INTEGER ( KIND = ip_ ) :: i DO 10 i = 1, n XPLS( i ) = X( i ) 10 CONTINUE diff --git a/src/test/ctest.F90 b/src/test/ctest.F90 index 50b1fd5..38906d2 100644 --- a/src/test/ctest.F90 +++ b/src/test/ctest.F90 @@ -39,8 +39,7 @@ PROGRAM CUTEST_test_constrained_tools INTEGER ( KIND = ip_ ) :: l_j2_1, l_j2_2, l_j, icon, iprob INTEGER ( KIND = ip_ ) :: CHP_ne, l_chp, OHP_ne, nnz_vector, nnz_result REAL ( KIND = rp_ ) :: f, ci, y0 - LOGICAL :: grad, byrows, goth, gotj - LOGICAL :: grlagf, jtrans + LOGICAL :: grad, byrows, goth, gotj, grlagf, jtrans, noobj CHARACTER ( len = 10 ) :: p_name INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: X_type INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_row, H_col @@ -71,6 +70,13 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cdimen ' )" ) CALL CUTEST_cdimen_r( status, input, n, m ) WRITE( out, "( ' * n = ', I0, ', m = ', I0 )" ) n, m + WRITE( out, "( ' CALL CUTEST_cnoobj ' )" ) + CALL CUTEST_cnoobj_r( status, input, noobj ) + IF ( noobj ) THEN + WRITE( out, "( ' there is no objective function' )" ) + ELSE + WRITE( out, "( ' there is an objective function' )" ) + END IF l_h2_1 = n ALLOCATE( X( n ), X_l( n ), X_u( n ), G( n ), Ji( n ), & X_names( n ), X_type( n ), INDEX_nz_vector( n ), & @@ -167,7 +173,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_JT_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -175,7 +181,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .TRUE. and ', & & 'jtrans = .FALSE.' )" ) CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_J_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -183,7 +189,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .FALSE. and ', & & 'jtrans = .TRUE.' )" ) CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_JT_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -191,7 +197,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .FALSE. and ', & & 'jtrans = .FALSE.' )" ) CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_J_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -225,14 +231,12 @@ PROGRAM CUTEST_test_constrained_tools IF ( alloc_stat /= 0 ) GO TO 990 grad = .FALSE. WRITE( out, "( ' CALL CUTEST_cofsg with grad = .FALSE.' )" ) - CALL CUTEST_cofsg_r( status, n, X, f, & - G_ne, l_g, G_val, G_var, grad ) + CALL CUTEST_cofsg_r( status, n, X, f, G_ne, l_g, G_val, G_var, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_f( out, f ) grad = .TRUE. WRITE( out, "( ' CALL CUTEST_cofsg with grad = .TRUE.' )" ) - CALL CUTEST_cofsg_r( status, n, X, f, & - G_ne, l_g, G_val, G_var, grad ) + CALL CUTEST_cofsg_r( status, n, X, f, G_ne, l_g, G_val, G_var, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_f( out, f ) CALL WRITE_SG( out, G_ne, l_g, G_val, G_var ) @@ -289,13 +293,13 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. WRITE( out, "( ' CALL CUTEST_csgr with grlagf = .TRUE.' )" ) CALL CUTEST_csgr_r( status, n, m, X, Y, grlagf, & - J_ne, l_j, J_val, J_var, J_fun ) + J_ne, l_j, J_val, J_var, J_fun ) IF ( status /= 0 ) GO TO 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) grlagf = .FALSE. WRITE( out, "( ' CALL CUTEST_csgr with grlagf = .FALSE.' )" ) CALL CUTEST_csgr_r( status, n, m, X, Y, grlagf, & - J_ne, l_j, J_val, J_var, J_fun ) + J_ne, l_j, J_val, J_var, J_fun ) IF ( status /= 0 ) GO TO 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) @@ -305,7 +309,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_ccfg with grad = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_C( out, m, C ) CALL WRITE_JT_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -313,7 +317,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_ccfg with grad = .TRUE. and ', & & 'jtrans = .FALSE.' )" ) CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_C( out, m, C ) CALL WRITE_J_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -328,7 +332,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_ccfg with grad = .FALSE. and ', & & 'jtrans = .FALSE.' )" ) CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_C( out, m, C ) @@ -337,14 +341,14 @@ PROGRAM CUTEST_test_constrained_tools grad = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfsg with grad = .TRUE.' )" ) CALL CUTEST_ccfsg_r( status, n, m, X, C, & - J_ne, l_j, J_val, J_var, J_fun, grad ) + J_ne, l_j, J_val, J_var, J_fun, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_C( out, m, C ) CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) grad = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfsg with grad = .FALSE.' )" ) CALL CUTEST_ccfsg_r( status, n, m, X, C, & - J_ne, l_j, J_val, J_var, J_fun, grad ) + J_ne, l_j, J_val, J_var, J_fun, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_C( out, m, C ) @@ -389,13 +393,13 @@ PROGRAM CUTEST_test_constrained_tools grad = .FALSE. WRITE( out, "( ' CALL CUTEST_ccifsg with grad = .FALSE.' )" ) CALL CUTEST_ccifsg_r( status, n, icon, X, ci, & - Ji_ne, n, Ji, J_var, grad ) + Ji_ne, n, Ji, J_var, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_CI( out, icon, ci ) grad = .TRUE. WRITE( out, "( ' CALL CUTEST_ccifsg with grad = .TRUE.' )" ) CALL CUTEST_ccifsg_r( status, n, icon, X, ci, & - Ji_ne, n, Ji, J_var, grad ) + Ji_ne, n, Ji, J_var, grad ) IF ( status /= 0 ) GO TO 900 CALL WRITE_CI( out, icon, ci ) CALL WRITE_SJI( out, icon, Ji_ne, n, Ji, J_var ) @@ -447,7 +451,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_dense( out, n, l_h2_1, H2_val ) @@ -455,7 +459,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .TRUE. and ', & & 'jtrans = .FALSE.' )") CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_dense( out, n, l_h2_1, H2_val ) @@ -463,7 +467,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .FALSE. and ', & & 'jtrans = .TRUE.' )") CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_dense( out, n, l_h2_1, H2_val ) @@ -471,7 +475,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .FALSE. and ', & & 'jtrans = .FALSE.')") CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO TO 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_dense( out, n, l_h2_1, H2_val ) @@ -498,7 +502,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_csh' )" ) CALL CUTEST_csh_r( status, n, m, X, Y, & - H_ne, l_h, H_val, H_row, H_col ) + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -506,7 +510,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cshc' )" ) CALL CUTEST_cshc_r( status, n, m, X, Y, & - H_ne, l_h, H_val, H_row, H_col ) + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -515,7 +519,7 @@ PROGRAM CUTEST_test_constrained_tools y0 = 1.0_rp_ WRITE( out, "( ' CALL CUTEST_cshj' )" ) CALL CUTEST_cshj_r( status, n, m, X, y0, Y, & - H_ne, l_h, H_val, H_row, H_col ) + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -524,13 +528,13 @@ PROGRAM CUTEST_test_constrained_tools iprob = 0 WRITE( out, "( ' CALL CUTEST_cish for objective' )" ) CALL CUTEST_cish_r( status, n, X, iprob, & - H_ne, l_h, H_val, H_row, H_col ) + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) iprob = 1 WRITE( out, "( ' CALL CUTEST_cish for a constraint' )" ) CALL CUTEST_cish_r( status, n, X, iprob, & - H_ne, l_h, H_val, H_row, H_col ) + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -538,7 +542,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' Call CUTEST_csgrshp' )" ) CALL CUTEST_csgrshp_r( status, n, J_ne, l_j, J_var, J_fun, & - H_ne, l_h, H_row, H_col ) + H_ne, l_h, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_J_sparsity_pattern( out, J_ne, l_j, J_fun, J_var ) CALL WRITE_H_sparsity_pattern( out, H_ne, l_h, H_row, H_col ) @@ -548,14 +552,14 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. WRITE( out, "( ' CALL CUTEST_csgrsh with grlagf = .TRUE.' )" ) CALL CUTEST_csgrsh_r( status, n, m, X, Y, grlagf, J_ne, l_j, J_val, & - J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) + J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) grlagf = .FALSE. WRITE( out, "( ' CALL CUTEST_csgrsh with grlagf = .FALSE.' )" ) CALL CUTEST_csgrsh_r( status, n, m, X, Y, grlagf, J_ne, l_j, J_val, & - J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) + J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -580,14 +584,14 @@ PROGRAM CUTEST_test_constrained_tools byrows = .FALSE. WRITE( out, "( ' CALL CUTEST_ceh with byrows = .FALSE.' )" ) CALL CUTEST_ceh_r( status, n, m, X, Y, HE_nel, lhe_ptr, HE_row_ptr, & - HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) + HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_ceh with byrows = .TRUE.' )" ) CALL CUTEST_ceh_r( status, n, m, X, Y, HE_nel, lhe_ptr, HE_row_ptr, & - HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) + HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) @@ -655,8 +659,8 @@ PROGRAM CUTEST_test_constrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .FALSE.' )" ) CALL CUTEST_cshprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) @@ -664,8 +668,8 @@ PROGRAM CUTEST_test_constrained_tools goth = .TRUE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .TRUE.' )" ) CALL CUTEST_cshprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) @@ -710,8 +714,8 @@ PROGRAM CUTEST_test_constrained_tools goth = .TRUE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .TRUE.' )" ) CALL CUTEST_cshcprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) @@ -745,29 +749,29 @@ PROGRAM CUTEST_test_constrained_tools gotj = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CSJPROD with gotj = .FALSE. and jtrans = .FALSE.')") CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, n, & - nnz_result, INDEX_nz_result, RESULT, m ) + nnz_vector, INDEX_nz_vector, VECTOR, n, & + nnz_result, INDEX_nz_result, RESULT, m ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m ) gotj = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CSJPROD with gotj = .TRUE. and jtrans = .FALSE.')" ) CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, n, & - nnz_result, INDEX_nz_result, RESULT, m ) + nnz_vector, INDEX_nz_vector, VECTOR, n, & + nnz_result, INDEX_nz_result, RESULT, m ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m ) gotj = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CSJPROD with gotj = .FALSE. and jtrans = .TRUE.')" ) CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, m, & - nnz_result, INDEX_nz_result, RESULT, n ) + nnz_vector, INDEX_nz_vector, VECTOR, m, & + nnz_result, INDEX_nz_result, RESULT, n ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n ) gotj = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CSJPROD with gotj = .TRUE. and jtrans = .TRUE.' )" ) CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, m, & - nnz_result, INDEX_nz_result, RESULT, n ) + nnz_vector, INDEX_nz_vector, VECTOR, m, & + nnz_result, INDEX_nz_result, RESULT, n ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n ) @@ -797,13 +801,13 @@ PROGRAM CUTEST_test_constrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_cchprods with goth = .FALSE.' )" ) CALL CUTEST_cchprods_r( status, n, m, goth, X, VECTOR, l_chp, & - CHP_val, CHP_ind, CHP_ptr ) + CHP_val, CHP_ind, CHP_ptr ) CALL WRITE_CHP( out, m, l_chp, CHP_val, CHP_ind, CHP_ptr ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_cchprods with goth = .TRUE.' )" ) CALL CUTEST_cchprods_r( status, n, m, goth, X, VECTOR, l_chp, & - CHP_val, CHP_ind, CHP_ptr ) + CHP_val, CHP_ind, CHP_ptr ) CALL WRITE_CHP( out, m, l_chp, CHP_val, CHP_ind, CHP_ptr ) ! compute the number of nonzeros when forming the products of the objective @@ -831,13 +835,13 @@ PROGRAM CUTEST_test_constrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_cohprods with goth = .FALSE.' )" ) CALL CUTEST_cohprods_r( status, n, goth, X, VECTOR, & - OHP_ne, l_ohp, OHP_val, OHP_ind ) + OHP_ne, l_ohp, OHP_val, OHP_ind ) CALL WRITE_OHP( out, OHP_ne, l_ohp, OHP_val, OHP_ind ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_cohprods with goth = .TRUE.' )" ) CALL CUTEST_cohprods_r( status, n, goth, X, VECTOR, & - OHP_ne, l_ohp, OHP_val, OHP_ind ) + OHP_ne, l_ohp, OHP_val, OHP_ind ) CALL WRITE_OHP( out, OHP_ne, l_ohp, OHP_val, OHP_ind ) ! calls and time report @@ -857,7 +861,7 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_csetup ' )" ) CALL CUTEST_csetup_r( status, input, out, buffer, n, m, X, X_l, X_u, & - Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) + Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) IF ( status /= 0 ) GO TO 900 ! ... and terminal exit @@ -1118,21 +1122,22 @@ SUBROUTINE WRITE_G_sparsity_pattern( out, G_ne, l_g, G_ind ) INTEGER ( KIND = ip_ ), DIMENSION( l_g ) :: G_ind INTEGER ( KIND = ip_ ) :: i WRITE( out, "( ' * G(sparse)' )" ) - WRITE( out, "( ' * ', 5( ' ind' ) )" ) - DO i = 1, G_ne, 5 - IF ( i + 4 <= G_ne ) THEN - WRITE( out, "( ' * ', 5( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ), G_ind( i + 2 ), G_ind( i + 3 ), & - G_ind( i + 4 ) + WRITE( out, "( ' * ', 8( ' ind' ) )" ) + DO i = 1, G_ne, 8 + IF ( i + 7 <= G_ne ) THEN + WRITE( out, "( ' * ', 8I7 )" ) G_ind( i: i + 7 ) + ELSE IF ( i + 6 <= G_ne ) THEN + WRITE( out, "( ' * ', 7I7 )" ) G_ind( i: i + 6 ) + ELSE IF ( i + 5 <= G_ne ) THEN + WRITE( out, "( ' * ', 6I7 )" ) G_ind( i: i + 5 ) + ELSE IF ( i + 4 <= G_ne ) THEN + WRITE( out, "( ' * ', 5I7 )" ) G_ind( i: i + 4 ) ELSE IF ( i + 3 <= G_ne ) THEN - WRITE( out, "( ' * ', 4( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ), G_ind( i + 2 ), G_ind( i + 3 ) + WRITE( out, "( ' * ', 4I7 )" ) G_ind( i: i + 3 ) ELSE IF ( i + 2 <= G_ne ) THEN - WRITE( out, "( ' * ', 3( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ), G_ind( i + 2 ) + WRITE( out, "( ' * ', 3I7 )" ) G_ind( i : i + 2 ) ELSE IF ( i + 1 <= G_ne ) THEN - WRITE( out, "( ' * ', 2( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ) + WRITE( out, "( ' * ', 2I7 )" ) G_ind( i : i + 1 ) ELSE WRITE( out, "( ' * ', I7 )" ) G_ind( i ) END IF diff --git a/src/test/ctest_threaded.F90 b/src/test/ctest_threaded.F90 index 5c4f278..3e65e89 100644 --- a/src/test/ctest_threaded.F90 +++ b/src/test/ctest_threaded.F90 @@ -42,8 +42,7 @@ PROGRAM CUTEST_test_constrained_tools INTEGER ( KIND = ip_ ) :: nnz_vector, nnz_result INTEGER ( KIND = ip_ ) :: CHP_ne, l_chp, l_j2_1, l_j2_2, l_j, icon, iprob REAL ( KIND = rp_ ) :: f, ci, y0 - LOGICAL :: grad, byrows, goth, gotj - LOGICAL :: grlagf, jtrans + LOGICAL :: grad, byrows, goth, gotj, grlagf, jtrans, noobj CHARACTER ( len = 10 ) :: p_name INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: X_type INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_row, H_col @@ -73,6 +72,13 @@ PROGRAM CUTEST_test_constrained_tools WRITE( out, "( ' CALL CUTEST_cdimen ' )" ) CALL CUTEST_cdimen_r( status, input, n, m ) WRITE( out, "( ' * n = ', I0, ', m = ', I0 )" ) n, m + WRITE( out, "( ' CALL CUTEST_cnoobj ' )" ) + CALL CUTEST_cnoobj_r( status, input, noobj ) + IF ( noobj ) THEN + WRITE( out, "( ' there is no objective function' )" ) + ELSE + WRITE( out, "( ' there is an objective function' )" ) + END IF l_h2_1 = n ALLOCATE( X( n ), X_l( n ), X_u( n ), G( n ), Ji( n ), & X_names( n ), X_type( n ), INDEX_nz_vector( n ), & @@ -93,9 +99,9 @@ PROGRAM CUTEST_test_constrained_tools ! set up SIF data WRITE( out, "( ' CALL CUTEST_csetup ' )" ) - CALL CUTEST_csetup_threaded_r( status, input, out, threads, BUFFER, & - n, m, X, X_l, X_u, & - Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) + CALL CUTEST_csetup_threaded_r( status, input, out, threads, BUFFER, & + n, m, X, X_l, X_u, & + Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) IF ( status /= 0 ) GO to 900 CALL WRITE_X( out, n, X, X_l, X_u ) CALL WRITE_Y( out, m, Y, C_l, C_u, EQUATION, LINEAR ) @@ -105,9 +111,9 @@ PROGRAM CUTEST_test_constrained_tools ! obtain numbers of nonlinear variables, and equality and linear constraints WRITE( out, "( ' CALL CUTEST_cstats' )" ) - CALL CUTEST_cstats_r( status, nonlinear_variables_objective, & - nonlinear_variables_constraints, & - equality_constraints, linear_constraints ) + CALL CUTEST_cstats_r( status, nonlinear_variables_objective, & + nonlinear_variables_constraints, & + equality_constraints, linear_constraints ) IF ( status /= 0 ) GO to 900 WRITE( out, "( ' * nonlinear_variables_objective = ', I0, /, & & ' * nonlinear_variables_constraints = ', I0, /, & @@ -168,32 +174,32 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, thread ) + CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_JT_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) grlagf = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .TRUE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, thread ) + CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_J_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) grlagf = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .FALSE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, thread ) + CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_JT_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) grlagf = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .FALSE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, thread ) + CALL CUTEST_cgr_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_J_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) @@ -227,14 +233,14 @@ PROGRAM CUTEST_test_constrained_tools IF ( alloc_stat /= 0 ) GO TO 990 grad = .FALSE. WRITE( out, "( ' CALL CUTEST_cofsg with grad = .FALSE.' )" ) - CALL CUTEST_cofsg_threaded_r( status, n, X, f, & - G_ne, l_g, G_val, G_var, grad, thread ) + CALL CUTEST_cofsg_threaded_r( status, n, X, f, & + G_ne, l_g, G_val, G_var, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_f( out, f ) grad = .TRUE. WRITE( out, "( ' CALL CUTEST_cofsg with grad = .TRUE.' )" ) - CALL CUTEST_cofsg_threaded_r( status, n, X, f, & - G_ne, l_g, G_val, G_var, grad, thread ) + CALL CUTEST_cofsg_threaded_r( status, n, X, f, & + G_ne, l_g, G_val, G_var, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_f( out, f ) CALL WRITE_SG( out, G_ne, l_g, G_val, G_var ) @@ -243,8 +249,8 @@ PROGRAM CUTEST_test_constrained_tools icon = 0 WRITE( out, "( ' CALL CUTEST_cisgr for the objective function' )" ) - CALL CUTEST_cisgr_threaded_r( status, n, icon, X, & - G_ne, l_g, G_val, G_var, thread ) + CALL CUTEST_cisgr_threaded_r( status, n, icon, X, & + G_ne, l_g, G_val, G_var, thread ) IF ( status /= 0 ) GO TO 900 CALL WRITE_SG( out, G_ne, l_g, G_val, G_var ) @@ -284,14 +290,14 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. WRITE( out, "( ' CALL CUTEST_csgr with grlagf = .TRUE.' )" ) - CALL CUTEST_csgr_threaded_r( status, n, m, X, Y, grlagf, & - J_ne, l_j, J_val, J_var, J_fun, thread ) + CALL CUTEST_csgr_threaded_r( status, n, m, X, Y, grlagf, & + J_ne, l_j, J_val, J_var, J_fun, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) grlagf = .FALSE. WRITE( out, "( ' CALL CUTEST_csgr with grlagf = .FALSE.' )" ) - CALL CUTEST_csgr_threaded_r( status, n, m, X, Y, grlagf, & - J_ne, l_j, J_val, J_var, J_fun, thread ) + CALL CUTEST_csgr_threaded_r( status, n, m, X, Y, grlagf, & + J_ne, l_j, J_val, J_var, J_fun, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) @@ -300,31 +306,31 @@ PROGRAM CUTEST_test_constrained_tools grad = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad, thread ) + CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_C( out, m, C ) CALL WRITE_JT_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) grad = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .TRUE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad, thread ) + CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_C( out, m, C ) CALL WRITE_J_dense( out, n, m, l_j2_1, l_j2_2, J2_val ) grad = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .FALSE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad, thread ) + CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_C( out, m, C ) grad = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .FALSE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad, thread ) + CALL CUTEST_ccfg_threaded_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_C( out, m, C ) @@ -332,15 +338,15 @@ PROGRAM CUTEST_test_constrained_tools grad = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfsg with grad = .TRUE.' )" ) - CALL CUTEST_ccfsg_threaded_r( status, n, m, X, C, & - J_ne, l_j, J_val, J_var, J_fun, grad, thread ) + CALL CUTEST_ccfsg_threaded_r( status, n, m, X, C, J_ne, l_j, J_val, & + J_var, J_fun, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_C( out, m, C ) CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) grad = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfsg with grad = .FALSE.' )" ) - CALL CUTEST_ccfsg_threaded_r( status, n, m, X, C, & - J_ne, l_j, J_val, J_var, J_fun, grad, thread ) + CALL CUTEST_ccfsg_threaded_r( status, n, m, X, C, J_ne, l_j, J_val, & + J_var, J_fun, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_C( out, m, C ) @@ -385,14 +391,14 @@ PROGRAM CUTEST_test_constrained_tools grad = .FALSE. WRITE( out, "( ' CALL CUTEST_ccifsg with grad = .FALSE.' )" ) - CALL CUTEST_ccifsg_threaded_r( status, n, icon, X, ci, & - Ji_ne, n, Ji, J_var, grad, thread ) + CALL CUTEST_ccifsg_threaded_r( status, n, icon, X, ci, & + Ji_ne, n, Ji, J_var, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_CI( out, icon, ci ) grad = .TRUE. WRITE( out, "( ' CALL CUTEST_ccifsg with grad = .TRUE.' )" ) - CALL CUTEST_ccifsg_threaded_r( status, n, icon, X, ci, & - Ji_ne, n, Ji, J_var, grad, thread ) + CALL CUTEST_ccifsg_threaded_r( status, n, icon, X, ci, & + Ji_ne, n, Ji, J_var, grad, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_CI( out, icon, ci ) CALL WRITE_SJI( out, icon, Ji_ne, n, Ji, J_var ) @@ -400,8 +406,8 @@ PROGRAM CUTEST_test_constrained_tools ! compute just its sparse gradient WRITE( out, "( ' CALL CUTEST_cisgr for a constraint' )" ) - CALL CUTEST_cisgr_threaded_r( status, n, icon, X, & - Ji_ne, n, Ji, J_var, thread ) + CALL CUTEST_cisgr_threaded_r( status, n, icon, X, & + Ji_ne, n, Ji, J_var, thread ) IF ( status /= 0 ) GO TO 900 CALL WRITE_SJI( out, icon, Ji_ne, n, Ji, J_var ) @@ -444,7 +450,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) @@ -452,7 +458,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .TRUE. and ', & & 'jtrans = .FALSE.' )") - CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) @@ -460,7 +466,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .FALSE. and ', & & 'jtrans = .TRUE.' )") - CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) @@ -468,7 +474,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .FALSE. and ', & & 'jtrans = .FALSE.')") - CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & + CALL CUTEST_cgrdh_threaded_r( status, n, m, X, Y, grlagf, G, jtrans, & l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) @@ -495,16 +501,16 @@ PROGRAM CUTEST_test_constrained_tools ! compute the sparse Hessian value WRITE( out, "( ' CALL CUTEST_csh' )" ) - CALL CUTEST_csh_threaded_r( status, n, m, X, Y, & - H_ne, l_h, H_val, H_row, H_col, thread ) + CALL CUTEST_csh_threaded_r( status, n, m, X, Y, & + H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) ! compute the sparse Hessian value without the objective WRITE( out, "( ' CALL CUTEST_cshc' )" ) - CALL CUTEST_cshc_threaded_r( status, n, m, X, Y, & - H_ne, l_h, H_val, H_row, H_col, thread ) + CALL CUTEST_cshc_threaded_r( status, n, m, X, Y, & + H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -512,8 +518,8 @@ PROGRAM CUTEST_test_constrained_tools y0 = 2.0_rp_ WRITE( out, "( ' CALL CUTEST_cshj' )" ) - CALL CUTEST_cshj_threaded_r( status, n, m, X, y0, Y, & - H_ne, l_h, H_val, H_row, H_col, thread ) + CALL CUTEST_cshj_threaded_r( status, n, m, X, y0, Y, & + H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO TO 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -521,22 +527,22 @@ PROGRAM CUTEST_test_constrained_tools iprob = 0 WRITE( out, "( ' CALL CUTEST_cish for objective' )" ) - CALL CUTEST_cish_threaded_r( status, n, X, iprob, & - H_ne, l_h, H_val, H_row, H_col, thread ) + CALL CUTEST_cish_threaded_r( status, n, X, iprob, & + H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) iprob = 1 WRITE( out, "( ' CALL CUTEST_cish for a constraint' )" ) - CALL CUTEST_cish_threaded_r( status, n, X, iprob, & - H_ne, l_h, H_val, H_row, H_col, thread ) + CALL CUTEST_cish_threaded_r( status, n, X, iprob, & + H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) ! compute the sparsity pattern of the gradients and Hessian WRITE( out, "( ' Call CUTEST_csgrshp' )" ) - CALL CUTEST_csgrshp_r( status, n, J_ne, l_j, J_var, J_fun, & - H_ne, l_h, H_row, H_col ) + CALL CUTEST_csgrshp_r( status, n, J_ne, l_j, J_var, J_fun, & + H_ne, l_h, H_row, H_col ) IF ( status /= 0 ) GO TO 900 CALL WRITE_J_sparsity_pattern( out, J_ne, l_j, J_fun, J_var ) CALL WRITE_H_sparsity_pattern( out, H_ne, l_h, H_row, H_col ) @@ -545,14 +551,14 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. WRITE( out, "( ' CALL CUTEST_csgrsh with grlagf = .TRUE.' )" ) - CALL CUTEST_csgrsh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgrsh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) grlagf = .FALSE. WRITE( out, "( ' CALL CUTEST_csgrsh with grlagf = .FALSE.' )" ) - CALL CUTEST_csgrsh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgrsh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, H_ne, l_h, H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) @@ -577,7 +583,7 @@ PROGRAM CUTEST_test_constrained_tools byrows = .FALSE. WRITE( out, "( ' CALL CUTEST_ceh with byrows = .FALSE.' )" ) - CALL CUTEST_ceh_threaded_r( status, n, m, X, Y, HE_nel, lhe_ptr, & + CALL CUTEST_ceh_threaded_r( status, n, m, X, Y, HE_nel, lhe_ptr, & HE_row_ptr, HE_val_ptr, lhe_row, HE_row, & lhe_val, HE_val, byrows, thread ) IF ( status /= 0 ) GO to 900 @@ -585,7 +591,7 @@ PROGRAM CUTEST_test_constrained_tools HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_ceh with byrows = .TRUE.' )" ) - CALL CUTEST_ceh_threaded_r( status, n, m, X, Y, HE_nel, lhe_ptr, & + CALL CUTEST_ceh_threaded_r( status, n, m, X, Y, HE_nel, lhe_ptr, & HE_row_ptr, HE_val_ptr, lhe_row, HE_row, & lhe_val, HE_val, byrows, thread ) IF ( status /= 0 ) GO to 900 @@ -598,7 +604,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. ; byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_csgreh with grlagf = .TRUE. and ', & & 'byrows = .TRUE.')" ) - CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows, thread ) @@ -609,7 +615,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .TRUE. ; byrows = .FALSE. WRITE( out, "(' CALL CUTEST_csgreh with grlagf = .TRUE. and ', & & 'byrows = .FALSE.')" ) - CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows, thread ) @@ -620,7 +626,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .FALSE. ; byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_csgreh with grlagf = .FALSE. and ', & & 'byrows = .TRUE.')") - CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows, thread ) @@ -631,7 +637,7 @@ PROGRAM CUTEST_test_constrained_tools grlagf = .FALSE. ; byrows = .FALSE. WRITE( out, "(' CALL CUTEST_csgreh with grlagf = .FALSE. and ', & & 'byrows = .FALSE.')") - CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_threaded_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows, thread ) @@ -645,14 +651,14 @@ PROGRAM CUTEST_test_constrained_tools VECTOR( 1 ) = one ; VECTOR( 2 : n ) = zero goth = .FALSE. WRITE( out, "( ' Call CUTEST_chprod with goth = .FALSE.' )" ) - CALL CUTEST_chprod_threaded_r( status, n, m, goth, X, Y, VECTOR, RESULT, & - thread ) + CALL CUTEST_chprod_threaded_r( status, n, m, goth, X, Y, VECTOR, RESULT, & + thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_RESULT( out, n, VECTOR, RESULT ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_chprod with goth = .TRUE.' )" ) - CALL CUTEST_chprod_threaded_r( status, n, m, goth, X, Y, VECTOR, RESULT, & - thread ) + CALL CUTEST_chprod_threaded_r( status, n, m, goth, X, Y, VECTOR, RESULT, & + thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_RESULT( out, n, VECTOR, RESULT ) @@ -661,7 +667,7 @@ PROGRAM CUTEST_test_constrained_tools nnz_vector = 1 ; INDEX_nz_vector( nnz_vector ) = 1 goth = .FALSE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .FALSE.' )" ) - CALL CUTEST_cshprod_threaded_r( status, n, m, goth, X, Y, & + CALL CUTEST_cshprod_threaded_r( status, n, m, goth, X, Y, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT, thread ) IF ( status /= 0 ) GO to 900 @@ -670,7 +676,7 @@ PROGRAM CUTEST_test_constrained_tools goth = .TRUE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .TRUE.' )" ) - CALL CUTEST_cshprod_threaded_r( status, n, m, goth, X, Y, & + CALL CUTEST_cshprod_threaded_r( status, n, m, goth, X, Y, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT, thread ) IF ( status /= 0 ) GO to 900 @@ -681,14 +687,14 @@ PROGRAM CUTEST_test_constrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_chcprod with goth = .FALSE.' )" ) - CALL CUTEST_chcprod_threaded_r( status, n, m, goth, X, Y, VECTOR, RESULT, & - thread ) + CALL CUTEST_chcprod_threaded_r( status, n, m, goth, X, Y, VECTOR, & + RESULT, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_RESULT( out, n, VECTOR, RESULT ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_chcprod with goth = .TRUE.' )" ) - CALL CUTEST_chcprod_threaded_r( status, n, m, goth, X, Y, VECTOR, RESULT, & - thread ) + CALL CUTEST_chcprod_threaded_r( status, n, m, goth, X, Y, VECTOR, & + RESULT, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_RESULT( out, n, VECTOR, RESULT ) @@ -696,7 +702,7 @@ PROGRAM CUTEST_test_constrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .FALSE.' )" ) - CALL CUTEST_cshcprod_threaded_r( status, n, m, goth, X, Y, & + CALL CUTEST_cshcprod_threaded_r( status, n, m, goth, X, Y, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT, thread ) IF ( status /= 0 ) GO to 900 @@ -705,7 +711,7 @@ PROGRAM CUTEST_test_constrained_tools goth = .TRUE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .TRUE.' )" ) - CALL CUTEST_cshcprod_threaded_r( status, n, m, goth, X, Y, & + CALL CUTEST_cshcprod_threaded_r( status, n, m, goth, X, Y, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT, thread ) IF ( status /= 0 ) GO to 900 @@ -717,22 +723,22 @@ PROGRAM CUTEST_test_constrained_tools VECTOR( 1 ) = one ; VECTOR( 2 : MAX( n, m ) ) = zero gotj = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CJPROD with gotj = .FALSE. and jtrans = .FALSE.')" ) - CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, n, & + CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, n, & RESULT, m, thread ) CALL WRITE_RESULT2( out, n, VECTOR, m, RESULT ) gotj = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CJPROD with gotj = .TRUE. and jtrans = .FALSE.' )" ) - CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, n, & + CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, n, & RESULT, m, thread ) CALL WRITE_RESULT2( out, n, VECTOR, m, RESULT ) gotj = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CJPROD with gotj = .FALSE. and jtrans = .TRUE.')" ) - CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, m, & + CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, m, & RESULT, n, thread ) CALL WRITE_RESULT2( out, m, VECTOR, n, RESULT ) gotj = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CJPROD with gotj = .TRUE. and jtrans = .TRUE.' )" ) - CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, m, & + CALL CUTEST_cjprod_threaded_r( status, n, m, gotj, jtrans, X, VECTOR, m, & RESULT, n, thread ) CALL WRITE_RESULT2( out, m, VECTOR, n, RESULT ) @@ -740,28 +746,28 @@ PROGRAM CUTEST_test_constrained_tools gotj = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CSJPROD with gotj = .FALSE. and jtrans = .FALSE.')") - CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & + CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m, thread ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m ) gotj = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CSJPROD with gotj = .TRUE. and jtrans = .FALSE.')" ) - CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & + CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m, thread ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m ) gotj = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CSJPROD with gotj = .FALSE. and jtrans = .TRUE.')" ) - CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & + CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n, thread ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n ) gotj = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CSJPROD with gotj = .TRUE. and jtrans = .TRUE.' )" ) - CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & + CALL CUTEST_csjprod_threaded_r( status, n, m, gotj, jtrans, X, & nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n, thread ) CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, m, & @@ -792,14 +798,14 @@ PROGRAM CUTEST_test_constrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_cchprods with goth = .FALSE.' )" ) - CALL CUTEST_cchprods_threaded_r( status, n, m, goth, X, VECTOR, l_chp, & - CHP_val, CHP_ind, CHP_ptr, thread ) + CALL CUTEST_cchprods_threaded_r( status, n, m, goth, X, VECTOR, l_chp, & + CHP_val, CHP_ind, CHP_ptr, thread ) CALL WRITE_CHP( out, m, l_chp, CHP_val, CHP_ind, CHP_ptr ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_cchprods with goth = .TRUE.' )" ) - CALL CUTEST_cchprods_threaded_r( status, n, m, goth, X, VECTOR, l_chp, & - CHP_val, CHP_ind, CHP_ptr, thread ) + CALL CUTEST_cchprods_threaded_r( status, n, m, goth, X, VECTOR, l_chp, & + CHP_val, CHP_ind, CHP_ptr, thread ) CALL WRITE_CHP( out, m, l_chp, CHP_val, CHP_ind, CHP_ptr ) ! calls and time report @@ -1072,21 +1078,22 @@ SUBROUTINE WRITE_G_sparsity_pattern( out, G_ne, l_g, G_ind ) INTEGER ( KIND = ip_ ), DIMENSION( l_g ) :: G_ind INTEGER ( KIND = ip_ ) :: i WRITE( out, "( ' * G(sparse)' )" ) - WRITE( out, "( ' * ', 5( ' ind' ) )" ) - DO i = 1, G_ne, 5 - IF ( i + 4 <= G_ne ) THEN - WRITE( out, "( ' * ', 5( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ), G_ind( i + 2 ), G_ind( i + 3 ), & - G_ind( i + 4 ) + WRITE( out, "( ' * ', 8( ' ind' ) )" ) + DO i = 1, G_ne, 8 + IF ( i + 7 <= G_ne ) THEN + WRITE( out, "( ' * ', 8I7 )" ) G_ind( i: i + 7 ) + ELSE IF ( i + 6 <= G_ne ) THEN + WRITE( out, "( ' * ', 7I7 )" ) G_ind( i: i + 6 ) + ELSE IF ( i + 5 <= G_ne ) THEN + WRITE( out, "( ' * ', 6I7 )" ) G_ind( i: i + 5 ) + ELSE IF ( i + 4 <= G_ne ) THEN + WRITE( out, "( ' * ', 5I7 )" ) G_ind( i: i + 4 ) ELSE IF ( i + 3 <= G_ne ) THEN - WRITE( out, "( ' * ', 4( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ), G_ind( i + 2 ), G_ind( i + 3 ) + WRITE( out, "( ' * ', 4I7 )" ) G_ind( i: i + 3 ) ELSE IF ( i + 2 <= G_ne ) THEN - WRITE( out, "( ' * ', 3( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ), G_ind( i + 2 ) + WRITE( out, "( ' * ', 3I7 )" ) G_ind( i : i + 2 ) ELSE IF ( i + 1 <= G_ne ) THEN - WRITE( out, "( ' * ', 2( I7 ) )" ) & - G_ind( i ), G_ind( i + 1 ) + WRITE( out, "( ' * ', 2I7 )" ) G_ind( i : i + 1 ) ELSE WRITE( out, "( ' * ', I7 )" ) G_ind( i ) END IF diff --git a/src/test/lqptest.F90 b/src/test/lqptest.F90 index 60cb70f..0654b63 100644 --- a/src/test/lqptest.F90 +++ b/src/test/lqptest.F90 @@ -1,7 +1,6 @@ ! THIS VERSION: CUTEST 2.2 - 2023-11-12 AT 15:50 GMT. #include "cutest_modules.h" -#include "cutest_routines.h" !-*-*-*-*-*-*-*-*- C U T E S T l q p _ t e s t P R O G R A M -*-*-*-*-*-*-*- diff --git a/src/test/makemaster b/src/test/makemaster index 595d68f..64d966e 100644 --- a/src/test/makemaster +++ b/src/test/makemaster @@ -1,87 +1,28 @@ # Main body of the installation makefile for CUTEST test programs -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 19 XI 2012 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-21 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = TEST -package = test - -SHELL = /bin/$(BINSHELL) - -# preprocessing flags - -ifeq "$(PRECIS)" "single" - DPREC = -DCUTEST_SINGLE -else - DPREC = -DCUTEST_DOUBLE -endif - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) \ - $(DPREC) -I $(CUTEST)/include -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGS77N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) \ - $(DPREC) -I $(CUTEST)/include - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used +include $(CUTEST)/src/makedefs/defaults -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# Archive manipulation strings +# package name -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) +PACKAGE = TEST +package = test -# compilation agenda +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -#U_TEST = $(OBJ)/u_elfun.o $(OBJ)/u_group.o $(OBJ)/u_range.o $(OBJ)/u_exter.o -#C_TEST = $(OBJ)/c_elfun.o $(OBJ)/c_group.o $(OBJ)/c_range.o $(OBJ)/c_exter.o -U_TEST = $(OBJ)/u_elfun.o $(OBJ)/u_group.o $(OBJ)/u_range.o -C_TEST = $(OBJ)/c_elfun.o $(OBJ)/c_group.o $(OBJ)/c_range.o -Q_TEST = $(OBJ)/q_elfun.o $(OBJ)/q_group.o $(OBJ)/q_range.o +# include standard CUTEst makefile definitions -SUCC = precision version) compiled successfully +include $(CUTEST)/src/makedefs/definitions # main compilations and runs @@ -96,38 +37,31 @@ $(package)_double: $(OBJ)/$(package)_main.o test_cutest: test_cutest_$(PRECIS) @printf ' %-21s\n' "CUTEST: tests ($(PRECIS) $(SUCC)" - test_cutest_single: test_cutest_unconstrained_single \ test_cutest_constrained_single - test_cutest_double: test_cutest_unconstrained_double \ test_cutest_constrained_double test_cutest_unconstrained: test_cutest_unconstrained_$(PRECIS) @printf ' %-21s\n' "CUTEST: unconstrained tests ($(PRECIS) $(SUCC)" - test_cutest_unconstrained_single: $(U_TEST) - test_cutest_unconstrained_double: $(U_TEST) test_cutest_constrained: test_cutest_constrained_$(PRECIS) @printf ' %-21s\n' "CUTEST: constrained tests ($(PRECIS) $(SUCC)" - test_cutest_constrained_single: $(C_TEST) - test_cutest_constrained_double: $(C_TEST) test_cutest_quadratic: test_cutest_quadratic_$(PRECIS) @printf ' %-21s\n' "CUTEST: quadratic tests ($(PRECIS) $(SUCC)" - test_cutest_quadratic_single: $(Q_TEST) - test_cutest_quadratic_double: $(Q_TEST) # run example tests run_test_cutest: run_test_cutest_unconstrained run_test_cutest_constrained -run_test_threaded_cutest: run_test_cutest_threaded_unconstrained run_test_cutest_threaded_constrained +run_test_threaded_cutest: run_test_cutest_threaded_unconstrained \ + run_test_cutest_threaded_constrained run_test_cutest_unconstrained: utools test_cutest_unconstrained echo " Exhaustive test of unconstrained tools" @@ -143,10 +77,12 @@ run_test_cutest_constrained: ctools test_cutest_constrained $(CP) ../test/ctest.F90 $(OBJ)/ctest.F90 cd $(OBJ) ; echo "$(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ $(C_TEST) ctest.F90 -L$(OBJ) $(LIBS)" -# cd $(OBJ) ; $(FORTRAN) -cpp -dI -DCUTEST_DOUBLE -I $(CUTEST)/include ctest.F90 +# cd $(OBJ) ; $(FORTRAN) -cpp -dI -DCUTEST_DOUBLE \ +# -I $(CUTEST)/include ctest.F90 cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ $(C_TEST) ctest.F90 -L$(OBJ) $(LIBS) -# valgrind -v --tool=memcheck --leak-check=yes --show-reachable=yes --track-origins=yes $(OBJ)/run_test +# valgrind -v --tool=memcheck --leak-check=yes \ +# --show-reachable=yes --track-origins=yes $(OBJ)/run_test # - $(OBJ)/run_test - $(OBJ)/run_test >& ../test/test_con.output cat ../test/test_con.output @@ -222,99 +158,99 @@ ctools: $(OBJ)/u_elfun.o: ../test/u_elfun_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "u_elfun" $(CP) ../test/u_elfun_$(PRECIS).f $(OBJ)/u_elfun.f - cd $(OBJ); $(FORTRAN) -o u_elfun.o $(FFLAGS77) u_elfun.f \ + cd $(OBJ); $(FORTRAN) -o u_elfun.o $(FFLAGS) u_elfun.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o u_elfun.o $(FFLAGS77N) u_elfun.f ) + $(FORTRAN) -o u_elfun.o $(FFLAGSN) u_elfun.f ) $(RM) $(OBJ)/u_elfun.f @printf '[ OK ]\n' $(OBJ)/u_group.o: ../test/u_group_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "u_group" $(CP) ../test/u_group_$(PRECIS).f $(OBJ)/u_group.f - cd $(OBJ); $(FORTRAN) -o u_group.o $(FFLAGS77) u_group.f \ + cd $(OBJ); $(FORTRAN) -o u_group.o $(FFLAGS) u_group.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o u_group.o $(FFLAGS77N) u_group.f ) + $(FORTRAN) -o u_group.o $(FFLAGSN) u_group.f ) $(RM) $(OBJ)/u_group.f @printf '[ OK ]\n' $(OBJ)/u_range.o: ../test/u_range_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "u_range" $(CP) ../test/u_range_$(PRECIS).f $(OBJ)/u_range.f - cd $(OBJ); $(FORTRAN) -o u_range.o $(FFLAGS77) u_range.f \ + cd $(OBJ); $(FORTRAN) -o u_range.o $(FFLAGS) u_range.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o u_range.o $(FFLAGS77N) u_range.f ) + $(FORTRAN) -o u_range.o $(FFLAGSN) u_range.f ) $(RM) $(OBJ)/u_range.f @printf '[ OK ]\n' $(OBJ)/u_exter.o: ../test/u_exter_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "u_exter" $(CP) ../test/u_exter_$(PRECIS).f $(OBJ)/u_exter.f - cd $(OBJ); $(FORTRAN) -o u_exter.o $(FFLAGS77) u_exter.f \ + cd $(OBJ); $(FORTRAN) -o u_exter.o $(FFLAGS) u_exter.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o u_exter.o $(FFLAGS77N) u_exter.f ) + $(FORTRAN) -o u_exter.o $(FFLAGSN) u_exter.f ) $(RM) $(OBJ)/u_exter.f @printf '[ OK ]\n' $(OBJ)/c_elfun.o: ../test/c_elfun_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "c_elfun" $(CP) ../test/c_elfun_$(PRECIS).f $(OBJ)/c_elfun.f - cd $(OBJ); $(FORTRAN) -o c_elfun.o $(FFLAGS77) c_elfun.f \ + cd $(OBJ); $(FORTRAN) -o c_elfun.o $(FFLAGS) c_elfun.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o c_elfun.o $(FFLAGS77N) c_elfun.f ) + $(FORTRAN) -o c_elfun.o $(FFLAGSN) c_elfun.f ) $(RM) $(OBJ)/c_elfun.f @printf '[ OK ]\n' $(OBJ)/c_group.o: ../test/c_group_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "c_group" $(CP) ../test/c_group_$(PRECIS).f $(OBJ)/c_group.f - cd $(OBJ); $(FORTRAN) -o c_group.o $(FFLAGS77) c_group.f \ + cd $(OBJ); $(FORTRAN) -o c_group.o $(FFLAGS) c_group.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o c_group.o $(FFLAGS77N) c_group.f ) + $(FORTRAN) -o c_group.o $(FFLAGSN) c_group.f ) $(RM) $(OBJ)/c_group.f @printf '[ OK ]\n' $(OBJ)/c_range.o: ../test/c_range_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "c_range" $(CP) ../test/c_range_$(PRECIS).f $(OBJ)/c_range.f - cd $(OBJ); $(FORTRAN) -o c_range.o $(FFLAGS77) c_range.f \ + cd $(OBJ); $(FORTRAN) -o c_range.o $(FFLAGS) c_range.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o c_range.o $(FFLAGS77N) c_range.f ) + $(FORTRAN) -o c_range.o $(FFLAGSN) c_range.f ) $(RM) $(OBJ)/c_range.f @printf '[ OK ]\n' $(OBJ)/c_exter.o: ../test/c_exter_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "c_exter" $(CP) ../test/c_exter_$(PRECIS).f $(OBJ)/c_exter.f - cd $(OBJ); $(FORTRAN) -o c_exter.o $(FFLAGS77) c_exter.f \ + cd $(OBJ); $(FORTRAN) -o c_exter.o $(FFLAGS) c_exter.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o c_exter.o $(FFLAGS77N) c_exter.f ) + $(FORTRAN) -o c_exter.o $(FFLAGSN) c_exter.f ) $(RM) $(OBJ)/c_exter.f @printf '[ OK ]\n' $(OBJ)/q_elfun.o: ../test/q_elfun_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "q_elfun" $(CP) ../test/q_elfun_$(PRECIS).f $(OBJ)/q_elfun.f - cd $(OBJ); $(FORTRAN) -o q_elfun.o $(FFLAGS77) q_elfun.f \ + cd $(OBJ); $(FORTRAN) -o q_elfun.o $(FFLAGS) q_elfun.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o q_elfun.o $(FFLAGS77N) q_elfun.f ) + $(FORTRAN) -o q_elfun.o $(FFLAGSN) q_elfun.f ) $(RM) $(OBJ)/q_elfun.f @printf '[ OK ]\n' $(OBJ)/q_group.o: ../test/q_group_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "q_group" $(CP) ../test/q_group_$(PRECIS).f $(OBJ)/q_group.f - cd $(OBJ); $(FORTRAN) -o q_group.o $(FFLAGS77) q_group.f \ + cd $(OBJ); $(FORTRAN) -o q_group.o $(FFLAGS) q_group.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o q_group.o $(FFLAGS77N) q_group.f ) + $(FORTRAN) -o q_group.o $(FFLAGSN) q_group.f ) $(RM) $(OBJ)/q_group.f @printf '[ OK ]\n' $(OBJ)/q_range.o: ../test/q_range_$(PRECIS).f @printf ' %-9s %-15s\t\t' "Compiling" "q_range" $(CP) ../test/q_range_$(PRECIS).f $(OBJ)/q_range.f - cd $(OBJ); $(FORTRAN) -o q_range.o $(FFLAGS77) q_range.f \ + cd $(OBJ); $(FORTRAN) -o q_range.o $(FFLAGS) q_range.f \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o q_range.o $(FFLAGS77N) q_range.f ) + $(FORTRAN) -o q_range.o $(FFLAGSN) q_range.f ) $(RM) $(OBJ)/q_range.f @printf '[ OK ]\n' @@ -323,10 +259,10 @@ $(OBJ)/q_range.o: ../test/q_range_$(PRECIS).f $(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.F90 @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" $(CP) ../$(package)/$(package)_main.F90 $(OBJ)/$(package)_main.F90 - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(F90FLAGS) \ $(package)_main.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGSN) $(package)_main.F90 ) + $(FORTRAN) -o $(package)_main.o $(F90FLAGSN) $(package)_main.F90 ) $(RM) $(OBJ)/$(package)_main.F90 $(OBJ)/*.mod @printf '[ OK ]\n' diff --git a/src/test/q_OUTSDIF.d b/src/test/q_OUTSDIF.d index c998d5f..d8c7d1c 100644 --- a/src/test/q_OUTSDIF.d +++ b/src/test/q_OUTSDIF.d @@ -1,5 +1,5 @@ 10 7 19 19 28 11 0 0 2 0 - 3ALLINQP 0 + 3ALLINQP 0 1 1 1 1 1 1 1 20 1 1 1 1 1 1 1 1 1 2 4 6 8 10 12 12 @@ -61,4 +61,4 @@ X9 X10 123456789S123456789P 0 0 0 0 0 0 0 0 0 0 -ALLINQP 1 4 2 2 1 0 2 0 1 0 4 0 +ALLINQP 1 4 2 2 1 0 2 0 1 0 4 0 diff --git a/src/test/test_main.F90 b/src/test/test_main.F90 index 7ff7569..c2baca9 100644 --- a/src/test/test_main.F90 +++ b/src/test/test_main.F90 @@ -42,7 +42,7 @@ PROGRAM CUTEST_test_main INTEGER ( KIND = ip_ ) :: nnz_vector, nnz_result REAL ( KIND = rp_ ) :: f, ci, y0 LOGICAL :: grad, byrows, goth, gotj, grlagf, jtrans, only_print_small - LOGICAL :: debug_cutest_exists + LOGICAL :: debug_cutest_exists, noobj CHARACTER ( len = 10 ) :: p_name INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: X_type INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: H_row, H_col @@ -245,7 +245,7 @@ PROGRAM CUTEST_test_main byrows = .FALSE. WRITE( out, "( ' Call CUTEST_ueh with byrows = .FALSE.' )" ) - CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -253,7 +253,7 @@ PROGRAM CUTEST_test_main HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' Call CUTEST_ueh with byrows = .TRUE.' )" ) - CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -264,7 +264,7 @@ PROGRAM CUTEST_test_main byrows = .FALSE. WRITE( out, "( ' Call CUTEST_ugreh with byrows = .FALSE' )" ) - CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -274,7 +274,7 @@ PROGRAM CUTEST_test_main HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' Call CUTEST_ugreh with byrows = .TRUE.' )" ) - CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -304,7 +304,7 @@ PROGRAM CUTEST_test_main nnz_vector = 1 ; INDEX_nz_vector( nnz_vector ) = 1 goth = .FALSE. WRITE( out, "( ' Call CUTEST_ushprod with goth = .FALSE.' )" ) - CALL CUTEST_ushprod_r( status, n, goth, X, & + CALL CUTEST_ushprod_r( status, n, goth, X, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO to 900 @@ -314,7 +314,7 @@ PROGRAM CUTEST_test_main goth = .TRUE. WRITE( out, "( ' Call CUTEST_ushprod with goth = .TRUE.' )" ) - CALL CUTEST_ushprod_r( status, n, goth, X, & + CALL CUTEST_ushprod_r( status, n, goth, X, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO to 900 @@ -383,16 +383,24 @@ PROGRAM CUTEST_test_main WRITE( out, "( ' CALL CUTEST_cdimen ' )" ) WRITE( out, "( ' * n = ', I0, ', m = ', I0 )" ) n, m + WRITE( out, "( ' CALL CUTEST_cnoobj ' )" ) + CALL CUTEST_cnoobj_r( status, input, noobj ) + IF ( noobj ) THEN + WRITE( out, "( ' there is no objective function' )" ) + ELSE + WRITE( out, "( ' there is an objective function' )" ) + END IF l_h2_1 = n ALLOCATE( X( n ), X_l( n ), X_u( n ), G( n ), Ji( n ), & - X_names( n ), X_type( n ), INDEX_nz_vector( n ), & - INDEX_nz_result( n ), stat = alloc_stat ) + X_names( n ), X_type( n ), stat = alloc_stat ) IF ( alloc_stat /= 0 ) GO TO 990 ALLOCATE( C( m ), Y( m ), C_l( m ), C_u( m ), C_names( m ), & EQUATION( m ), LINEAR( m ), stat = alloc_stat ) IF ( alloc_stat /= 0 ) GO TO 990 ALLOCATE( VECTOR( MAX( n, m ) ), RESULT( MAX( n, m ) ), & + INDEX_nz_vector( MAX( n, m ) ), & + INDEX_nz_result( MAX( n, m ) ), & stat = alloc_stat ) IF ( alloc_stat /= 0 ) GO TO 990 ALLOCATE( H2_val( l_h2_1, n ), stat = alloc_stat ) @@ -404,7 +412,7 @@ PROGRAM CUTEST_test_main ! set up SIF data WRITE( out, "( ' CALL CUTEST_csetup ' )" ) - CALL CUTEST_csetup_r( status, input, out, buffer, n, m, X, X_l, X_u, & + CALL CUTEST_csetup_r( status, input, out, buffer, n, m, X, X_l, X_u, & Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -417,9 +425,9 @@ PROGRAM CUTEST_test_main ! obtain numbers of nonlinear variables, and equality and linear constraints WRITE( out, "( ' CALL CUTEST_cstats' )" ) - CALL CUTEST_cstats_r( status, nonlinear_variables_objective, & - nonlinear_variables_constraints, & - equality_constraints, linear_constraints ) + CALL CUTEST_cstats_r( status, nonlinear_variables_objective, & + nonlinear_variables_constraints, & + equality_constraints, linear_constraints ) IF ( status /= 0 ) GO to 900 WRITE( out, "( ' * nonlinear_variables_objective = ', I0, /, & & ' * nonlinear_variables_constraints = ', I0, /, & @@ -485,8 +493,8 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -495,8 +503,8 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .TRUE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -505,8 +513,8 @@ PROGRAM CUTEST_test_main grlagf = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .FALSE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -515,8 +523,8 @@ PROGRAM CUTEST_test_main grlagf = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgr with grlagf = .FALSE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val ) + CALL CUTEST_cgr_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -554,7 +562,7 @@ PROGRAM CUTEST_test_main IF ( alloc_stat /= 0 ) GO TO 990 grad = .TRUE. WRITE( out, "( ' CALL CUTEST_cofsg with grad = .TRUE.' )" ) - CALL CUTEST_cofsg_r( status, n, X, f, & + CALL CUTEST_cofsg_r( status, n, X, f, & G_ne, l_g, G_val, G_var, grad ) IF ( status /= 0 ) GO to 900 CALL WRITE_f( out, f ) @@ -562,7 +570,7 @@ PROGRAM CUTEST_test_main CALL WRITE_SG( out, G_ne, l_g, G_val, G_var ) grad = .FALSE. WRITE( out, "( ' CALL CUTEST_cofsg with grad = .FALSE.' )" ) - CALL CUTEST_cofsg_r( status, n, X, f, & + CALL CUTEST_cofsg_r( status, n, X, f, & G_ne, l_g, G_val, G_var, grad ) IF ( status /= 0 ) GO to 900 CALL WRITE_f( out, f ) @@ -622,14 +630,14 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. WRITE( out, "( ' CALL CUTEST_csgr with grlagf = .TRUE.' )" ) - CALL CUTEST_csgr_r( status, n, m, X, Y, grlagf, & + CALL CUTEST_csgr_r( status, n, m, X, Y, grlagf, & J_ne, l_j, J_val, J_var, J_fun ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) grlagf = .FALSE. WRITE( out, "( ' CALL CUTEST_csgr with grlagf = .FALSE.' )" ) - CALL CUTEST_csgr_r( status, n, m, X, Y, grlagf, & + CALL CUTEST_csgr_r( status, n, m, X, Y, grlagf, & J_ne, l_j, J_val, J_var, J_fun ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -640,8 +648,8 @@ PROGRAM CUTEST_test_main grad = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_C( out, m, C ) @@ -650,8 +658,8 @@ PROGRAM CUTEST_test_main grad = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .TRUE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_C( out, m, C ) @@ -660,16 +668,16 @@ PROGRAM CUTEST_test_main grad = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .FALSE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_C( out, m, C ) grad = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfg with grad = .FALSE. and ', & & 'jtrans = .FALSE.' )" ) - CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & - l_j2_1, l_j2_2, J2_val, grad ) + CALL CUTEST_ccfg_r( status, n, m, X, C, jtrans, & + l_j2_1, l_j2_2, J2_val, grad ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_C( out, m, C ) @@ -678,8 +686,8 @@ PROGRAM CUTEST_test_main grad = .TRUE. WRITE( out, "( ' CALL CUTEST_ccfsg with grad = .TRUE.' )" ) - CALL CUTEST_ccfsg_r( status, n, m, X, C, & - J_ne, l_j, J_val, J_var, J_fun, grad ) + CALL CUTEST_ccfsg_r( status, n, m, X, C, & + J_ne, l_j, J_val, J_var, J_fun, grad ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_C( out, m, C ) @@ -687,8 +695,8 @@ PROGRAM CUTEST_test_main CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) grad = .FALSE. WRITE( out, "( ' CALL CUTEST_ccfsg with grad = .FALSE.' )" ) - CALL CUTEST_ccfsg_r( status, n, m, X, C, & - J_ne, l_j, J_val, J_var, J_fun, grad ) + CALL CUTEST_ccfsg_r( status, n, m, X, C, & + J_ne, l_j, J_val, J_var, J_fun, grad ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_C( out, m, C ) @@ -736,15 +744,15 @@ PROGRAM CUTEST_test_main grad = .TRUE. WRITE( out, "( ' CALL CUTEST_ccifsg with grad = .TRUE.' )" ) - CALL CUTEST_ccifsg_r( status, n, icon, X, ci, & - Ji_ne, n, Ji, J_var, grad ) + CALL CUTEST_ccifsg_r( status, n, icon, X, ci, & + Ji_ne, n, Ji, J_var, grad ) IF ( status /= 0 ) GO to 900 CALL WRITE_CI( out, icon, ci ) IF ( only_print_small ) & CALL WRITE_SJI( out, icon, Ji_ne, n, Ji, J_var ) grad = .FALSE. WRITE( out, "( ' CALL CUTEST_ccifsg with grad = .FALSE.' )" ) - CALL CUTEST_ccifsg_r( status, n, icon, X, ci, & + CALL CUTEST_ccifsg_r( status, n, icon, X, ci, & Ji_ne, n, Ji, J_var, grad ) IF ( status /= 0 ) GO to 900 CALL WRITE_CI( out, icon, ci ) @@ -801,8 +809,8 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .TRUE. and ', & & 'jtrans = .TRUE.' )" ) - CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -811,8 +819,8 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .TRUE. and ', & & 'jtrans = .FALSE.' )") - CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -821,8 +829,8 @@ PROGRAM CUTEST_test_main grlagf = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .FALSE. and ', & & 'jtrans = .TRUE.' )") - CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -831,8 +839,8 @@ PROGRAM CUTEST_test_main grlagf = .FALSE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CUTEST_cgrdh with grlagf = .FALSE. and ', & & 'jtrans = .FALSE.')") - CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & - l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) + CALL CUTEST_cgrdh_r( status, n, m, X, Y, grlagf, G, jtrans, & + l_j2_1, l_j2_2, J2_val, l_h2_1, H2_val ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_G( out, n, G ) @@ -861,8 +869,8 @@ PROGRAM CUTEST_test_main ! compute the sparse Hessian value WRITE( out, "( ' CALL CUTEST_csh' )" ) - CALL CUTEST_csh_r( status, n, m, X, Y, & - H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_csh_r( status, n, m, X, Y, & + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -870,8 +878,8 @@ PROGRAM CUTEST_test_main ! compute the sparse Hessian value without the objective WRITE( out, "( ' CALL CUTEST_cshc' )" ) - CALL CUTEST_cshc_r( status, n, m, X, Y, & - H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_cshc_r( status, n, m, X, Y, & + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -880,8 +888,8 @@ PROGRAM CUTEST_test_main y0 = 1.0_rp_ WRITE( out, "( ' CALL CUTEST_cshj' )" ) - CALL CUTEST_cshj_r( status, n, m, X, y0, Y, & - H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_cshj_r( status, n, m, X, y0, Y, & + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO TO 900 IF ( only_print_small ) & CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -890,15 +898,15 @@ PROGRAM CUTEST_test_main iprob = 0 WRITE( out, "( ' CALL CUTEST_cish for objective' )" ) - CALL CUTEST_cish_r( status, n, X, iprob, & - H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_cish_r( status, n, X, iprob, & + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) iprob = 1 WRITE( out, "( ' CALL CUTEST_cish for a constraint' )" ) - CALL CUTEST_cish_r( status, n, X, iprob, & - H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_cish_r( status, n, X, iprob, & + H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -906,8 +914,8 @@ PROGRAM CUTEST_test_main ! compute the sparsity pattern of the gradients and Hessian WRITE( out, "( ' Call CUTEST_csgrshp' )" ) - CALL CUTEST_csgrshp_r( status, n, J_ne, l_j, J_var, J_fun, & - H_ne, l_h, H_row, H_col ) + CALL CUTEST_csgrshp_r( status, n, J_ne, l_j, J_var, J_fun, & + H_ne, l_h, H_row, H_col ) IF ( status /= 0 ) GO TO 900 IF ( only_print_small ) THEN CALL WRITE_J_sparsity_pattern( out, J_ne, l_j, J_fun, J_var ) @@ -918,8 +926,8 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. WRITE( out, "( ' CALL CUTEST_csgrsh with grlagf = .TRUE.' )" ) - CALL CUTEST_csgrsh_r( status, n, m, X, Y, grlagf, J_ne, l_j, J_val, & - J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_csgrsh_r( status, n, m, X, Y, grlagf, J_ne, l_j, J_val, & + J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) @@ -927,8 +935,8 @@ PROGRAM CUTEST_test_main CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) grlagf = .FALSE. WRITE( out, "( ' CALL CUTEST_csgrsh with grlagf = .FALSE.' )" ) - CALL CUTEST_csgrsh_r( status, n, m, X, Y, grlagf, J_ne, l_j, J_val, & - J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) + CALL CUTEST_csgrsh_r( status, n, m, X, Y, grlagf, J_ne, l_j, J_val, & + J_var, J_fun, H_ne, l_h, H_val, H_row, H_col ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & CALL WRITE_J_sparse( out, J_ne, l_j, J_val, J_fun, J_var ) @@ -954,7 +962,7 @@ PROGRAM CUTEST_test_main byrows = .FALSE. WRITE( out, "( ' CALL CUTEST_ceh with byrows = .FALSE.' )" ) - CALL CUTEST_ceh_r( status, n, m, X, Y, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ceh_r( status, n, m, X, Y, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -962,7 +970,7 @@ PROGRAM CUTEST_test_main HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_ceh with byrows = .TRUE.' )" ) - CALL CUTEST_ceh_r( status, n, m, X, Y, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ceh_r( status, n, m, X, Y, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 IF ( only_print_small ) & @@ -974,7 +982,7 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. ; byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_csgreh with grlagf = .TRUE. and ', & & 'byrows = .TRUE.')" ) - CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows ) @@ -987,7 +995,7 @@ PROGRAM CUTEST_test_main grlagf = .TRUE. ; byrows = .FALSE. WRITE( out, "(' CALL CUTEST_csgreh with grlagf = .TRUE. and ', & & 'byrows = .FALSE.')" ) - CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows ) @@ -1000,7 +1008,7 @@ PROGRAM CUTEST_test_main grlagf = .FALSE. ; byrows = .TRUE. WRITE( out, "( ' CALL CUTEST_csgreh with grlagf = .FALSE. and ', & & 'byrows = .TRUE.')") - CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows ) @@ -1013,7 +1021,7 @@ PROGRAM CUTEST_test_main grlagf = .FALSE. ; byrows = .FALSE. WRITE( out, "(' CALL CUTEST_csgreh with grlagf = .FALSE. and ', & & 'byrows = .FALSE.')") - CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & + CALL CUTEST_csgreh_r( status, n, m, X, Y, grlagf, J_ne, l_j, & J_val, J_var, J_fun, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, & byrows ) @@ -1045,9 +1053,9 @@ PROGRAM CUTEST_test_main nnz_vector = 1 ; INDEX_nz_vector( nnz_vector ) = 1 goth = .FALSE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .FALSE.' )" ) - CALL CUTEST_cshprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + CALL CUTEST_cshprod_r( status, n, m, goth, X, Y, & + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 IF ( only_print_small ) & CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & @@ -1055,9 +1063,9 @@ PROGRAM CUTEST_test_main goth = .TRUE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .TRUE.' )" ) - CALL CUTEST_cshprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + CALL CUTEST_cshprod_r( status, n, m, goth, X, Y, & + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 IF ( only_print_small ) & CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & @@ -1097,9 +1105,9 @@ PROGRAM CUTEST_test_main goth = .FALSE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .FALSE.' )" ) - CALL CUTEST_cshcprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + CALL CUTEST_cshcprod_r( status, n, m, goth, X, Y, & + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 IF ( only_print_small ) & CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & @@ -1107,9 +1115,9 @@ PROGRAM CUTEST_test_main goth = .TRUE. WRITE( out, "( ' Call CUTEST_cshprod with goth = .TRUE.' )" ) - CALL CUTEST_cshcprod_r( status, n, m, goth, X, Y, & - nnz_vector, INDEX_nz_vector, VECTOR, & - nnz_result, INDEX_nz_result, RESULT ) + CALL CUTEST_cshcprod_r( status, n, m, goth, X, Y, & + nnz_vector, INDEX_nz_vector, VECTOR, & + nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO TO 900 IF ( only_print_small ) & CALL WRITE_SRESULT( out, n, nnz_vector, INDEX_nz_vector, VECTOR, & @@ -1120,26 +1128,26 @@ PROGRAM CUTEST_test_main VECTOR = one gotj = .FALSE. ; jtrans = .FALSE. WRITE( out, "(' CALL CJPROD with gotj = .FALSE. and jtrans = .FALSE.')") - CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, n, RESULT, & - m ) + CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, n, & + RESULT, m ) IF ( only_print_small ) & CALL WRITE_RESULT2( out, n, VECTOR, m, RESULT ) gotj = .TRUE. ; jtrans = .FALSE. WRITE( out, "( ' CALL CJPROD with gotj = .TRUE. and jtrans = .TRUE.' )") - CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, n, RESULT, & - m ) + CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, n, & + RESULT, m ) IF ( only_print_small ) & CALL WRITE_RESULT2( out, n, VECTOR, m, RESULT ) gotj = .FALSE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CJPROD with gotj = .FALSE. and jtrans = .TRUE.')") - CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, m, RESULT, & - n ) + CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, m, & + RESULT, n ) IF ( only_print_small ) & CALL WRITE_RESULT2( out, m, VECTOR, n, RESULT ) gotj = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CJPROD with gotj = .TRUE. and jtrans = .TRUE.' )") - CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, m, RESULT, & - n ) + CALL CUTEST_cjprod_r( status, n, m, gotj, jtrans, X, VECTOR, m, & + RESULT, n ) IF ( only_print_small ) & CALL WRITE_RESULT2( out, m, VECTOR, n, RESULT ) @@ -1147,33 +1155,33 @@ PROGRAM CUTEST_test_main gotj = .FALSE. ; jtrans = .FALSE. WRITE( out,"(' CALL CSJPROD with gotj = .FALSE. and jtrans = .FALSE.')") - CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, n, & - nnz_result, INDEX_nz_result, RESULT, m ) + CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & + nnz_vector, INDEX_nz_vector, VECTOR, n, & + nnz_result, INDEX_nz_result, RESULT, m ) IF ( only_print_small ) & CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m ) gotj = .TRUE. ; jtrans = .FALSE. WRITE( out, "(' CALL CSJPROD with gotj = .TRUE. and jtrans = .FALSE.')") - CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, n, & - nnz_result, INDEX_nz_result, RESULT, m ) + CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & + nnz_vector, INDEX_nz_vector, VECTOR, n, & + nnz_result, INDEX_nz_result, RESULT, m ) IF ( only_print_small ) & CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, n, & nnz_result, INDEX_nz_result, RESULT, m ) gotj = .FALSE. ; jtrans = .TRUE. WRITE( out, "(' CALL CSJPROD with gotj = .FALSE. and jtrans = .TRUE.')") - CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, m, & - nnz_result, INDEX_nz_result, RESULT, n ) + CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & + nnz_vector, INDEX_nz_vector, VECTOR, m, & + nnz_result, INDEX_nz_result, RESULT, n ) IF ( only_print_small ) & CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n ) gotj = .TRUE. ; jtrans = .TRUE. WRITE( out, "( ' CALL CSJPROD with gotj = .TRUE. and jtrans = .TRUE.')") - CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & - nnz_vector, INDEX_nz_vector, VECTOR, m, & - nnz_result, INDEX_nz_result, RESULT, n ) + CALL CUTEST_csjprod_r( status, n, m, gotj, jtrans, X, & + nnz_vector, INDEX_nz_vector, VECTOR, m, & + nnz_result, INDEX_nz_result, RESULT, n ) IF ( only_print_small ) & CALL WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, m, & nnz_result, INDEX_nz_result, RESULT, n ) @@ -1204,15 +1212,15 @@ PROGRAM CUTEST_test_main goth = .FALSE. WRITE( out, "( ' Call CUTEST_cchprods with goth = .FALSE.' )" ) - CALL CUTEST_cchprods_r( status, n, m, goth, X, VECTOR, l_chp, & - CHP_val, CHP_ind, CHP_ptr ) + CALL CUTEST_cchprods_r( status, n, m, goth, X, VECTOR, l_chp, & + CHP_val, CHP_ind, CHP_ptr ) IF ( only_print_small ) & CALL WRITE_CHP( out, m, l_chp, CHP_val, CHP_ind, CHP_ptr ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_cchprods with goth = .TRUE.' )" ) - CALL CUTEST_cchprods_r( status, n, m, goth, X, VECTOR, l_chp, & - CHP_val, CHP_ind, CHP_ptr ) + CALL CUTEST_cchprods_r( status, n, m, goth, X, VECTOR, l_chp, & + CHP_val, CHP_ind, CHP_ptr ) IF ( only_print_small ) & CALL WRITE_CHP( out, m, l_chp, CHP_val, CHP_ind, CHP_ptr ) @@ -1241,15 +1249,15 @@ PROGRAM CUTEST_test_main goth = .FALSE. WRITE( out, "( ' Call CUTEST_cohprods with goth = .FALSE.' )" ) - CALL CUTEST_cohprods_r( status, n, goth, X, VECTOR, & - OHP_ne, l_ohp, OHP_val, OHP_ind ) + CALL CUTEST_cohprods_r( status, n, goth, X, VECTOR, & + OHP_ne, l_ohp, OHP_val, OHP_ind ) IF ( only_print_small ) & CALL WRITE_OHP( out, OHP_ne, l_ohp, OHP_val, OHP_ind ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_cohprods with goth = .TRUE.' )" ) - CALL CUTEST_cohprods_r( status, n, goth, X, VECTOR, & - OHP_ne, l_ohp, OHP_val, OHP_ind ) + CALL CUTEST_cohprods_r( status, n, goth, X, VECTOR, & + OHP_ne, l_ohp, OHP_val, OHP_ind ) IF ( only_print_small ) & CALL WRITE_OHP( out, OHP_ne, l_ohp, OHP_val, OHP_ind ) @@ -1269,8 +1277,8 @@ PROGRAM CUTEST_test_main ! one more setup ... WRITE( out, "( ' CALL CUTEST_csetup ' )" ) - CALL CUTEST_csetup_r( status, input, out, buffer, n, m, X, X_l, X_u, & - Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) + CALL CUTEST_csetup_r( status, input, out, buffer, n, m, X, X_l, X_u, & + Y, C_l, C_u, EQUATION, LINEAR, 1, 1, 1 ) IF ( status /= 0 ) GO to 900 ! ... and terminal exit @@ -1531,12 +1539,12 @@ SUBROUTINE WRITE_G_sparsity_pattern( out, G_ne, l_g, G_ind ) INTEGER ( KIND = ip_ ) :: i WRITE( out, "( ' * G(sparse)' )" ) WRITE( out, "( ' * ', 8( ' ind' ) )" ) - DO i = 1, G_ne, 5 + DO i = 1, G_ne, 8 IF ( i + 7 <= G_ne ) THEN WRITE( out, "( ' * ', 8I7 )" ) G_ind( i: i + 7 ) - ELSE IF ( i + 4 <= G_ne ) THEN + ELSE IF ( i + 6 <= G_ne ) THEN WRITE( out, "( ' * ', 7I7 )" ) G_ind( i: i + 6 ) - ELSE IF ( i + 4 <= G_ne ) THEN + ELSE IF ( i + 5 <= G_ne ) THEN WRITE( out, "( ' * ', 6I7 )" ) G_ind( i: i + 5 ) ELSE IF ( i + 4 <= G_ne ) THEN WRITE( out, "( ' * ', 5I7 )" ) G_ind( i: i + 4 ) @@ -1718,9 +1726,10 @@ END SUBROUTINE WRITE_SRESULT SUBROUTINE WRITE_SRESULT2( out, nnz_vector, INDEX_nz_vector, VECTOR, & len_vector, nnz_result, INDEX_nz_result, & RESULT, len_result ) - INTEGER ( KIND = ip_ ) :: len_vector, len_result, out, nnz_vector, nnz_result + INTEGER ( KIND = ip_ ) :: len_vector, len_result, out, nnz_vector, & + nnz_result INTEGER ( KIND = ip_ ), DIMENSION( nnz_vector ) :: INDEX_nz_vector - INTEGER ( KIND = ip_ ), DIMENSION( n ) :: INDEX_nz_result + INTEGER ( KIND = ip_ ), DIMENSION( nnz_result ) :: INDEX_nz_result REAL ( KIND = rp_ ), DIMENSION( len_vector ) :: VECTOR REAL ( KIND = rp_ ), DIMENSION( len_result ) :: RESULT INTEGER ( KIND = ip_ ) :: i, j diff --git a/src/test/utest.F90 b/src/test/utest.F90 index 9d2b895..6deaec3 100644 --- a/src/test/utest.F90 +++ b/src/test/utest.F90 @@ -200,14 +200,14 @@ PROGRAM CUTEST_test_unconstrained_tools byrows = .FALSE. WRITE( out, "( ' Call CUTEST_ueh with byrows = .FALSE.' )" ) - CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' Call CUTEST_ueh with byrows = .TRUE.' )" ) - CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ueh_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & @@ -217,7 +217,7 @@ PROGRAM CUTEST_test_unconstrained_tools byrows = .FALSE. WRITE( out, "( ' Call CUTEST_ugreh with byrows = .FALSE' )" ) - CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) @@ -225,7 +225,7 @@ PROGRAM CUTEST_test_unconstrained_tools HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' Call CUTEST_ugreh with byrows = .TRUE.' )" ) - CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ugreh_r( status, n, X, G, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) @@ -251,7 +251,7 @@ PROGRAM CUTEST_test_unconstrained_tools nnz_vector = 1 ; INDEX_nz_vector( nnz_vector ) = 1 goth = .FALSE. WRITE( out, "( ' Call CUTEST_ushprod with goth = .FALSE.' )" ) - CALL CUTEST_ushprod_r( status, n, goth, X, & + CALL CUTEST_ushprod_r( status, n, goth, X, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO to 900 @@ -260,7 +260,7 @@ PROGRAM CUTEST_test_unconstrained_tools goth = .TRUE. WRITE( out, "( ' Call CUTEST_ushprod with goth = .TRUE.' )" ) - CALL CUTEST_ushprod_r( status, n, goth, X, & + CALL CUTEST_ushprod_r( status, n, goth, X, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT ) IF ( status /= 0 ) GO to 900 diff --git a/src/test/utest_threaded.F90 b/src/test/utest_threaded.F90 index af52146..a8bdeb7 100644 --- a/src/test/utest_threaded.F90 +++ b/src/test/utest_threaded.F90 @@ -72,8 +72,8 @@ PROGRAM CUTEST_test_unconstrained_tools ! set up SIF data WRITE( out, "( ' Call CUTEST_usetup ' )" ) - CALL CUTEST_usetup_threaded_r( status, input, out, threads, BUFFER, & - n, X, X_l, X_u ) + CALL CUTEST_usetup_threaded_r( status, input, out, threads, BUFFER, & + n, X, X_l, X_u ) IF ( status /= 0 ) GO to 900 CALL WRITE_X( out, n, X, X_l, X_u ) @@ -173,16 +173,16 @@ PROGRAM CUTEST_test_unconstrained_tools ! compute the sparse Hessian value WRITE( out, "( ' Call CUTEST_ush' )" ) - CALL CUTEST_ush_threaded_r( status, n, X, H_ne, l_h, H_val, H_row, H_col, & - thread ) + CALL CUTEST_ush_threaded_r( status, n, X, H_ne, l_h, & + H_val, H_row, H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) ! compute the gradient and sparse Hessian values WRITE( out, "( ' Call CUTEST_ugrsh' )" ) - CALL CUTEST_ugrsh_threaded_r( status, n, X, G, H_ne, l_h, H_val, H_row, & - H_col, thread ) + CALL CUTEST_ugrsh_threaded_r( status, n, X, G, H_ne, l_h, H_val, H_row, & + H_col, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_sparse( out, H_ne, l_h, H_val, H_row, H_col ) @@ -206,14 +206,14 @@ PROGRAM CUTEST_test_unconstrained_tools byrows = .FALSE. WRITE( out, "( ' Call CUTEST_ueh with byrows = .FALSE.' )" ) - CALL CUTEST_ueh_threaded_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ueh_threaded_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' Call CUTEST_ueh with byrows = .TRUE.' )" ) - CALL CUTEST_ueh_threaded_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & + CALL CUTEST_ueh_threaded_r( status, n, X, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val, byrows, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & @@ -223,18 +223,18 @@ PROGRAM CUTEST_test_unconstrained_tools byrows = .FALSE. WRITE( out, "( ' Call CUTEST_ugreh with byrows = .FALSE' )" ) - CALL CUTEST_ugreh_threaded_r( status, n, X, G, HE_nel, lhe_ptr, & - HE_row_ptr, HE_val_ptr, lhe_row, & - HE_row, lhe_val, HE_val, byrows, thread ) + CALL CUTEST_ugreh_threaded_r( status, n, X, G, HE_nel, lhe_ptr, & + HE_row_ptr, HE_val_ptr, lhe_row, & + HE_row, lhe_val, HE_val, byrows, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & HE_val_ptr, lhe_row, HE_row, lhe_val, HE_val ) byrows = .TRUE. WRITE( out, "( ' Call CUTEST_ugreh with byrows = .TRUE.' )" ) - CALL CUTEST_ugreh_threaded_r( status, n, X, G, HE_nel, lhe_ptr, & - HE_row_ptr, HE_val_ptr, lhe_row, & - HE_row, lhe_val, HE_val, byrows, thread ) + CALL CUTEST_ugreh_threaded_r( status, n, X, G, HE_nel, lhe_ptr, & + HE_row_ptr, HE_val_ptr, lhe_row, & + HE_row, lhe_val, HE_val, byrows, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_G( out, n, G ) CALL WRITE_H_element( out, HE_nel, lhe_ptr, HE_row_ptr, & @@ -245,12 +245,14 @@ PROGRAM CUTEST_test_unconstrained_tools VECTOR( 1 ) = one ; VECTOR( 2 : n ) = zero goth = .FALSE. WRITE( out, "( ' Call CUTEST_uhprod with goth = .FALSE.' )" ) - CALL CUTEST_uhprod_threaded_r( status, n, goth, X, VECTOR, RESULT, thread ) + CALL CUTEST_uhprod_threaded_r( status, n, goth, X, VECTOR, RESULT, & + thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_RESULT( out, n, VECTOR, RESULT ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_uhprod with goth = .TRUE.' )" ) - CALL CUTEST_uhprod_threaded_r( status, n, goth, X, VECTOR, RESULT, thread ) + CALL CUTEST_uhprod_threaded_r( status, n, goth, X, VECTOR, RESULT, & + thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_RESULT( out, n, VECTOR, RESULT ) @@ -259,7 +261,7 @@ PROGRAM CUTEST_test_unconstrained_tools nnz_vector = 1 ; INDEX_nz_vector( nnz_vector ) = 1 goth = .FALSE. WRITE( out, "( ' Call CUTEST_ushprod with goth = .FALSE.' )" ) - CALL CUTEST_ushprod_threaded_r( status, n, goth, X, & + CALL CUTEST_ushprod_threaded_r( status, n, goth, X, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT, thread ) IF ( status /= 0 ) GO to 900 @@ -268,7 +270,7 @@ PROGRAM CUTEST_test_unconstrained_tools goth = .TRUE. WRITE( out, "( ' Call CUTEST_ushprod with goth = .TRUE.' )" ) - CALL CUTEST_ushprod_threaded_r( status, n, goth, X, & + CALL CUTEST_ushprod_threaded_r( status, n, goth, X, & nnz_vector, INDEX_nz_vector, VECTOR, & nnz_result, INDEX_nz_result, RESULT, thread ) IF ( status /= 0 ) GO to 900 @@ -284,15 +286,15 @@ PROGRAM CUTEST_test_unconstrained_tools goth = .FALSE. WRITE( out, "( ' Call CUTEST_ubandh with goth = .FALSE.' )" ) - CALL CUTEST_ubandh_threaded_r( status, n, X, nsemib, H_band, lbandh, & - maxsbw, thread ) + CALL CUTEST_ubandh_threaded_r( status, n, X, nsemib, H_band, lbandh, & + maxsbw, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_BAND( out, n, lbandh, H_band, nsemib ) ! CALL WRITE_H_BAND( out, n, lbandh, H_band, nsemib, maxsbw ) goth = .TRUE. WRITE( out, "( ' Call CUTEST_ubandh with goth = .TRUE.' )" ) - CALL CUTEST_ubandh_threaded_r( status, n, X, nsemib, H_band, lbandh, & - maxsbw, thread ) + CALL CUTEST_ubandh_threaded_r( status, n, X, nsemib, H_band, lbandh, & + maxsbw, thread ) IF ( status /= 0 ) GO to 900 CALL WRITE_H_BAND( out, n, lbandh, H_band, nsemib ) ! CALL WRITE_H_BAND( out, n, lbandh, H_band, nsemib, maxsbw ) diff --git a/src/tools/cnoobj.F90 b/src/tools/cnoobj.F90 new file mode 100644 index 0000000..68e5dd3 --- /dev/null +++ b/src/tools/cnoobj.F90 @@ -0,0 +1,128 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-10 AT 11:30 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" + +!-*-*-*-*- C U T E S T C I N T_ C N O O B J S U B R O U T I N E -*-*-*- + +! Copyright reserved, Gould/Orban/Toint, for GALAHAD productions +! Principal author: Nick Gould + +! History - +! modern fortran version released in CUTEst, 10th December 2023 + + SUBROUTINE CUTEST_Cint_cnoobj_r( status, input, noobj ) + USE CUTEST_KINDS_precision + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_Bool + +! dummy arguments + + INTEGER ( KIND = ip_ ), INTENT( IN ) :: input + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: status + LOGICAL ( KIND = C_Bool ), INTENT( OUT ) :: noobj + +! -------------------------------------------------- +! Determine if the problem has an objective function +! -------------------------------------------------- + +! local variables + + LOGICAL :: noobj_fortran + + CALL CUTEST_cnoobj_r( status, input, noobj_fortran ) + noobj = noobj_fortran + + RETURN + +! End of subroutine CUTEST_Cint_cnoobj_r + + END SUBROUTINE CUTEST_Cint_cnoobj_r + +!-*-*-*-*-*-*- C U T E S T C N O O B J S U B R O U T I N E -*-*-*-*-*- + +! Copyright reserved, Gould/Orban/Toint, for GALAHAD productions +! Principal author: Nick Gould + +! History - +! modern fortran version released in CUTEst, 10th December 2023 + + SUBROUTINE CUTEST_cnoobj_r( status, input, noobj ) + USE CUTEST_KINDS_precision + +! dummy arguments + + INTEGER ( KIND = ip_ ), INTENT( IN ) :: input + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: status + LOGICAL, INTENT( OUT ) :: noobj + +! -------------------------------------------------- +! Determine if the problem has an objective function +! -------------------------------------------------- + +! local variables + + INTEGER ( KIND = ip_ ) :: ialgor, i, iend, j, n, ng, ng1, nel1, nel + INTEGER ( KIND = ip_ ), DIMENSION( 10 ) :: IARRAY + CHARACTER ( LEN = 8 ) :: pname + +! input the problem dimensions + + REWIND( input ) + READ( input, "( 3I10 )" ) n, ng, nel + +! input the problem type + + READ( input, "( I2, A8 )" ) ialgor, pname + IF ( ialgor < 2 ) THEN + noobj = .FALSE. + +! set useful integer values + + ELSE + ng1 = ng + 1 + nel1 = nel + 1 + +! print out problem data. input the number of variables, groups, elements and +! the identity of the objective function group (i = nslack, j = nobjgr) + + IF ( ialgor == 2 ) READ( input, "( 2I10 )" ) i, j + +! input the starting addresses of the elements in each group, of the +! parameters used for each group and of the nonzeros of the linear element +! in each group + + READ( input, "( ( 10I8 ) )" ) ( iend, i = 1, ng1 ) + READ( input, "( ( 10I8 ) )" ) ( iend, i = 1, ng1 ) + READ( input, "( ( 10I8 ) )" ) ( iend, i = 1, ng1 ) + +! Input the starting addresses of the variables and parameters in each element + + READ( input, "( ( 10I8 ) )" ) ( iend, i = 1, nel1 ) + READ( input, "( ( 10I8 ) )" ) ( iend, i = 1, nel1 ) + +! input the group type of each group + + READ( input, "( ( 10I8 ) )" ) ( iend, i = 1, ng ) + +! count the number of constraint groups + + noobj = .TRUE. + iloop: DO i = 1, ng, 10 + iend = MIN( i + 9, ng ) + READ( input, "( ( 10I8 ) )" ) ( IARRAY( j - i + 1 ), j = i, iend ) + DO j = i, iend + IF ( IARRAY( j - i + 1 ) == 1 ) THEN + noobj = .FALSE. + EXIT iloop + END IF + END DO + END DO iloop + END IF + + REWIND( input ) + status = 0 + RETURN + +! End of subroutine CUTEST_cnoobj_r + + END SUBROUTINE CUTEST_cnoobj_r diff --git a/src/tools/csjprod.F90 b/src/tools/csjprod.F90 index 4d9ed38..6708bab 100644 --- a/src/tools/csjprod.F90 +++ b/src/tools/csjprod.F90 @@ -204,7 +204,8 @@ SUBROUTINE CUTEST_csjprod_threadsafe_r( data, work, status, n, m, & LOGICAL, INTENT( IN ) :: gotj, jtrans INTEGER ( KIND = ip_ ), DIMENSION( nnz_vector ), & INTENT( IN ) :: INDEX_nz_vector - INTEGER ( KIND = ip_ ), DIMENSION( n ), INTENT( OUT ) :: INDEX_nz_result + INTEGER ( KIND = ip_ ), DIMENSION( MAX( m, n ) ), & + INTENT( OUT ) :: INDEX_nz_result REAL ( KIND = rp_ ), INTENT( IN ), DIMENSION( n ) :: X REAL ( KIND = rp_ ), INTENT( IN ), DIMENSION( lvector ) :: VECTOR REAL ( KIND = rp_ ), INTENT( OUT ), DIMENSION( lresult ) :: RESULT diff --git a/src/tools/interface.F90 b/src/tools/interface.F90 index bd89f04..66d496b 100644 --- a/src/tools/interface.F90 +++ b/src/tools/interface.F90 @@ -233,6 +233,13 @@ SUBROUTINE CUTEST_cdimen_r( cutest_status, input, n, m ) INTEGER ( KIND = ip_ ), INTENT( OUT ) :: cutest_status, n, m END SUBROUTINE CUTEST_cdimen_r + SUBROUTINE CUTEST_cnoobj_r( status, input, noobj ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ), INTENT( IN ) :: input + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: status + LOGICAL, INTENT( OUT ) :: noobj + END SUBROUTINE CUTEST_cnoobj_r + SUBROUTINE CUTEST_csetup_r( cutest_status, input, out, io_buffer, & n, m, X, X_l, X_u, & Y, C_l, C_u, EQUATN, LINEAR, & diff --git a/src/tools/kinds.F90 b/src/tools/kinds.F90 index cc89327..f491110 100644 --- a/src/tools/kinds.F90 +++ b/src/tools/kinds.F90 @@ -25,10 +25,11 @@ MODULE CUTEST_KINDS_int USE ISO_C_BINDING USE ISO_FORTRAN_ENV PRIVATE - PUBLIC :: ip_, ipc_ + PUBLIC :: ip_, ipc_, ip_long_ ! Integer kinds (standard 32 bit integer) + INTEGER, PARAMETER :: iplong_ = INT64 INTEGER, PARAMETER :: ip_ = INT32 INTEGER, PARAMETER :: ipc_ = C_INT32_T @@ -41,10 +42,11 @@ MODULE CUTEST_KINDS_long USE ISO_C_BINDING USE ISO_FORTRAN_ENV PRIVATE - PUBLIC :: ip_, ipc_ + PUBLIC :: ip_, ipc_, iplong_ ! Integer kinds (long 64 bit integer) + INTEGER, PARAMETER :: iplong_ = INT64 INTEGER, PARAMETER :: ip_ = INT64 INTEGER, PARAMETER :: ipc_ = C_INT64_T diff --git a/src/tools/makemaster b/src/tools/makemaster index d93c646..4604d88 100644 --- a/src/tools/makemaster +++ b/src/tools/makemaster @@ -1,73 +1,28 @@ # Main body of the installation makefile for basic CUTEST tools packages -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 2023-11-02 +# Nick Gould, for GALAHAD productions +# This version: 2023-11-21 -SHELL = /bin/$(BINSHELL) +# include standard CUTEst makefile defaults before package-specifics -# preprocessing flags +include $(CUTEST)/src/makedefs/defaults -ifeq "$(PRECIS)" "single" - DPREC = -DCUTEST_SINGLE -else - DPREC = -DCUTEST_DOUBLE -endif +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -# compiler flags +# package name -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) \ - $(DPREC) -I $(CUTEST)/include -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) \ - $(DPREC) -I $(CUTEST)/include -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) \ - $(DPREC) -I $(CUTEST)/include -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) \ - $(DPREC) -I $(CUTEST)/include -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) \ - $(DPREC) -I $(CUTEST)/include -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) \ - $(DPREC) -I $(CUTEST)/include +PACKAGE = TOOLS +package = tools -# names of random libraries +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a +# include standard CUTEst makefile definitions -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -LIBS = -lcutest -lcutest_lapack -lcutest_blas -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) +include $(CUTEST)/src/makedefs/definitions # compilation agenda @@ -117,7 +72,8 @@ CCUTESTS = $(LCS)(csetup_single.o) $(LCS)(cdimen_single.o) \ $(LCS)(csgrp_single.o) $(LCS)(csgrshp_single.o) \ $(LCS)(creport_single.o) $(LCS)(connames_single.o) \ $(LCS)(cterminate_single.o) $(LCS)(lqp_single.o) \ - $(LCS)(cconst_single.o) $(LCS)(cnames_single.o) + $(LCS)(cconst_single.o) $(LCS)(cnames_single.o) \ + $(LCS)(cnoobj_single.o) BASICD = $(LCD)(kinds_double.o) $(LCD)(cutest_double.o) \ $(LCD)(pname_double.o) $(LCD)(probname_double.o) \ @@ -165,13 +121,12 @@ CCUTESTD = $(LCD)(csetup_double.o) $(LCD)(cdimen_double.o) \ $(LCD)(csgrp_double.o) $(LCD)(csgrshp_double.o) \ $(LCD)(creport_double.o) $(LCD)(connames_double.o) \ $(LCD)(cterminate_double.o) $(LCD)(lqp_double.o) \ - $(LCD)(cconst_double.o) $(LCD)(cnames_double.o) + $(LCD)(cconst_double.o) $(LCD)(cnames_double.o) \ + $(LCD)(cnoobj_double.o) CUTESTS = $(BASICS) $(UCUTESTS) $(CCUTESTS) CUTESTD = $(BASICD) $(UCUTESTD) $(CCUTESTD) -SUCC = precision version) compiled successfully - # main compilations and runs all: cutest @@ -211,19 +166,7 @@ cutest_constrained_single: $(BASICS) $(CCUTESTS) cutest_constrained_double: $(BASICD) $(CCUTESTD) $(RANLIB) $(LCD) -# blas - -blas_silent: $(BLC)(blas.o) -blas: $(BLC)(blas.o) - @printf ' %-21s\n' "CUTEST: BLAS compiled successfully" - -# lapack - -lapack_silent: $(LLC)(lapack.o) -lapack: $(LLC)(lapack.o) - @printf ' %-21s\n' "CUTEST: LAPACK compiled successfully" - -# run spec-sheet example tests +# run example tests test_cutest: test_cutest_unconstrained test_cutest_constrained test_cutest_unconstrained: cutest @@ -243,9 +186,9 @@ kinds.o: $(LC)(kinds_$(PRECIS).o) $(LC)(kinds_$(PRECIS).o): ../tools/kinds.F90 @printf ' %-9s %-15s\t\t' "Compiling" "kinds" $(CP) ../tools/kinds.F90 $(OBJ)/kinds.F90 - cd $(OBJ); $(FORTRAN) -o kinds_$(PRECIS).o $(FFLAGS) kinds.F90 \ + cd $(OBJ); $(FORTRAN) -o kinds_$(PRECIS).o $(F90FLAGS) kinds.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o kinds_$(PRECIS).o $(FFLAGSN) kinds.F90 ) + $(FORTRAN) -o kinds_$(PRECIS).o $(F90FLAGSN) kinds.F90 ) cd $(OBJ); $(ARR) kinds_$(PRECIS).o; $(RM) kinds.F90 kinds_$(PRECIS).o $(RMARFILE) cutest_$(PRECIS).o $(MVMODS) @@ -257,13 +200,14 @@ $(LC)(cutest_$(PRECIS).o): ../tools/cutest.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cutest" $(CP) ../tools/cutest.F90 $(OBJ)/cutest.F90 # cd $(OBJ); $(FORTRAN) -dM $(DPREC) -I $(CUTEST)/include cutest.F90 - cd $(OBJ); $(FORTRAN) -o cutest_$(PRECIS).o $(FFLAGS) cutest.F90 \ + cd $(OBJ); $(FORTRAN) -o cutest_$(PRECIS).o $(F90FLAGS) cutest.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cutest_$(PRECIS).o $(FFLAGSN) cutest.F90 ) + $(FORTRAN) -o cutest_$(PRECIS).o $(F90FLAGSN) cutest.F90 ) cd $(OBJ); $(ARR) cutest_$(PRECIS).o; \ $(RM) cutest.F90 cutest_$(PRECIS).o $(RMARFILE) csetup_$(PRECIS).o $(RMARFILE) cdimen_$(PRECIS).o + $(RMARFILE) cnoobj_$(PRECIS).o $(RMARFILE) cstats_$(PRECIS).o $(RMARFILE) cdimse_$(PRECIS).o $(RMARFILE) cdimsh_$(PRECIS).o @@ -352,10 +296,10 @@ interface.o: $(LC)(interface_$(PRECIS).o) $(LC)(interface_$(PRECIS).o): ../tools/interface.F90 @printf ' %-9s %-15s\t\t' "Compiling" "interface" $(CP) ../tools/interface.F90 $(OBJ)/interface.F90 - cd $(OBJ); $(FORTRAN) -o interface_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o interface_$(PRECIS).o $(F90FLAGS) \ interface.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o interface_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o interface_$(PRECIS).o $(F90FLAGSN) \ interface.F90 ) cd $(OBJ); $(ARR) interface_$(PRECIS).o; \ $(RM) interface.F90 interface_$(PRECIS).o @@ -367,9 +311,9 @@ csetup.o: $(LC)(csetup_$(PRECIS).o) $(LC)(csetup_$(PRECIS).o): ../tools/csetup.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csetup" $(CP) ../tools/csetup.F90 $(OBJ)/csetup.F90 - cd $(OBJ); $(FORTRAN) -o csetup_$(PRECIS).o $(FFLAGS) csetup.F90 \ + cd $(OBJ); $(FORTRAN) -o csetup_$(PRECIS).o $(F90FLAGS) csetup.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csetup_$(PRECIS).o $(FFLAGSN) csetup.F90 ) + $(FORTRAN) -o csetup_$(PRECIS).o $(F90FLAGSN) csetup.F90 ) cd $(OBJ); $(ARR) csetup_$(PRECIS).o; \ $(RM) csetup.F90 csetup_$(PRECIS).o # $(MVMODS) @@ -380,22 +324,35 @@ cdimen.o: $(LC)(cdimen_$(PRECIS).o) $(LC)(cdimen_$(PRECIS).o): ../tools/cdimen.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimen" $(CP) ../tools/cdimen.F90 $(OBJ)/cdimen.F90 - cd $(OBJ); $(FORTRAN) -o cdimen_$(PRECIS).o $(FFLAGS) cdimen.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimen_$(PRECIS).o $(F90FLAGS) cdimen.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimen_$(PRECIS).o $(FFLAGSN) cdimen.F90 ) + $(FORTRAN) -o cdimen_$(PRECIS).o $(F90FLAGSN) cdimen.F90 ) cd $(OBJ); $(ARR) cdimen_$(PRECIS).o; \ $(RM) cdimen.F90 cdimen_$(PRECIS).o # $(MVMODS) @printf '[ OK ]\n' +cnoobj.o: $(LC)(cnoobj_$(PRECIS).o) + +$(LC)(cnoobj_$(PRECIS).o): ../tools/cnoobj.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "cnoobj" + $(CP) ../tools/cnoobj.F90 $(OBJ)/cnoobj.F90 + cd $(OBJ); $(FORTRAN) -o cnoobj_$(PRECIS).o $(F90FLAGS) cnoobj.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o cnoobj_$(PRECIS).o $(F90FLAGSN) cnoobj.F90 ) + cd $(OBJ); $(ARR) cnoobj_$(PRECIS).o; \ + $(RM) cnoobj.F90 cnoobj_$(PRECIS).o +# $(MVMODS) + @printf '[ OK ]\n' + cstats.o: $(LC)(cstats_$(PRECIS).o) $(LC)(cstats_$(PRECIS).o): ../tools/cstats.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cstats" $(CP) ../tools/cstats.F90 $(OBJ)/cstats.F90 - cd $(OBJ); $(FORTRAN) -o cstats_$(PRECIS).o $(FFLAGS) cstats.F90 \ + cd $(OBJ); $(FORTRAN) -o cstats_$(PRECIS).o $(F90FLAGS) cstats.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cstats_$(PRECIS).o $(FFLAGSN) cstats.F90 ) + $(FORTRAN) -o cstats_$(PRECIS).o $(F90FLAGSN) cstats.F90 ) cd $(OBJ); $(ARR) cstats_$(PRECIS).o; \ $(RM) cstats.F90 cstats_$(PRECIS).o # $(MVMODS) @@ -406,9 +363,9 @@ cdimse.o: $(LC)(cdimse_$(PRECIS).o) $(LC)(cdimse_$(PRECIS).o): ../tools/cdimse.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimse" $(CP) ../tools/cdimse.F90 $(OBJ)/cdimse.F90 - cd $(OBJ); $(FORTRAN) -o cdimse_$(PRECIS).o $(FFLAGS) cdimse.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimse_$(PRECIS).o $(F90FLAGS) cdimse.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimse_$(PRECIS).o $(FFLAGSN) cdimse.F90 ) + $(FORTRAN) -o cdimse_$(PRECIS).o $(F90FLAGSN) cdimse.F90 ) cd $(OBJ); $(ARR) cdimse_$(PRECIS).o; \ $(RM) cdimse.F90 cdimse_$(PRECIS).o # $(MVMODS) @@ -419,9 +376,9 @@ cdimsh.o: $(LC)(cdimsh_$(PRECIS).o) $(LC)(cdimsh_$(PRECIS).o): ../tools/cdimsh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimsh" $(CP) ../tools/cdimsh.F90 $(OBJ)/cdimsh.F90 - cd $(OBJ); $(FORTRAN) -o cdimsh_$(PRECIS).o $(FFLAGS) cdimsh.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimsh_$(PRECIS).o $(F90FLAGS) cdimsh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimsh_$(PRECIS).o $(FFLAGSN) cdimsh.F90 ) + $(FORTRAN) -o cdimsh_$(PRECIS).o $(F90FLAGSN) cdimsh.F90 ) cd $(OBJ); $(ARR) cdimsh_$(PRECIS).o; \ $(RM) cdimsh.F90 cdimsh_$(PRECIS).o # $(MVMODS) @@ -432,9 +389,9 @@ cdimsj.o: $(LC)(cdimsj_$(PRECIS).o) $(LC)(cdimsj_$(PRECIS).o): ../tools/cdimsj.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimsj" $(CP) ../tools/cdimsj.F90 $(OBJ)/cdimsj.F90 - cd $(OBJ); $(FORTRAN) -o cdimsj_$(PRECIS).o $(FFLAGS) cdimsj.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimsj_$(PRECIS).o $(F90FLAGS) cdimsj.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimsj_$(PRECIS).o $(FFLAGSN) cdimsj.F90 ) + $(FORTRAN) -o cdimsj_$(PRECIS).o $(F90FLAGSN) cdimsj.F90 ) cd $(OBJ); $(ARR) cdimsj_$(PRECIS).o; \ $(RM) cdimsj.F90 cdimsj_$(PRECIS).o # $(MVMODS) @@ -445,9 +402,9 @@ cdimchp.o: $(LC)(cdimchp_$(PRECIS).o) $(LC)(cdimchp_$(PRECIS).o): ../tools/cdimchp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimchp" $(CP) ../tools/cdimchp.F90 $(OBJ)/cdimchp.F90 - cd $(OBJ); $(FORTRAN) -o cdimchp_$(PRECIS).o $(FFLAGS) cdimchp.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimchp_$(PRECIS).o $(F90FLAGS) cdimchp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimchp_$(PRECIS).o $(FFLAGSN) cdimchp.F90 ) + $(FORTRAN) -o cdimchp_$(PRECIS).o $(F90FLAGSN) cdimchp.F90 ) cd $(OBJ); $(ARR) cdimchp_$(PRECIS).o; \ $(RM) cdimchp.F90 cdimchp_$(PRECIS).o # $(MVMODS) @@ -458,9 +415,9 @@ cdimohp.o: $(LC)(cdimohp_$(PRECIS).o) $(LC)(cdimohp_$(PRECIS).o): ../tools/cdimohp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimohp" $(CP) ../tools/cdimohp.F90 $(OBJ)/cdimohp.F90 - cd $(OBJ); $(FORTRAN) -o cdimohp_$(PRECIS).o $(FFLAGS) cdimohp.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimohp_$(PRECIS).o $(F90FLAGS) cdimohp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimohp_$(PRECIS).o $(FFLAGSN) cdimohp.F90 ) + $(FORTRAN) -o cdimohp_$(PRECIS).o $(F90FLAGSN) cdimohp.F90 ) cd $(OBJ); $(ARR) cdimohp_$(PRECIS).o; \ $(RM) cdimohp.F90 cdimohp_$(PRECIS).o # $(MVMODS) @@ -471,9 +428,9 @@ cnames.o: $(LC)(cnames_$(PRECIS).o) $(LC)(cnames_$(PRECIS).o): ../tools/cnames.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cnames" $(CP) ../tools/cnames.F90 $(OBJ)/cnames.F90 - cd $(OBJ); $(FORTRAN) -o cnames_$(PRECIS).o $(FFLAGS) cnames.F90 \ + cd $(OBJ); $(FORTRAN) -o cnames_$(PRECIS).o $(F90FLAGS) cnames.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cnames_$(PRECIS).o $(FFLAGSN) cnames.F90 ) + $(FORTRAN) -o cnames_$(PRECIS).o $(F90FLAGSN) cnames.F90 ) cd $(OBJ); $(ARR) cnames_$(PRECIS).o; \ $(RM) cnames.F90 cnames_$(PRECIS).o # $(MVMODS) @@ -484,9 +441,9 @@ cvartype.o: $(LC)(cvartype_$(PRECIS).o) $(LC)(cvartype_$(PRECIS).o): ../tools/cvartype.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cvartype" $(CP) ../tools/cvartype.F90 $(OBJ)/cvartype.F90 - cd $(OBJ); $(FORTRAN) -o cvartype_$(PRECIS).o $(FFLAGS) cvartype.F90 \ + cd $(OBJ); $(FORTRAN) -o cvartype_$(PRECIS).o $(F90FLAGS) cvartype.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cvartype_$(PRECIS).o $(FFLAGSN) cvartype.F90 ) + $(FORTRAN) -o cvartype_$(PRECIS).o $(F90FLAGSN) cvartype.F90 ) cd $(OBJ); $(ARR) cvartype_$(PRECIS).o; \ $(RM) cvartype.F90 cvartype_$(PRECIS).o # $(MVMODS) @@ -497,9 +454,9 @@ cfn.o: $(LC)(cfn_$(PRECIS).o) $(LC)(cfn_$(PRECIS).o): ../tools/cfn.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cfn" $(CP) ../tools/cfn.F90 $(OBJ)/cfn.F90 - cd $(OBJ); $(FORTRAN) -o cfn_$(PRECIS).o $(FFLAGS) cfn.F90 \ + cd $(OBJ); $(FORTRAN) -o cfn_$(PRECIS).o $(F90FLAGS) cfn.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cfn_$(PRECIS).o $(FFLAGSN) cfn.F90 ) + $(FORTRAN) -o cfn_$(PRECIS).o $(F90FLAGSN) cfn.F90 ) cd $(OBJ); $(ARR) cfn_$(PRECIS).o; \ $(RM) cfn.F90 cfn_$(PRECIS).o # $(MVMODS) @@ -510,9 +467,9 @@ cgr.o: $(LC)(cgr_$(PRECIS).o) $(LC)(cgr_$(PRECIS).o): ../tools/cgr.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cgr" $(CP) ../tools/cgr.F90 $(OBJ)/cgr.F90 - cd $(OBJ); $(FORTRAN) -o cgr_$(PRECIS).o $(FFLAGS) cgr.F90 \ + cd $(OBJ); $(FORTRAN) -o cgr_$(PRECIS).o $(F90FLAGS) cgr.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cgr_$(PRECIS).o $(FFLAGSN) cgr.F90 ) + $(FORTRAN) -o cgr_$(PRECIS).o $(F90FLAGSN) cgr.F90 ) cd $(OBJ); $(ARR) cgr_$(PRECIS).o; \ $(RM) cgr.F90 cgr_$(PRECIS).o # $(MVMODS) @@ -523,9 +480,9 @@ cofg.o: $(LC)(cofg_$(PRECIS).o) $(LC)(cofg_$(PRECIS).o): ../tools/cofg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cofg" $(CP) ../tools/cofg.F90 $(OBJ)/cofg.F90 - cd $(OBJ); $(FORTRAN) -o cofg_$(PRECIS).o $(FFLAGS) cofg.F90 \ + cd $(OBJ); $(FORTRAN) -o cofg_$(PRECIS).o $(F90FLAGS) cofg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cofg_$(PRECIS).o $(FFLAGSN) cofg.F90 ) + $(FORTRAN) -o cofg_$(PRECIS).o $(F90FLAGSN) cofg.F90 ) cd $(OBJ); $(ARR) cofg_$(PRECIS).o; \ $(RM) cofg.F90 cofg_$(PRECIS).o # $(MVMODS) @@ -536,9 +493,9 @@ cofsg.o: $(LC)(cofsg_$(PRECIS).o) $(LC)(cofsg_$(PRECIS).o): ../tools/cofsg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cofsg" $(CP) ../tools/cofsg.F90 $(OBJ)/cofsg.F90 - cd $(OBJ); $(FORTRAN) -o cofsg_$(PRECIS).o $(FFLAGS) cofsg.F90 \ + cd $(OBJ); $(FORTRAN) -o cofsg_$(PRECIS).o $(F90FLAGS) cofsg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cofsg_$(PRECIS).o $(FFLAGSN) cofsg.F90 ) + $(FORTRAN) -o cofsg_$(PRECIS).o $(F90FLAGSN) cofsg.F90 ) cd $(OBJ); $(ARR) cofsg_$(PRECIS).o; \ $(RM) cofsg.F90 cofsg_$(PRECIS).o # $(MVMODS) @@ -549,9 +506,9 @@ ccfg.o: $(LC)(ccfg_$(PRECIS).o) $(LC)(ccfg_$(PRECIS).o): ../tools/ccfg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ccfg" $(CP) ../tools/ccfg.F90 $(OBJ)/ccfg.F90 - cd $(OBJ); $(FORTRAN) -o ccfg_$(PRECIS).o $(FFLAGS) ccfg.F90 \ + cd $(OBJ); $(FORTRAN) -o ccfg_$(PRECIS).o $(F90FLAGS) ccfg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ccfg_$(PRECIS).o $(FFLAGSN) ccfg.F90 ) + $(FORTRAN) -o ccfg_$(PRECIS).o $(F90FLAGSN) ccfg.F90 ) cd $(OBJ); $(ARR) ccfg_$(PRECIS).o; \ $(RM) ccfg.F90 ccfg_$(PRECIS).o # $(MVMODS) @@ -562,9 +519,9 @@ ccfsg.o: $(LC)(ccfsg_$(PRECIS).o) $(LC)(ccfsg_$(PRECIS).o): ../tools/ccfsg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ccfsg" $(CP) ../tools/ccfsg.F90 $(OBJ)/ccfsg.F90 - cd $(OBJ); $(FORTRAN) -o ccfsg_$(PRECIS).o $(FFLAGS) ccfsg.F90 \ + cd $(OBJ); $(FORTRAN) -o ccfsg_$(PRECIS).o $(F90FLAGS) ccfsg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ccfsg_$(PRECIS).o $(FFLAGSN) ccfsg.F90 ) + $(FORTRAN) -o ccfsg_$(PRECIS).o $(F90FLAGSN) ccfsg.F90 ) cd $(OBJ); $(ARR) ccfsg_$(PRECIS).o; \ $(RM) ccfsg.F90 ccfsg_$(PRECIS).o # $(MVMODS) @@ -575,9 +532,9 @@ clfg.o: $(LC)(clfg_$(PRECIS).o) $(LC)(clfg_$(PRECIS).o): ../tools/clfg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "clfg" $(CP) ../tools/clfg.F90 $(OBJ)/clfg.F90 - cd $(OBJ); $(FORTRAN) -o clfg_$(PRECIS).o $(FFLAGS) clfg.F90 \ + cd $(OBJ); $(FORTRAN) -o clfg_$(PRECIS).o $(F90FLAGS) clfg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o clfg_$(PRECIS).o $(FFLAGSN) clfg.F90 ) + $(FORTRAN) -o clfg_$(PRECIS).o $(F90FLAGSN) clfg.F90 ) cd $(OBJ); $(ARR) clfg_$(PRECIS).o; \ $(RM) clfg.F90 clfg_$(PRECIS).o # $(MVMODS) @@ -588,9 +545,9 @@ ccifg.o: $(LC)(ccifg_$(PRECIS).o) $(LC)(ccifg_$(PRECIS).o): ../tools/ccifg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ccifg" $(CP) ../tools/ccifg.F90 $(OBJ)/ccifg.F90 - cd $(OBJ); $(FORTRAN) -o ccifg_$(PRECIS).o $(FFLAGS) ccifg.F90 \ + cd $(OBJ); $(FORTRAN) -o ccifg_$(PRECIS).o $(F90FLAGS) ccifg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ccifg_$(PRECIS).o $(FFLAGSN) ccifg.F90 ) + $(FORTRAN) -o ccifg_$(PRECIS).o $(F90FLAGSN) ccifg.F90 ) cd $(OBJ); $(ARR) ccifg_$(PRECIS).o; \ $(RM) ccifg.F90 ccifg_$(PRECIS).o # $(MVMODS) @@ -601,9 +558,9 @@ ccifsg.o: $(LC)(ccifsg_$(PRECIS).o) $(LC)(ccifsg_$(PRECIS).o): ../tools/ccifsg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ccifsg" $(CP) ../tools/ccifsg.F90 $(OBJ)/ccifsg.F90 - cd $(OBJ); $(FORTRAN) -o ccifsg_$(PRECIS).o $(FFLAGS) ccifsg.F90 \ + cd $(OBJ); $(FORTRAN) -o ccifsg_$(PRECIS).o $(F90FLAGS) ccifsg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ccifsg_$(PRECIS).o $(FFLAGSN) ccifsg.F90 ) + $(FORTRAN) -o ccifsg_$(PRECIS).o $(F90FLAGSN) ccifsg.F90 ) cd $(OBJ); $(ARR) ccifsg_$(PRECIS).o; \ $(RM) ccifsg.F90 ccifsg_$(PRECIS).o # $(MVMODS) @@ -614,9 +571,9 @@ cdh.o: $(LC)(cdh_$(PRECIS).o) $(LC)(cdh_$(PRECIS).o): ../tools/cdh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdh" $(CP) ../tools/cdh.F90 $(OBJ)/cdh.F90 - cd $(OBJ); $(FORTRAN) -o cdh_$(PRECIS).o $(FFLAGS) cdh.F90 \ + cd $(OBJ); $(FORTRAN) -o cdh_$(PRECIS).o $(F90FLAGS) cdh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdh_$(PRECIS).o $(FFLAGSN) cdh.F90 ) + $(FORTRAN) -o cdh_$(PRECIS).o $(F90FLAGSN) cdh.F90 ) cd $(OBJ); $(ARR) cdh_$(PRECIS).o; \ $(RM) cdh.F90 cdh_$(PRECIS).o # $(MVMODS) @@ -627,9 +584,9 @@ cdhc.o: $(LC)(cdhc_$(PRECIS).o) $(LC)(cdhc_$(PRECIS).o): ../tools/cdhc.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdhc" $(CP) ../tools/cdhc.F90 $(OBJ)/cdhc.F90 - cd $(OBJ); $(FORTRAN) -o cdhc_$(PRECIS).o $(FFLAGS) cdhc.F90 \ + cd $(OBJ); $(FORTRAN) -o cdhc_$(PRECIS).o $(F90FLAGS) cdhc.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdhc_$(PRECIS).o $(FFLAGSN) cdhc.F90 ) + $(FORTRAN) -o cdhc_$(PRECIS).o $(F90FLAGSN) cdhc.F90 ) cd $(OBJ); $(ARR) cdhc_$(PRECIS).o; \ $(RM) cdhc.F90 cdhc_$(PRECIS).o # $(MVMODS) @@ -640,9 +597,9 @@ ceh.o: $(LC)(ceh_$(PRECIS).o) $(LC)(ceh_$(PRECIS).o): ../tools/ceh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ceh" $(CP) ../tools/ceh.F90 $(OBJ)/ceh.F90 - cd $(OBJ); $(FORTRAN) -o ceh_$(PRECIS).o $(FFLAGS) ceh.F90 \ + cd $(OBJ); $(FORTRAN) -o ceh_$(PRECIS).o $(F90FLAGS) ceh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ceh_$(PRECIS).o $(FFLAGSN) ceh.F90 ) + $(FORTRAN) -o ceh_$(PRECIS).o $(F90FLAGSN) ceh.F90 ) cd $(OBJ); $(ARR) ceh_$(PRECIS).o; \ $(RM) ceh.F90 ceh_$(PRECIS).o # $(MVMODS) @@ -653,9 +610,9 @@ cgrdh.o: $(LC)(cgrdh_$(PRECIS).o) $(LC)(cgrdh_$(PRECIS).o): ../tools/cgrdh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cgrdh" $(CP) ../tools/cgrdh.F90 $(OBJ)/cgrdh.F90 - cd $(OBJ); $(FORTRAN) -o cgrdh_$(PRECIS).o $(FFLAGS) cgrdh.F90 \ + cd $(OBJ); $(FORTRAN) -o cgrdh_$(PRECIS).o $(F90FLAGS) cgrdh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cgrdh_$(PRECIS).o $(FFLAGSN) cgrdh.F90 ) + $(FORTRAN) -o cgrdh_$(PRECIS).o $(F90FLAGSN) cgrdh.F90 ) cd $(OBJ); $(ARR) cgrdh_$(PRECIS).o; \ $(RM) cgrdh.F90 cgrdh_$(PRECIS).o # $(MVMODS) @@ -666,9 +623,9 @@ cifn.o: $(LC)(cifn_$(PRECIS).o) $(LC)(cifn_$(PRECIS).o): ../tools/cifn.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cifn" $(CP) ../tools/cifn.F90 $(OBJ)/cifn.F90 - cd $(OBJ); $(FORTRAN) -o cifn_$(PRECIS).o $(FFLAGS) cifn.F90 \ + cd $(OBJ); $(FORTRAN) -o cifn_$(PRECIS).o $(F90FLAGS) cifn.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cifn_$(PRECIS).o $(FFLAGSN) cifn.F90 ) + $(FORTRAN) -o cifn_$(PRECIS).o $(F90FLAGSN) cifn.F90 ) cd $(OBJ); $(ARR) cifn_$(PRECIS).o; \ $(RM) cifn.F90 cifn_$(PRECIS).o # $(MVMODS) @@ -679,9 +636,9 @@ cigr.o: $(LC)(cigr_$(PRECIS).o) $(LC)(cigr_$(PRECIS).o): ../tools/cigr.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cigr" $(CP) ../tools/cigr.F90 $(OBJ)/cigr.F90 - cd $(OBJ); $(FORTRAN) -o cigr_$(PRECIS).o $(FFLAGS) cigr.F90 \ + cd $(OBJ); $(FORTRAN) -o cigr_$(PRECIS).o $(F90FLAGS) cigr.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cigr_$(PRECIS).o $(FFLAGSN) cigr.F90 ) + $(FORTRAN) -o cigr_$(PRECIS).o $(F90FLAGSN) cigr.F90 ) cd $(OBJ); $(ARR) cigr_$(PRECIS).o; \ $(RM) cigr.F90 cigr_$(PRECIS).o # $(MVMODS) @@ -692,9 +649,9 @@ cdimsg.o: $(LC)(cdimsg_$(PRECIS).o) $(LC)(cdimsg_$(PRECIS).o): ../tools/cdimsg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cdimsg" $(CP) ../tools/cdimsg.F90 $(OBJ)/cdimsg.F90 - cd $(OBJ); $(FORTRAN) -o cdimsg_$(PRECIS).o $(FFLAGS) cdimsg.F90 \ + cd $(OBJ); $(FORTRAN) -o cdimsg_$(PRECIS).o $(F90FLAGS) cdimsg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cdimsg_$(PRECIS).o $(FFLAGSN) cdimsg.F90 ) + $(FORTRAN) -o cdimsg_$(PRECIS).o $(F90FLAGSN) cdimsg.F90 ) cd $(OBJ); $(ARR) cdimsg_$(PRECIS).o; \ $(RM) cdimsg.F90 cdimsg_$(PRECIS).o # $(MVMODS) @@ -705,9 +662,9 @@ cisgr.o: $(LC)(cisgr_$(PRECIS).o) $(LC)(cisgr_$(PRECIS).o): ../tools/cisgr.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cisgr" $(CP) ../tools/cisgr.F90 $(OBJ)/cisgr.F90 - cd $(OBJ); $(FORTRAN) -o cisgr_$(PRECIS).o $(FFLAGS) cisgr.F90 \ + cd $(OBJ); $(FORTRAN) -o cisgr_$(PRECIS).o $(F90FLAGS) cisgr.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cisgr_$(PRECIS).o $(FFLAGSN) cisgr.F90 ) + $(FORTRAN) -o cisgr_$(PRECIS).o $(F90FLAGSN) cisgr.F90 ) cd $(OBJ); $(ARR) cisgr_$(PRECIS).o; \ $(RM) cisgr.F90 cisgr_$(PRECIS).o # $(MVMODS) @@ -718,9 +675,9 @@ cisgrp.o: $(LC)(cisgrp_$(PRECIS).o) $(LC)(cisgrp_$(PRECIS).o): ../tools/cisgrp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cisgrp" $(CP) ../tools/cisgrp.F90 $(OBJ)/cisgrp.F90 - cd $(OBJ); $(FORTRAN) -o cisgrp_$(PRECIS).o $(FFLAGS) cisgrp.F90 \ + cd $(OBJ); $(FORTRAN) -o cisgrp_$(PRECIS).o $(F90FLAGS) cisgrp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cisgrp_$(PRECIS).o $(FFLAGSN) cisgrp.F90 ) + $(FORTRAN) -o cisgrp_$(PRECIS).o $(F90FLAGSN) cisgrp.F90 ) cd $(OBJ); $(ARR) cisgrp_$(PRECIS).o; \ $(RM) cisgrp.F90 cisgrp_$(PRECIS).o # $(MVMODS) @@ -731,9 +688,9 @@ cidh.o: $(LC)(cidh_$(PRECIS).o) $(LC)(cidh_$(PRECIS).o): ../tools/cidh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cidh" $(CP) ../tools/cidh.F90 $(OBJ)/cidh.F90 - cd $(OBJ); $(FORTRAN) -o cidh_$(PRECIS).o $(FFLAGS) cidh.F90 \ + cd $(OBJ); $(FORTRAN) -o cidh_$(PRECIS).o $(F90FLAGS) cidh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cidh_$(PRECIS).o $(FFLAGSN) cidh.F90 ) + $(FORTRAN) -o cidh_$(PRECIS).o $(F90FLAGSN) cidh.F90 ) cd $(OBJ); $(ARR) cidh_$(PRECIS).o; \ $(RM) cidh.F90 cidh_$(PRECIS).o # $(MVMODS) @@ -744,9 +701,9 @@ csh.o: $(LC)(csh_$(PRECIS).o) $(LC)(csh_$(PRECIS).o): ../tools/csh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csh" $(CP) ../tools/csh.F90 $(OBJ)/csh.F90 - cd $(OBJ); $(FORTRAN) -o csh_$(PRECIS).o $(FFLAGS) csh.F90 \ + cd $(OBJ); $(FORTRAN) -o csh_$(PRECIS).o $(F90FLAGS) csh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csh_$(PRECIS).o $(FFLAGSN) csh.F90 ) + $(FORTRAN) -o csh_$(PRECIS).o $(F90FLAGSN) csh.F90 ) cd $(OBJ); $(ARR) csh_$(PRECIS).o; \ $(RM) csh.F90 csh_$(PRECIS).o # $(MVMODS) @@ -757,9 +714,9 @@ cshc.o: $(LC)(cshc_$(PRECIS).o) $(LC)(cshc_$(PRECIS).o): ../tools/cshc.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cshc" $(CP) ../tools/cshc.F90 $(OBJ)/cshc.F90 - cd $(OBJ); $(FORTRAN) -o cshc_$(PRECIS).o $(FFLAGS) cshc.F90 \ + cd $(OBJ); $(FORTRAN) -o cshc_$(PRECIS).o $(F90FLAGS) cshc.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cshc_$(PRECIS).o $(FFLAGSN) cshc.F90 ) + $(FORTRAN) -o cshc_$(PRECIS).o $(F90FLAGSN) cshc.F90 ) cd $(OBJ); $(ARR) cshc_$(PRECIS).o; \ $(RM) cshc.F90 cshc_$(PRECIS).o # $(MVMODS) @@ -770,9 +727,9 @@ cshj.o: $(LC)(cshj_$(PRECIS).o) $(LC)(cshj_$(PRECIS).o): ../tools/cshj.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cshj" $(CP) ../tools/cshj.F90 $(OBJ)/cshj.F90 - cd $(OBJ); $(FORTRAN) -o cshj_$(PRECIS).o $(FFLAGS) cshj.F90 \ + cd $(OBJ); $(FORTRAN) -o cshj_$(PRECIS).o $(F90FLAGS) cshj.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cshj_$(PRECIS).o $(FFLAGSN) cshj.F90 ) + $(FORTRAN) -o cshj_$(PRECIS).o $(F90FLAGSN) cshj.F90 ) cd $(OBJ); $(ARR) cshj_$(PRECIS).o; \ $(RM) cshj.F90 cshj_$(PRECIS).o # $(MVMODS) @@ -783,9 +740,9 @@ cshp.o: $(LC)(cshp_$(PRECIS).o) $(LC)(cshp_$(PRECIS).o): ../tools/cshp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cshp" $(CP) ../tools/cshp.F90 $(OBJ)/cshp.F90 - cd $(OBJ); $(FORTRAN) -o cshp_$(PRECIS).o $(FFLAGS) cshp.F90 \ + cd $(OBJ); $(FORTRAN) -o cshp_$(PRECIS).o $(F90FLAGS) cshp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cshp_$(PRECIS).o $(FFLAGSN) cshp.F90 ) + $(FORTRAN) -o cshp_$(PRECIS).o $(F90FLAGSN) cshp.F90 ) cd $(OBJ); $(ARR) cshp_$(PRECIS).o; \ $(RM) cshp.F90 cshp_$(PRECIS).o # $(MVMODS) @@ -796,9 +753,9 @@ cish.o: $(LC)(cish_$(PRECIS).o) $(LC)(cish_$(PRECIS).o): ../tools/cish.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cish" $(CP) ../tools/cish.F90 $(OBJ)/cish.F90 - cd $(OBJ); $(FORTRAN) -o cish_$(PRECIS).o $(FFLAGS) cish.F90 \ + cd $(OBJ); $(FORTRAN) -o cish_$(PRECIS).o $(F90FLAGS) cish.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cish_$(PRECIS).o $(FFLAGSN) cish.F90 ) + $(FORTRAN) -o cish_$(PRECIS).o $(F90FLAGSN) cish.F90 ) cd $(OBJ); $(ARR) cish_$(PRECIS).o; \ $(RM) cish.F90 cish_$(PRECIS).o # $(MVMODS) @@ -809,9 +766,9 @@ cjprod.o: $(LC)(cjprod_$(PRECIS).o) $(LC)(cjprod_$(PRECIS).o): ../tools/cjprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cjprod" $(CP) ../tools/cjprod.F90 $(OBJ)/cjprod.F90 - cd $(OBJ); $(FORTRAN) -o cjprod_$(PRECIS).o $(FFLAGS) cjprod.F90 \ + cd $(OBJ); $(FORTRAN) -o cjprod_$(PRECIS).o $(F90FLAGS) cjprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cjprod_$(PRECIS).o $(FFLAGSN) cjprod.F90 ) + $(FORTRAN) -o cjprod_$(PRECIS).o $(F90FLAGSN) cjprod.F90 ) cd $(OBJ); $(ARR) cjprod_$(PRECIS).o; \ $(RM) cjprod.F90 cjprod_$(PRECIS).o # $(MVMODS) @@ -822,9 +779,9 @@ csjprod.o: $(LC)(csjprod_$(PRECIS).o) $(LC)(csjprod_$(PRECIS).o): ../tools/csjprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csjprod" $(CP) ../tools/csjprod.F90 $(OBJ)/csjprod.F90 - cd $(OBJ); $(FORTRAN) -o csjprod_$(PRECIS).o $(FFLAGS) csjprod.F90 \ + cd $(OBJ); $(FORTRAN) -o csjprod_$(PRECIS).o $(F90FLAGS) csjprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csjprod_$(PRECIS).o $(FFLAGSN) csjprod.F90 ) + $(FORTRAN) -o csjprod_$(PRECIS).o $(F90FLAGSN) csjprod.F90 ) cd $(OBJ); $(ARR) csjprod_$(PRECIS).o; \ $(RM) csjprod.F90 csjprod_$(PRECIS).o # $(MVMODS) @@ -835,9 +792,9 @@ csgr.o: $(LC)(csgr_$(PRECIS).o) $(LC)(csgr_$(PRECIS).o): ../tools/csgr.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csgr" $(CP) ../tools/csgr.F90 $(OBJ)/csgr.F90 - cd $(OBJ); $(FORTRAN) -o csgr_$(PRECIS).o $(FFLAGS) csgr.F90 \ + cd $(OBJ); $(FORTRAN) -o csgr_$(PRECIS).o $(F90FLAGS) csgr.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csgr_$(PRECIS).o $(FFLAGSN) csgr.F90 ) + $(FORTRAN) -o csgr_$(PRECIS).o $(F90FLAGSN) csgr.F90 ) cd $(OBJ); $(ARR) csgr_$(PRECIS).o; \ $(RM) csgr.F90 csgr_$(PRECIS).o # $(MVMODS) @@ -848,9 +805,9 @@ csjp.o: $(LC)(csjp_$(PRECIS).o) $(LC)(csjp_$(PRECIS).o): ../tools/csjp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csjp" $(CP) ../tools/csjp.F90 $(OBJ)/csjp.F90 - cd $(OBJ); $(FORTRAN) -o csjp_$(PRECIS).o $(FFLAGS) csjp.F90 \ + cd $(OBJ); $(FORTRAN) -o csjp_$(PRECIS).o $(F90FLAGS) csjp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csjp_$(PRECIS).o $(FFLAGSN) csjp.F90 ) + $(FORTRAN) -o csjp_$(PRECIS).o $(F90FLAGSN) csjp.F90 ) cd $(OBJ); $(ARR) csjp_$(PRECIS).o; \ $(RM) csjp.F90 csjp_$(PRECIS).o # $(MVMODS) @@ -861,9 +818,9 @@ csgrp.o: $(LC)(csgrp_$(PRECIS).o) $(LC)(csgrp_$(PRECIS).o): ../tools/csgrp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csgrp" $(CP) ../tools/csgrp.F90 $(OBJ)/csgrp.F90 - cd $(OBJ); $(FORTRAN) -o csgrp_$(PRECIS).o $(FFLAGS) csgrp.F90 \ + cd $(OBJ); $(FORTRAN) -o csgrp_$(PRECIS).o $(F90FLAGS) csgrp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csgrp_$(PRECIS).o $(FFLAGSN) csgrp.F90 ) + $(FORTRAN) -o csgrp_$(PRECIS).o $(F90FLAGSN) csgrp.F90 ) cd $(OBJ); $(ARR) csgrp_$(PRECIS).o; \ $(RM) csgrp.F90 csgrp_$(PRECIS).o # $(MVMODS) @@ -874,9 +831,9 @@ csgreh.o: $(LC)(csgreh_$(PRECIS).o) $(LC)(csgreh_$(PRECIS).o): ../tools/csgreh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csgreh" $(CP) ../tools/csgreh.F90 $(OBJ)/csgreh.F90 - cd $(OBJ); $(FORTRAN) -o csgreh_$(PRECIS).o $(FFLAGS) csgreh.F90 \ + cd $(OBJ); $(FORTRAN) -o csgreh_$(PRECIS).o $(F90FLAGS) csgreh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csgreh_$(PRECIS).o $(FFLAGSN) csgreh.F90 ) + $(FORTRAN) -o csgreh_$(PRECIS).o $(F90FLAGSN) csgreh.F90 ) cd $(OBJ); $(ARR) csgreh_$(PRECIS).o; \ $(RM) csgreh.F90 csgreh_$(PRECIS).o # $(MVMODS) @@ -887,9 +844,9 @@ csgrsh.o: $(LC)(csgrsh_$(PRECIS).o) $(LC)(csgrsh_$(PRECIS).o): ../tools/csgrsh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csgrsh" $(CP) ../tools/csgrsh.F90 $(OBJ)/csgrsh.F90 - cd $(OBJ); $(FORTRAN) -o csgrsh_$(PRECIS).o $(FFLAGS) csgrsh.F90 \ + cd $(OBJ); $(FORTRAN) -o csgrsh_$(PRECIS).o $(F90FLAGS) csgrsh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csgrsh_$(PRECIS).o $(FFLAGSN) csgrsh.F90 ) + $(FORTRAN) -o csgrsh_$(PRECIS).o $(F90FLAGSN) csgrsh.F90 ) cd $(OBJ); $(ARR) csgrsh_$(PRECIS).o; \ $(RM) csgrsh.F90 csgrsh_$(PRECIS).o # $(MVMODS) @@ -901,10 +858,10 @@ $(LC)(csgrshp_$(PRECIS).o): ../tools/csgrshp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "csgrshp" $(CP) ../tools/csgrshp.F90 \ $(OBJ)/csgrshp.F90 - cd $(OBJ); $(FORTRAN) -o csgrshp_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o csgrshp_$(PRECIS).o $(F90FLAGS) \ csgrshp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o csgrshp_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o csgrshp_$(PRECIS).o $(F90FLAGSN) \ csgrshp.F90 ) cd $(OBJ); $(ARR) csgrshp_$(PRECIS).o; \ $(RM) csgrshp.F90 csgrshp_$(PRECIS).o @@ -916,9 +873,9 @@ chprod.o: $(LC)(chprod_$(PRECIS).o) $(LC)(chprod_$(PRECIS).o): ../tools/chprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "chprod" $(CP) ../tools/chprod.F90 $(OBJ)/chprod.F90 - cd $(OBJ); $(FORTRAN) -o chprod_$(PRECIS).o $(FFLAGS) chprod.F90 \ + cd $(OBJ); $(FORTRAN) -o chprod_$(PRECIS).o $(F90FLAGS) chprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o chprod_$(PRECIS).o $(FFLAGSN) chprod.F90 ) + $(FORTRAN) -o chprod_$(PRECIS).o $(F90FLAGSN) chprod.F90 ) cd $(OBJ); $(ARR) chprod_$(PRECIS).o; \ $(RM) chprod.F90 chprod_$(PRECIS).o # $(MVMODS) @@ -929,9 +886,9 @@ chjprod.o: $(LC)(chjprod_$(PRECIS).o) $(LC)(chjprod_$(PRECIS).o): ../tools/chjprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "chjprod" $(CP) ../tools/chjprod.F90 $(OBJ)/chjprod.F90 - cd $(OBJ); $(FORTRAN) -o chjprod_$(PRECIS).o $(FFLAGS) chjprod.F90 \ + cd $(OBJ); $(FORTRAN) -o chjprod_$(PRECIS).o $(F90FLAGS) chjprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o chjprod_$(PRECIS).o $(FFLAGSN) chjprod.F90 ) + $(FORTRAN) -o chjprod_$(PRECIS).o $(F90FLAGSN) chjprod.F90 ) cd $(OBJ); $(ARR) chjprod_$(PRECIS).o; \ $(RM) chjprod.F90 chjprod_$(PRECIS).o # $(MVMODS) @@ -942,9 +899,9 @@ chcprod.o: $(LC)(chcprod_$(PRECIS).o) $(LC)(chcprod_$(PRECIS).o): ../tools/chcprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "chcprod" $(CP) ../tools/chcprod.F90 $(OBJ)/chcprod.F90 - cd $(OBJ); $(FORTRAN) -o chcprod_$(PRECIS).o $(FFLAGS) chcprod.F90 \ + cd $(OBJ); $(FORTRAN) -o chcprod_$(PRECIS).o $(F90FLAGS) chcprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o chcprod_$(PRECIS).o $(FFLAGSN) chcprod.F90 ) + $(FORTRAN) -o chcprod_$(PRECIS).o $(F90FLAGSN) chcprod.F90 ) cd $(OBJ); $(ARR) chcprod_$(PRECIS).o; \ $(RM) chcprod.F90 chcprod_$(PRECIS).o # $(MVMODS) @@ -955,9 +912,9 @@ cshprod.o: $(LC)(cshprod_$(PRECIS).o) $(LC)(cshprod_$(PRECIS).o): ../tools/cshprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cshprod" $(CP) ../tools/cshprod.F90 $(OBJ)/cshprod.F90 - cd $(OBJ); $(FORTRAN) -o cshprod_$(PRECIS).o $(FFLAGS) cshprod.F90 \ + cd $(OBJ); $(FORTRAN) -o cshprod_$(PRECIS).o $(F90FLAGS) cshprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cshprod_$(PRECIS).o $(FFLAGSN) cshprod.F90 ) + $(FORTRAN) -o cshprod_$(PRECIS).o $(F90FLAGSN) cshprod.F90 ) cd $(OBJ); $(ARR) cshprod_$(PRECIS).o; \ $(RM) cshprod.F90 cshprod_$(PRECIS).o # $(MVMODS) @@ -968,9 +925,9 @@ cshcprod.o: $(LC)(cshcprod_$(PRECIS).o) $(LC)(cshcprod_$(PRECIS).o): ../tools/cshcprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cshcprod" $(CP) ../tools/cshcprod.F90 $(OBJ)/cshcprod.F90 - cd $(OBJ); $(FORTRAN) -o cshcprod_$(PRECIS).o $(FFLAGS) cshcprod.F90 \ + cd $(OBJ); $(FORTRAN) -o cshcprod_$(PRECIS).o $(F90FLAGS) cshcprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cshcprod_$(PRECIS).o $(FFLAGSN) cshcprod.F90 ) + $(FORTRAN) -o cshcprod_$(PRECIS).o $(F90FLAGSN) cshcprod.F90 ) cd $(OBJ); $(ARR) cshcprod_$(PRECIS).o; \ $(RM) cshcprod.F90 cshcprod_$(PRECIS).o # $(MVMODS) @@ -982,9 +939,9 @@ $(LC)(cohprodsp_$(PRECIS).o): ../tools/cohprodsp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cohprodsp" $(CP) ../tools/cohprodsp.F90 \ $(OBJ)/cohprodsp.F90 - cd $(OBJ); $(FORTRAN) -o cohprodsp_$(PRECIS).o $(FFLAGS) cohprodsp.F90 \ + cd $(OBJ); $(FORTRAN) -o cohprodsp_$(PRECIS).o $(F90FLAGS) cohprodsp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cohprodsp_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o cohprodsp_$(PRECIS).o $(F90FLAGSN) \ cohprodsp.F90 ) cd $(OBJ); $(ARR) cohprodsp_$(PRECIS).o; \ $(RM) cohprodsp.F90 cohprodsp_$(PRECIS).o @@ -996,9 +953,9 @@ cohprods.o: $(LC)(cohprods_$(PRECIS).o) $(LC)(cohprods_$(PRECIS).o): ../tools/cohprods.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cohprods" $(CP) ../tools/cohprods.F90 $(OBJ)/cohprods.F90 - cd $(OBJ); $(FORTRAN) -o cohprods_$(PRECIS).o $(FFLAGS) cohprods.F90 \ + cd $(OBJ); $(FORTRAN) -o cohprods_$(PRECIS).o $(F90FLAGS) cohprods.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cohprods_$(PRECIS).o $(FFLAGSN) cohprods.F90 ) + $(FORTRAN) -o cohprods_$(PRECIS).o $(F90FLAGSN) cohprods.F90 ) cd $(OBJ); $(ARR) cohprods_$(PRECIS).o; \ $(RM) cohprods.F90 cohprods_$(PRECIS).o # $(MVMODS) @@ -1010,9 +967,9 @@ $(LC)(cchprodsp_$(PRECIS).o): ../tools/cchprodsp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cchprodsp" $(CP) ../tools/cchprodsp.F90 \ $(OBJ)/cchprodsp.F90 - cd $(OBJ); $(FORTRAN) -o cchprodsp_$(PRECIS).o $(FFLAGS) cchprodsp.F90 \ + cd $(OBJ); $(FORTRAN) -o cchprodsp_$(PRECIS).o $(F90FLAGS) cchprodsp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cchprodsp_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o cchprodsp_$(PRECIS).o $(F90FLAGSN) \ cchprodsp.F90 ) cd $(OBJ); $(ARR) cchprodsp_$(PRECIS).o; \ $(RM) cchprodsp.F90 cchprodsp_$(PRECIS).o @@ -1024,9 +981,9 @@ cchprods.o: $(LC)(cchprods_$(PRECIS).o) $(LC)(cchprods_$(PRECIS).o): ../tools/cchprods.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cchprods" $(CP) ../tools/cchprods.F90 $(OBJ)/cchprods.F90 - cd $(OBJ); $(FORTRAN) -o cchprods_$(PRECIS).o $(FFLAGS) cchprods.F90 \ + cd $(OBJ); $(FORTRAN) -o cchprods_$(PRECIS).o $(F90FLAGS) cchprods.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cchprods_$(PRECIS).o $(FFLAGSN) cchprods.F90 ) + $(FORTRAN) -o cchprods_$(PRECIS).o $(F90FLAGSN) cchprods.F90 ) cd $(OBJ); $(ARR) cchprods_$(PRECIS).o; \ $(RM) cchprods.F90 cchprods_$(PRECIS).o # $(MVMODS) @@ -1037,9 +994,9 @@ cconst.o: $(LC)(cconst_$(PRECIS).o) $(LC)(cconst_$(PRECIS).o): ../tools/cconst.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cconst" $(CP) ../tools/cconst.F90 $(OBJ)/cconst.F90 - cd $(OBJ); $(FORTRAN) -o cconst_$(PRECIS).o $(FFLAGS) cconst.F90 \ + cd $(OBJ); $(FORTRAN) -o cconst_$(PRECIS).o $(F90FLAGS) cconst.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cconst_$(PRECIS).o $(FFLAGSN) cconst.F90 ) + $(FORTRAN) -o cconst_$(PRECIS).o $(F90FLAGSN) cconst.F90 ) cd $(OBJ); $(ARR) cconst_$(PRECIS).o; \ $(RM) cconst.F90 cconst_$(PRECIS).o # $(MVMODS) @@ -1050,9 +1007,9 @@ creport.o: $(LC)(creport_$(PRECIS).o) $(LC)(creport_$(PRECIS).o): ../tools/creport.F90 @printf ' %-9s %-15s\t\t' "Compiling" "creport" $(CP) ../tools/creport.F90 $(OBJ)/creport.F90 - cd $(OBJ); $(FORTRAN) -o creport_$(PRECIS).o $(FFLAGS) creport.F90 \ + cd $(OBJ); $(FORTRAN) -o creport_$(PRECIS).o $(F90FLAGS) creport.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o creport_$(PRECIS).o $(FFLAGSN) creport.F90 ) + $(FORTRAN) -o creport_$(PRECIS).o $(F90FLAGSN) creport.F90 ) cd $(OBJ); $(ARR) creport_$(PRECIS).o; \ $(RM) creport.F90 creport_$(PRECIS).o # $(MVMODS) @@ -1063,10 +1020,10 @@ cterminate.o: $(LC)(cterminate_$(PRECIS).o) $(LC)(cterminate_$(PRECIS).o): ../tools/cterminate.F90 @printf ' %-9s %-15s\t\t' "Compiling" "cterminate" $(CP) ../tools/cterminate.F90 $(OBJ)/cterminate.F90 - cd $(OBJ); $(FORTRAN) -o cterminate_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o cterminate_$(PRECIS).o $(F90FLAGS) \ cterminate.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cterminate_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o cterminate_$(PRECIS).o $(F90FLAGSN) \ cterminate.F90 ) cd $(OBJ); $(ARR) cterminate_$(PRECIS).o; \ $(RM) cterminate.F90 cterminate_$(PRECIS).o @@ -1078,9 +1035,9 @@ lqp.o: $(LC)(lqp_$(PRECS).o) $(LC)(lqp_$(PRECIS).o): ../tools/lqp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "lqp" $(CP) ../tools/lqp.F90 $(OBJ)/lqp.F90 - cd $(OBJ); $(FORTRAN) -o lqp_$(PRECIS).o $(FFLAGS) lqp.F90 \ + cd $(OBJ); $(FORTRAN) -o lqp_$(PRECIS).o $(F90FLAGS) lqp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o lqp_$(PRECIS).o $(FFLAGSN) lqp.F90 ) + $(FORTRAN) -o lqp_$(PRECIS).o $(F90FLAGSN) lqp.F90 ) cd $(OBJ); $(ARR) lqp_$(PRECIS).o; \ $(RM) lqp.F90 lqp_$(PRECIS).o $(MVMODS) @@ -1091,9 +1048,9 @@ timings.o: $(LC)(timings_$(PRECIS).o) $(LC)(timings_$(PRECIS).o): ../tools/timings.F90 @printf ' %-9s %-15s\t\t' "Compiling" "timings" $(CP) ../tools/timings.F90 $(OBJ)/timings.F90 - cd $(OBJ); $(FORTRAN) -o timings_$(PRECIS).o $(FFLAGS) timings.F90 \ + cd $(OBJ); $(FORTRAN) -o timings_$(PRECIS).o $(F90FLAGS) timings.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o timings_$(PRECIS).o $(FFLAGSN) timings.F90 ) + $(FORTRAN) -o timings_$(PRECIS).o $(F90FLAGSN) timings.F90 ) cd $(OBJ); $(ARR) timings_$(PRECIS).o; \ $(RM) timings.F90 timings_$(PRECIS).o # $(MVMODS) @@ -1104,10 +1061,10 @@ set_monitor.o: $(LC)(set_monitor_$(PRECIS).o) $(LC)(set_monitor_$(PRECIS).o): ../tools/set_monitor.F90 @printf ' %-9s %-15s\t\t' "Compiling" "set_monitor" $(CP) ../tools/set_monitor.F90 $(OBJ)/set_monitor.F90 - cd $(OBJ); $(FORTRAN) -o set_monitor_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o set_monitor_$(PRECIS).o $(F90FLAGS) \ set_monitor.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o set_monitor_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o set_monitor_$(PRECIS).o $(F90FLAGSN) \ set_monitor.F90 ) cd $(OBJ); $(ARR) set_monitor_$(PRECIS).o; \ $(RM) set_monitor.F90 set_monitor_$(PRECIS).o @@ -1119,9 +1076,9 @@ usetup.o: $(LC)(usetup_$(PRECIS).o) $(LC)(usetup_$(PRECIS).o): ../tools/usetup.F90 @printf ' %-9s %-15s\t\t' "Compiling" "usetup" $(CP) ../tools/usetup.F90 $(OBJ)/usetup.F90 - cd $(OBJ); $(FORTRAN) -o usetup_$(PRECIS).o $(FFLAGS) usetup.F90 \ + cd $(OBJ); $(FORTRAN) -o usetup_$(PRECIS).o $(F90FLAGS) usetup.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o usetup_$(PRECIS).o $(FFLAGSN) usetup.F90 ) + $(FORTRAN) -o usetup_$(PRECIS).o $(F90FLAGSN) usetup.F90 ) cd $(OBJ); $(ARR) usetup_$(PRECIS).o; \ $(RM) usetup.F90 usetup_$(PRECIS).o # $(MVMODS) @@ -1132,9 +1089,9 @@ udimen.o: $(LC)(udimen_$(PRECIS).o) $(LC)(udimen_$(PRECIS).o): ../tools/udimen.F90 @printf ' %-9s %-15s\t\t' "Compiling" "udimen" $(CP) ../tools/udimen.F90 $(OBJ)/udimen.F90 - cd $(OBJ); $(FORTRAN) -o udimen_$(PRECIS).o $(FFLAGS) udimen.F90 \ + cd $(OBJ); $(FORTRAN) -o udimen_$(PRECIS).o $(F90FLAGS) udimen.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o udimen_$(PRECIS).o $(FFLAGSN) udimen.F90 ) + $(FORTRAN) -o udimen_$(PRECIS).o $(F90FLAGSN) udimen.F90 ) cd $(OBJ); $(ARR) udimen_$(PRECIS).o; \ $(RM) udimen.F90 udimen_$(PRECIS).o # $(MVMODS) @@ -1145,9 +1102,9 @@ udimse.o: $(LC)(udimse_$(PRECIS).o) $(LC)(udimse_$(PRECIS).o): ../tools/udimse.F90 @printf ' %-9s %-15s\t\t' "Compiling" "udimse" $(CP) ../tools/udimse.F90 $(OBJ)/udimse.F90 - cd $(OBJ); $(FORTRAN) -o udimse_$(PRECIS).o $(FFLAGS) udimse.F90 \ + cd $(OBJ); $(FORTRAN) -o udimse_$(PRECIS).o $(F90FLAGS) udimse.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o udimse_$(PRECIS).o $(FFLAGSN) udimse.F90 ) + $(FORTRAN) -o udimse_$(PRECIS).o $(F90FLAGSN) udimse.F90 ) cd $(OBJ); $(ARR) udimse_$(PRECIS).o; \ $(RM) udimse.F90 udimse_$(PRECIS).o # $(MVMODS) @@ -1158,9 +1115,9 @@ udimsh.o: $(LC)(udimsh_$(PRECIS).o) $(LC)(udimsh_$(PRECIS).o): ../tools/udimsh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "udimsh" $(CP) ../tools/udimsh.F90 $(OBJ)/udimsh.F90 - cd $(OBJ); $(FORTRAN) -o udimsh_$(PRECIS).o $(FFLAGS) udimsh.F90 \ + cd $(OBJ); $(FORTRAN) -o udimsh_$(PRECIS).o $(F90FLAGS) udimsh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o udimsh_$(PRECIS).o $(FFLAGSN) udimsh.F90 ) + $(FORTRAN) -o udimsh_$(PRECIS).o $(F90FLAGSN) udimsh.F90 ) cd $(OBJ); $(ARR) udimsh_$(PRECIS).o; \ $(RM) udimsh.F90 udimsh_$(PRECIS).o # $(MVMODS) @@ -1171,9 +1128,9 @@ unames.o: $(LC)(unames_$(PRECIS).o) $(LC)(unames_$(PRECIS).o): ../tools/unames.F90 @printf ' %-9s %-15s\t\t' "Compiling" "unames" $(CP) ../tools/unames.F90 $(OBJ)/unames.F90 - cd $(OBJ); $(FORTRAN) -o unames_$(PRECIS).o $(FFLAGS) unames.F90 \ + cd $(OBJ); $(FORTRAN) -o unames_$(PRECIS).o $(F90FLAGS) unames.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o unames_$(PRECIS).o $(FFLAGSN) unames.F90 ) + $(FORTRAN) -o unames_$(PRECIS).o $(F90FLAGSN) unames.F90 ) cd $(OBJ); $(ARR) unames_$(PRECIS).o; \ $(RM) unames.F90 unames_$(PRECIS).o # $(MVMODS) @@ -1184,9 +1141,9 @@ uvartype.o: $(LC)(uvartype_$(PRECIS).o) $(LC)(uvartype_$(PRECIS).o): ../tools/uvartype.F90 @printf ' %-9s %-15s\t\t' "Compiling" "uvartype" $(CP) ../tools/uvartype.F90 $(OBJ)/uvartype.F90 - cd $(OBJ); $(FORTRAN) -o uvartype_$(PRECIS).o $(FFLAGS) uvartype.F90 \ + cd $(OBJ); $(FORTRAN) -o uvartype_$(PRECIS).o $(F90FLAGS) uvartype.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o uvartype_$(PRECIS).o $(FFLAGSN) uvartype.F90 ) + $(FORTRAN) -o uvartype_$(PRECIS).o $(F90FLAGSN) uvartype.F90 ) cd $(OBJ); $(ARR) uvartype_$(PRECIS).o; \ $(RM) uvartype.F90 uvartype_$(PRECIS).o # $(MVMODS) @@ -1197,9 +1154,9 @@ ufn.o: $(LC)(ufn_$(PRECIS).o) $(LC)(ufn_$(PRECIS).o): ../tools/ufn.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ufn" $(CP) ../tools/ufn.F90 $(OBJ)/ufn.F90 - cd $(OBJ); $(FORTRAN) -o ufn_$(PRECIS).o $(FFLAGS) ufn.F90 \ + cd $(OBJ); $(FORTRAN) -o ufn_$(PRECIS).o $(F90FLAGS) ufn.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ufn_$(PRECIS).o $(FFLAGSN) ufn.F90 ) + $(FORTRAN) -o ufn_$(PRECIS).o $(F90FLAGSN) ufn.F90 ) cd $(OBJ); $(ARR) ufn_$(PRECIS).o; \ $(RM) ufn.F90 ufn_$(PRECIS).o # $(MVMODS) @@ -1210,9 +1167,9 @@ ugr.o: $(LC)(ugr_$(PRECIS).o) $(LC)(ugr_$(PRECIS).o): ../tools/ugr.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ugr" $(CP) ../tools/ugr.F90 $(OBJ)/ugr.F90 - cd $(OBJ); $(FORTRAN) -o ugr_$(PRECIS).o $(FFLAGS) ugr.F90 \ + cd $(OBJ); $(FORTRAN) -o ugr_$(PRECIS).o $(F90FLAGS) ugr.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ugr_$(PRECIS).o $(FFLAGSN) ugr.F90 ) + $(FORTRAN) -o ugr_$(PRECIS).o $(F90FLAGSN) ugr.F90 ) cd $(OBJ); $(ARR) ugr_$(PRECIS).o; \ $(RM) ugr.F90 ugr_$(PRECIS).o # $(MVMODS) @@ -1223,9 +1180,9 @@ uofg.o: $(LC)(uofg_$(PRECIS).o) $(LC)(uofg_$(PRECIS).o): ../tools/uofg.F90 @printf ' %-9s %-15s\t\t' "Compiling" "uofg" $(CP) ../tools/uofg.F90 $(OBJ)/uofg.F90 - cd $(OBJ); $(FORTRAN) -o uofg_$(PRECIS).o $(FFLAGS) uofg.F90 \ + cd $(OBJ); $(FORTRAN) -o uofg_$(PRECIS).o $(F90FLAGS) uofg.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o uofg_$(PRECIS).o $(FFLAGSN) uofg.F90 ) + $(FORTRAN) -o uofg_$(PRECIS).o $(F90FLAGSN) uofg.F90 ) cd $(OBJ); $(ARR) uofg_$(PRECIS).o; \ $(RM) uofg.F90 uofg_$(PRECIS).o # $(MVMODS) @@ -1236,9 +1193,9 @@ udh.o: $(LC)(udh_$(PRECIS).o) $(LC)(udh_$(PRECIS).o): ../tools/udh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "udh" $(CP) ../tools/udh.F90 $(OBJ)/udh.F90 - cd $(OBJ); $(FORTRAN) -o udh_$(PRECIS).o $(FFLAGS) udh.F90 \ + cd $(OBJ); $(FORTRAN) -o udh_$(PRECIS).o $(F90FLAGS) udh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o udh_$(PRECIS).o $(FFLAGSN) udh.F90 ) + $(FORTRAN) -o udh_$(PRECIS).o $(F90FLAGSN) udh.F90 ) cd $(OBJ); $(ARR) udh_$(PRECIS).o; \ $(RM) udh.F90 udh_$(PRECIS).o # $(MVMODS) @@ -1249,9 +1206,9 @@ ugrdh.o: $(LC)(ugrdh_$(PRECIS).o) $(LC)(ugrdh_$(PRECIS).o): ../tools/ugrdh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ugrdh" $(CP) ../tools/ugrdh.F90 $(OBJ)/ugrdh.F90 - cd $(OBJ); $(FORTRAN) -o ugrdh_$(PRECIS).o $(FFLAGS) ugrdh.F90 \ + cd $(OBJ); $(FORTRAN) -o ugrdh_$(PRECIS).o $(F90FLAGS) ugrdh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ugrdh_$(PRECIS).o $(FFLAGSN) ugrdh.F90 ) + $(FORTRAN) -o ugrdh_$(PRECIS).o $(F90FLAGSN) ugrdh.F90 ) cd $(OBJ); $(ARR) ugrdh_$(PRECIS).o; \ $(RM) ugrdh.F90 ugrdh_$(PRECIS).o # $(MVMODS) @@ -1262,9 +1219,9 @@ ush.o: $(LC)(ush_$(PRECIS).o) $(LC)(ush_$(PRECIS).o): ../tools/ush.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ush" $(CP) ../tools/ush.F90 $(OBJ)/ush.F90 - cd $(OBJ); $(FORTRAN) -o ush_$(PRECIS).o $(FFLAGS) ush.F90 \ + cd $(OBJ); $(FORTRAN) -o ush_$(PRECIS).o $(F90FLAGS) ush.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ush_$(PRECIS).o $(FFLAGSN) ush.F90 ) + $(FORTRAN) -o ush_$(PRECIS).o $(F90FLAGSN) ush.F90 ) cd $(OBJ); $(ARR) ush_$(PRECIS).o; \ $(RM) ush.F90 ush_$(PRECIS).o # $(MVMODS) @@ -1275,9 +1232,9 @@ ushp.o: $(LC)(ushp_$(PRECIS).o) $(LC)(ushp_$(PRECIS).o): ../tools/ushp.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ushp" $(CP) ../tools/ushp.F90 $(OBJ)/ushp.F90 - cd $(OBJ); $(FORTRAN) -o ushp_$(PRECIS).o $(FFLAGS) ushp.F90 \ + cd $(OBJ); $(FORTRAN) -o ushp_$(PRECIS).o $(F90FLAGS) ushp.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ushp_$(PRECIS).o $(FFLAGSN) ushp.F90 ) + $(FORTRAN) -o ushp_$(PRECIS).o $(F90FLAGSN) ushp.F90 ) cd $(OBJ); $(ARR) ushp_$(PRECIS).o; \ $(RM) ushp.F90 ushp_$(PRECIS).o # $(MVMODS) @@ -1288,9 +1245,9 @@ ueh.o: $(LC)(ueh_$(PRECIS).o) $(LC)(ueh_$(PRECIS).o): ../tools/ueh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ueh" $(CP) ../tools/ueh.F90 $(OBJ)/ueh.F90 - cd $(OBJ); $(FORTRAN) -o ueh_$(PRECIS).o $(FFLAGS) ueh.F90 \ + cd $(OBJ); $(FORTRAN) -o ueh_$(PRECIS).o $(F90FLAGS) ueh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ueh_$(PRECIS).o $(FFLAGSN) ueh.F90 ) + $(FORTRAN) -o ueh_$(PRECIS).o $(F90FLAGSN) ueh.F90 ) cd $(OBJ); $(ARR) ueh_$(PRECIS).o; \ $(RM) ueh.F90 ueh_$(PRECIS).o # $(MVMODS) @@ -1301,9 +1258,9 @@ ugreh.o: $(LC)(ugreh_$(PRECIS).o) $(LC)(ugreh_$(PRECIS).o): ../tools/ugreh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ugreh" $(CP) ../tools/ugreh.F90 $(OBJ)/ugreh.F90 - cd $(OBJ); $(FORTRAN) -o ugreh_$(PRECIS).o $(FFLAGS) ugreh.F90 \ + cd $(OBJ); $(FORTRAN) -o ugreh_$(PRECIS).o $(F90FLAGS) ugreh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ugreh_$(PRECIS).o $(FFLAGSN) ugreh.F90 ) + $(FORTRAN) -o ugreh_$(PRECIS).o $(F90FLAGSN) ugreh.F90 ) cd $(OBJ); $(ARR) ugreh_$(PRECIS).o; \ $(RM) ugreh.F90 ugreh_$(PRECIS).o # $(MVMODS) @@ -1314,9 +1271,9 @@ ugrsh.o: $(LC)(ugrsh_$(PRECIS).o) $(LC)(ugrsh_$(PRECIS).o): ../tools/ugrsh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ugrsh" $(CP) ../tools/ugrsh.F90 $(OBJ)/ugrsh.F90 - cd $(OBJ); $(FORTRAN) -o ugrsh_$(PRECIS).o $(FFLAGS) ugrsh.F90 \ + cd $(OBJ); $(FORTRAN) -o ugrsh_$(PRECIS).o $(F90FLAGS) ugrsh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ugrsh_$(PRECIS).o $(FFLAGSN) ugrsh.F90 ) + $(FORTRAN) -o ugrsh_$(PRECIS).o $(F90FLAGSN) ugrsh.F90 ) cd $(OBJ); $(ARR) ugrsh_$(PRECIS).o; \ $(RM) ugrsh.F90 ugrsh_$(PRECIS).o # $(MVMODS) @@ -1327,9 +1284,9 @@ uhprod.o: $(LC)(uhprod_$(PRECIS).o) $(LC)(uhprod_$(PRECIS).o): ../tools/uhprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "uhprod" $(CP) ../tools/uhprod.F90 $(OBJ)/uhprod.F90 - cd $(OBJ); $(FORTRAN) -o uhprod_$(PRECIS).o $(FFLAGS) uhprod.F90 \ + cd $(OBJ); $(FORTRAN) -o uhprod_$(PRECIS).o $(F90FLAGS) uhprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o uhprod_$(PRECIS).o $(FFLAGSN) uhprod.F90 ) + $(FORTRAN) -o uhprod_$(PRECIS).o $(F90FLAGSN) uhprod.F90 ) cd $(OBJ); $(ARR) uhprod_$(PRECIS).o; \ $(RM) uhprod.F90 uhprod_$(PRECIS).o # $(MVMODS) @@ -1340,9 +1297,9 @@ ushprod.o: $(LC)(ushprod_$(PRECIS).o) $(LC)(ushprod_$(PRECIS).o): ../tools/ushprod.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ushprod" $(CP) ../tools/ushprod.F90 $(OBJ)/ushprod.F90 - cd $(OBJ); $(FORTRAN) -o ushprod_$(PRECIS).o $(FFLAGS) ushprod.F90 \ + cd $(OBJ); $(FORTRAN) -o ushprod_$(PRECIS).o $(F90FLAGS) ushprod.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ushprod_$(PRECIS).o $(FFLAGSN) ushprod.F90 ) + $(FORTRAN) -o ushprod_$(PRECIS).o $(F90FLAGSN) ushprod.F90 ) cd $(OBJ); $(ARR) ushprod_$(PRECIS).o; \ $(RM) ushprod.F90 ushprod_$(PRECIS).o # $(MVMODS) @@ -1353,9 +1310,9 @@ ubandh.o: $(LC)(ubandh_$(PRECIS).o) $(LC)(ubandh_$(PRECIS).o): ../tools/ubandh.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ubandh" $(CP) ../tools/ubandh.F90 $(OBJ)/ubandh.F90 - cd $(OBJ); $(FORTRAN) -o ubandh_$(PRECIS).o $(FFLAGS) ubandh.F90 \ + cd $(OBJ); $(FORTRAN) -o ubandh_$(PRECIS).o $(F90FLAGS) ubandh.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ubandh_$(PRECIS).o $(FFLAGSN) ubandh.F90 ) + $(FORTRAN) -o ubandh_$(PRECIS).o $(F90FLAGSN) ubandh.F90 ) cd $(OBJ); $(ARR) ubandh_$(PRECIS).o; \ $(RM) ubandh.F90 ubandh_$(PRECIS).o # $(MVMODS) @@ -1366,9 +1323,9 @@ ureport.o: $(LC)(ureport_$(PRECIS).o) $(LC)(ureport_$(PRECIS).o): ../tools/ureport.F90 @printf ' %-9s %-15s\t\t' "Compiling" "ureport" $(CP) ../tools/ureport.F90 $(OBJ)/ureport.F90 - cd $(OBJ); $(FORTRAN) -o ureport_$(PRECIS).o $(FFLAGS) ureport.F90 \ + cd $(OBJ); $(FORTRAN) -o ureport_$(PRECIS).o $(F90FLAGS) ureport.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ureport_$(PRECIS).o $(FFLAGSN) ureport.F90 ) + $(FORTRAN) -o ureport_$(PRECIS).o $(F90FLAGSN) ureport.F90 ) cd $(OBJ); $(ARR) ureport_$(PRECIS).o; \ $(RM) ureport.F90 ureport_$(PRECIS).o # $(MVMODS) @@ -1379,10 +1336,10 @@ uterminate.o: $(LC)(uterminate_$(PRECIS).o) $(LC)(uterminate_$(PRECIS).o): ../tools/uterminate.F90 @printf ' %-9s %-15s\t\t' "Compiling" "uterminate" $(CP) ../tools/uterminate.F90 $(OBJ)/uterminate.F90 - cd $(OBJ); $(FORTRAN) -o uterminate_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o uterminate_$(PRECIS).o $(F90FLAGS) \ uterminate.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o uterminate_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o uterminate_$(PRECIS).o $(F90FLAGSN) \ uterminate.F90 ) cd $(OBJ); $(ARR) uterminate_$(PRECIS).o; \ $(RM) uterminate.F90 uterminate_$(PRECIS).o @@ -1394,9 +1351,9 @@ pname.o: $(LC)(pname_$(PRECIS).o) $(LC)(pname_$(PRECIS).o): ../tools/pname.F90 @printf ' %-9s %-15s\t\t' "Compiling" "pname" $(CP) ../tools/pname.F90 $(OBJ)/pname.F90 - cd $(OBJ); $(FORTRAN) -o pname_$(PRECIS).o $(FFLAGS) pname.F90 \ + cd $(OBJ); $(FORTRAN) -o pname_$(PRECIS).o $(F90FLAGS) pname.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o pname_$(PRECIS).o $(FFLAGSN) pname.F90 ) + $(FORTRAN) -o pname_$(PRECIS).o $(F90FLAGSN) pname.F90 ) cd $(OBJ); $(ARR) pname_$(PRECIS).o; \ $(RM) pname.F90 pname_$(PRECIS).o # $(MVMODS) @@ -1407,9 +1364,9 @@ probname.o: $(LC)(probname_$(PRECIS).o) $(LC)(probname_$(PRECIS).o): ../tools/probname.F90 @printf ' %-9s %-15s\t\t' "Compiling" "probname" $(CP) ../tools/probname.F90 $(OBJ)/probname.F90 - cd $(OBJ); $(FORTRAN) -o probname_$(PRECIS).o $(FFLAGS) probname.F90 \ + cd $(OBJ); $(FORTRAN) -o probname_$(PRECIS).o $(F90FLAGS) probname.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o probname_$(PRECIS).o $(FFLAGSN) probname.F90 ) + $(FORTRAN) -o probname_$(PRECIS).o $(F90FLAGSN) probname.F90 ) cd $(OBJ); $(ARR) probname_$(PRECIS).o; \ $(RM) probname.F90 probname_$(PRECIS).o # $(MVMODS) @@ -1420,9 +1377,9 @@ varnames.o: $(LC)(varnames_$(PRECIS).o) $(LC)(varnames_$(PRECIS).o): ../tools/varnames.F90 @printf ' %-9s %-15s\t\t' "Compiling" "varnames" $(CP) ../tools/varnames.F90 $(OBJ)/varnames.F90 - cd $(OBJ); $(FORTRAN) -o varnames_$(PRECIS).o $(FFLAGS) varnames.F90 \ + cd $(OBJ); $(FORTRAN) -o varnames_$(PRECIS).o $(F90FLAGS) varnames.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o varnames_$(PRECIS).o $(FFLAGSN) varnames.F90 ) + $(FORTRAN) -o varnames_$(PRECIS).o $(F90FLAGSN) varnames.F90 ) cd $(OBJ); $(ARR) varnames_$(PRECIS).o; \ $(RM) varnames.F90 varnames_$(PRECIS).o # $(MVMODS) @@ -1433,9 +1390,9 @@ connames.o: $(LC)(connames_$(PRECIS).o) $(LC)(connames_$(PRECIS).o): ../tools/connames.F90 @printf ' %-9s %-15s\t\t' "Compiling" "connames" $(CP) ../tools/connames.F90 $(OBJ)/connames.F90 - cd $(OBJ); $(FORTRAN) -o connames_$(PRECIS).o $(FFLAGS) connames.F90 \ + cd $(OBJ); $(FORTRAN) -o connames_$(PRECIS).o $(F90FLAGS) connames.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o connames_$(PRECIS).o $(FFLAGSN) connames.F90 ) + $(FORTRAN) -o connames_$(PRECIS).o $(F90FLAGSN) connames.F90 ) cd $(OBJ); $(ARR) connames_$(PRECIS).o; \ $(RM) connames.F90 connames_$(PRECIS).o # $(MVMODS) @@ -1446,10 +1403,10 @@ newthread.o: $(LC)(newthread_$(PRECIS).o) $(LC)(newthread_$(PRECIS).o): ../tools/newthread.F90 @printf ' %-9s %-15s\t\t' "Compiling" "newthread" $(CP) ../tools/newthread.F90 $(OBJ)/newthread.F90 - cd $(OBJ); $(FORTRAN) -o newthread_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o newthread_$(PRECIS).o $(F90FLAGS) \ newthread.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o newthread_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o newthread_$(PRECIS).o $(F90FLAGSN) \ newthread.F90 ) cd $(OBJ); $(ARR) newthread_$(PRECIS).o; \ $(RM) newthread.F90 newthread_$(PRECIS).o @@ -1461,9 +1418,9 @@ problem.o: $(LC)(problem_$(PRECIS).o) $(LC)(problem_$(PRECIS).o): ../tools/problem.F90 @printf ' %-9s %-15s\t\t' "Compiling" "problem" $(CP) ../tools/problem.F90 $(OBJ)/problem.F90 - cd $(OBJ); $(FORTRAN) -o problem_$(PRECIS).o $(FFLAGS) problem.F90 \ + cd $(OBJ); $(FORTRAN) -o problem_$(PRECIS).o $(F90FLAGS) problem.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o problem_$(PRECIS).o $(FFLAGSN) problem.F90 ) + $(FORTRAN) -o problem_$(PRECIS).o $(F90FLAGSN) problem.F90 ) cd $(OBJ); $(ARR) problem_$(PRECIS).o; \ $(RM) problem.F90 problem_$(PRECIS).o # $(MVMODS) @@ -1474,10 +1431,10 @@ fortran_ops.o: $(LC)(fortran_ops_$(PRECIS).o) $(LC)(fortran_ops_$(PRECIS).o): ../tools/fortran_ops.F90 @printf ' %-9s %-15s\t\t' "Compiling" "fortran_ops" $(CP) ../tools/fortran_ops.F90 $(OBJ)/fortran_ops.F90 - cd $(OBJ); $(FORTRAN) -o fortran_ops_$(PRECIS).o $(FFLAGS) \ + cd $(OBJ); $(FORTRAN) -o fortran_ops_$(PRECIS).o $(F90FLAGS) \ fortran_ops.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o fortran_ops_$(PRECIS).o $(FFLAGSN) \ + $(FORTRAN) -o fortran_ops_$(PRECIS).o $(F90FLAGSN) \ fortran_ops.F90 ) cd $(OBJ); $(ARR) fortran_ops_$(PRECIS).o; \ $(RM) fortran_ops.F90 fortran_ops_$(PRECIS).o @@ -1493,7 +1450,7 @@ $(LC)(ccutest_$(PRECIS).o): ../tools/ccutest.c || ( printf ' %-26s' "=> Disabling optimization " ; \ $(CC) -o ccutest_$(PRECIS).o $(CFLAGSN) ccutest.c ) cd $(OBJ); $(ARR) ccutest_$(PRECIS).o; \ - $(RM) ccutest_$(PRECIS).o ccutest_$(PRECIS).o + $(RM) ccutest.c ccutest_$(PRECIS).o # $(MVMODS) @printf '[ OK ]\n' diff --git a/src/tools/usetup.F90 b/src/tools/usetup.F90 index 874248c..7a18c68 100644 --- a/src/tools/usetup.F90 +++ b/src/tools/usetup.F90 @@ -210,14 +210,14 @@ SUBROUTINE CUTEST_usetup_threadsafe_r( data, work, status, input, out, & CLOSE( input ) IF ( out > 0 ) WRITE( out, & "( /, ' ** SUNROUTINE CUTEST_usetup: the problem uses no variables.',& - & ' Execution terminating ' )" ) + & ' Execution terminating ' )" ) status = 2 ; RETURN END IF IF ( data%ng <= 0 ) THEN CLOSE( input ) IF ( out > 0 ) WRITE( out, & - "( /, ' ** SUBROUTINE CUTEST_usetup: the problem is vacuous.', & - & ' Execution terminating ' )" ) + "( /, ' ** SUBROUTINE CUTEST_usetup: the problem is vacuous.', /, & + & ' Execution terminating ' )" ) status = 2 ; RETURN END IF IF ( SIZE( X ) < n ) THEN @@ -480,7 +480,7 @@ SUBROUTINE CUTEST_usetup_threadsafe_r( data, work, status, input, out, & CLOSE( input ) IF ( out > 0 ) WRITE( out, & "( /, ' ** Program CUTEST_usetup: the problem includes general', & - & ' constraints. Execution terminating ' )" ) + & ' constraints.', /, ' Execution terminating ' )" ) status = 2 ; RETURN END IF END DO diff --git a/src/tron/makemaster b/src/tron/makemaster index 960068e..f459f13 100644 --- a/src/tron/makemaster +++ b/src/tron/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst TRON interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 4 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = TRON -package = tron - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -U_TEST = u_elfun.o u_group.o u_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_unconstrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(U_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = TRON +package = tron -test_cutest_unconstrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_unconstrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/tron/tron_main.f b/src/tron/tron_main.F similarity index 82% rename from src/tron/tron_main.f rename to src/tron/tron_main.F index 803d210..d3e8b85 100644 --- a/src/tron/tron_main.f +++ b/src/tron/tron_main.F @@ -1,32 +1,38 @@ -C ( Last modified on 2 Jan 2013 at 13:40:00 ) - PROGRAM TRNMA -C +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" + + PROGRAM TRNMA + C TRON test driver for problems derived from SIF files. C C Nick Gould, for CGT Productions. C September 2004. C Revised for CUTEst, January 2013 C + USE CUTEST_KINDS_precision IMPLICIT NONE - INTEGER LH, I, out, N, INPUT, J, MAXIT, L, P, - * IFLAG, INSPEC, NNZH, NNZH2, - * status, ISAVE( 3 ) - INTEGER :: io_buffer = 11 - DOUBLE PRECISION F, GTOL , GNORM , ZERO, ONE, DSAVE( 3 ), - * FRTOL, FATOL, FMIN, CGTOL, DELTA, GNORM0 + INTEGER ( KIND = ip_ ) LH, I, out, N, INPUT, J, MAXIT, L, P + INTEGER ( KIND = ip_ ) IFLAG, INSPEC, NNZH, NNZH2, status + INTEGER ( KIND = ip_ ) ISAVE( 3 ) + INTEGER ( KIND = ip_ ) :: io_buffer = 11 + REAL ( KIND = rp_ ) F, GTOL , GNORM , DSAVE( 3 ) + REAL ( KIND = rp_ ) FRTOL, FATOL, FMIN, CGTOL, DELTA, GNORM0 CHARACTER ( LEN = 60 ) :: TASK - PARAMETER ( out = 6 ) - INTEGER, ALLOCATABLE, DIMENSION( : ) :: HPTR, HROW, LPTR, LROW, - * BPTR, BROW, IFREE, IWA - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, XL, XU, G, + PARAMETER ( out = 6 ) + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: HPTR, HROW + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: LPTR, LROW + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: BPTR, BROW + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IFREE, IWA + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, XL, XU, G, * XC, S, WA, HVAL, HDIAG, LVAL, LDIAG, BVAL, BDIAG - PARAMETER ( INPUT = 55, INSPEC = 56 ) - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) + PARAMETER ( INPUT = 55, INSPEC = 56 ) CHARACTER ( LEN = 10 ) :: PNAME, SPCDAT CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: XNAMES - DOUBLE PRECISION :: CPU( 4 ), CALLS( 4 ) - DOUBLE PRECISION DGPNRM2, DNRM2 - EXTERNAL DTRON, DGPNRM2 + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) + REAL ( KIND = rp_ ) DGPNRM2, DNRM2 + EXTERNAL DTRON, DGPNRM2 C C Open the Spec file for the method. C @@ -59,7 +65,7 @@ PROGRAM TRNMA C C Check to see if there is sufficient room C - CALL CUTEST_udimen( status, INPUT, N ) + CALL CUTEST_udimen_r( status, INPUT, N ) IF ( status /= 0 ) GO TO 910 ALLOCATE( HPTR( n + 1 ), LPTR( n + 1 ), @@ -72,12 +78,13 @@ PROGRAM TRNMA C C Set up SIF data. C - CALL CUTEST_usetup( status, INPUT, out, io_buffer, N, X, XL, XU ) + CALL CUTEST_usetup_r( status, INPUT, out, io_buffer, N, + * X, XL, XU ) IF ( status /= 0 ) GO TO 910 C C Check to see if there is sufficient room for the matrices C - CALL CUTEST_udimsh( status, NNZH ) + CALL CUTEST_udimsh_r( status, NNZH ) IF ( status /= 0 ) GO TO 910 ALLOCATE( HROW( nnzh ), BROW( nnzh ), @@ -89,7 +96,7 @@ PROGRAM TRNMA C C Obtain variable names. C - CALL CUTEST_unames( status, N, PNAME, XNAMES ) + CALL CUTEST_unames_r( status, N, PNAME, XNAMES ) IF ( status /= 0 ) GO TO 910 C C Set up algorithmic input data. @@ -106,7 +113,7 @@ PROGRAM TRNMA C IF (TASK( 1: 1 ) .EQ. 'F' .OR. * TASK( 1: 5 ) .EQ. 'START' ) THEN - CALL CUTEST_ufn( status, N, X, F ) + CALL CUTEST_ufn_r( status, N, X, F ) IF ( status /= 0 ) GO TO 910 END IF C @@ -116,14 +123,14 @@ PROGRAM TRNMA C IF (TASK( 1: 2 ) .EQ. 'GH' .OR. * TASK( 1: 5 ) .EQ. 'START' ) THEN - CALL CUTEST_ugrsh( status, N, X, G, NNZH, LH, HVAL, + CALL CUTEST_ugrsh_r( status, N, X, G, NNZH, LH, HVAL, * BROW, HROW ) IF ( status /= 0 ) GO TO 910 C C Separate the diagonal of the Hessian from its off diagonal C DO 40 I = 1, N - HDIAG( I ) = ZERO + HDIAG( I ) = 0.0_rp_ 40 CONTINUE NNZH2 = NNZH NNZH = 0 @@ -148,7 +155,7 @@ PROGRAM TRNMA C Initialize the trust region bound. C IF ( TASK( 1: 5 ) .EQ. 'START' ) THEN - GNORM0 = MAX( DNRM2( N, G, 1 ), ONE ) + GNORM0 = MAX( DNRM2( N, G, 1 ), 1.0_rp_ ) DELTA = GNORM0 END IF C @@ -180,7 +187,7 @@ PROGRAM TRNMA C C Terminal exit. C - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 GNORM = DGPNRM2( N, X, XL, XU, G ) WRITE ( out, 2010 ) F, GNORM @@ -191,7 +198,7 @@ PROGRAM TRNMA WRITE ( out, 2000 ) PNAME, N, INT( CALLS(1) ), INT( CALLS(2) ), * IFLAG, F, CPU(1), CPU(2) CLOSE( INPUT ) - CALL CUTEST_uterminate( status ) + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -225,10 +232,11 @@ PROGRAM TRNMA END SUBROUTINE REORDA( NC, NNZ, IRN, JCN, A, IP, IW ) + USE CUTEST_KINDS_precision INTEGER NC, NNZ INTEGER IRN( NNZ ), JCN( NNZ ) INTEGER IW( NC + 1 ), IP( NC + 1 ) - DOUBLE PRECISION A( NNZ ) + REAL ( KIND = rp_ ) A( NNZ ) C Sort a sparse matrix from arbitrary order to column order @@ -236,7 +244,7 @@ SUBROUTINE REORDA( NC, NNZ, IRN, JCN, A, IP, IW ) C 7th November, 1990 INTEGER I, J, K, L, IC, NCP1, ITEMP, JTEMP, LOCAT - DOUBLE PRECISION ANEXT , ATEMP + REAL ( KIND = rp_ ) ANEXT , ATEMP C Initialize the workspace as zero diff --git a/src/tron/tron_test.F b/src/tron/tron_test.F new file mode 100644 index 0000000..611c431 --- /dev/null +++ b/src/tron/tron_test.F @@ -0,0 +1,68 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy DTRON for testing tron_main interface to CUTEst + +C Nick Gould, 4th January 2013 + + SUBROUTINE DTRON( n, X, XL, XU, f, G, HVAL, HDIAG, HPTR, HROW, + * frtol, fatol, fmin, cgtol, maxit, delta, TASK, + * BVAL, BDIAG, BPTR, BROW, + * LVAL, LDIAG, LPTR, LROW, + * XC, S, IFREE, ISAVE, DSAVE, WA, IWA ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n, maxit, ISAVE( 3 ) + REAL ( KIND = rp_ ) f, frtol, fatol, fmin, cgtol, delta + REAL ( KIND = rp_ ) DSAVE( 3 ) + CHARACTER ( LEN = 60 ) :: TASK + + INTEGER ( KIND = ip_ ) HPTR( n + 1 ), LPTR( n + 1 ) + INTEGER ( KIND = ip_ ) BPTR( n + 1 ), IFREE( n ), IWA( 3 * n ) + INTEGER ( KIND = ip_ ) HROW( * ), BROW( * ), LROW( * ) + REAL ( KIND = rp_ ) X( n ), XL( n ), XU( n ), G( n ) + REAL ( KIND = rp_ ) XC( n ), S( n ), WA( 7 * n ) + REAL ( KIND = rp_ ) HDIAG( n ), LVAL( * ), HVAL( * ), BVAL( * ) + REAL ( KIND = rp_ ) LDIAG( n ), BDIAG( n ) + + IF ( TASK( 1: 5 ) .EQ. 'START' ) THEN + TASK( 1: 5 ) = 'GH ' + ELSE + TASK( 1: 5 ) = 'CONV ' + END IF + RETURN + END + + REAL ( KIND = rp_ ) FUNCTION DGPNRM2(n,x,xl,xu,g) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n + REAL ( KIND = rp_ ) x(n), xl(n), xu(n), g(n) + INTEGER ( KIND = ip_ ) i + dgpnrm2 = 0.0_rp_ + DO i = 1, n + IF (xl(i) .ne. xu(i)) THEN + IF (x(i) .eq. xl(i)) THEN + dgpnrm2 = dgpnrm2 + min(g(i),0.0D+0)**2 + ELSE IF (x(i) .eq. xu(i)) THEN + dgpnrm2 = dgpnrm2 + max(g(i),0.0D+0)**2 + ELSE + dgpnrm2 = dgpnrm2 + g(i)**2 + END IF + END IF + END DO + dgpnrm2 = sqrt(dgpnrm2) + RETURN + END + + REAL ( KIND = rp_ ) FUNCTION dnrm2(n,x,lx) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) n, lx + REAL ( KIND = rp_ ) x(n) + INTEGER ( KIND = ip_ ) i + dnrm2 = 0.0_rp_ + DO i = 1, n + dnrm2 = dnrm2 + x(i)**2 + END DO + dnrm2 = sqrt(dnrm2) + return + END diff --git a/src/tron/tron_test.f b/src/tron/tron_test.f deleted file mode 100644 index 5d941ec..0000000 --- a/src/tron/tron_test.f +++ /dev/null @@ -1,61 +0,0 @@ -C ( Last modified on 4 Jan 2013 at 16:10:00 ) - -C Dummy DTRON for testing tron_main interface to CUTEst -C Nick Gould, 4th January 2013 - - SUBROUTINE DTRON( n, X, XL, XU, f, G, HVAL, HDIAG, HPTR, HROW, - * frtol, fatol, fmin, cgtol, maxit, delta, TASK, - * BVAL, BDIAG, BPTR, BROW, - * LVAL, LDIAG, LPTR, LROW, - * XC, S, IFREE, ISAVE, DSAVE, WA, IWA ) - INTEGER n, maxit, ISAVE( 3 ) - DOUBLE PRECISION f, frtol, fatol, fmin, cgtol, delta, DSAVE( 3 ) - CHARACTER ( LEN = 60 ) :: TASK - - INTEGER HPTR( n + 1 ), LPTR( n + 1 ), - * BPTR( n + 1 ), IFREE( n ), IWA( 3 * n ), - * HROW( * ), BROW( * ), LROW( * ) - DOUBLE PRECISION X( n ), XL( n ), XU( n ), G( n ), - * XC( n ), S( n ), WA( 7 * n ), - * HDIAG( n ), LVAL( * ), HVAL( * ), BVAL( * ), - * LDIAG( n ), BDIAG( n ) - - IF ( TASK( 1: 5 ) .EQ. 'START' ) THEN - TASK( 1: 5 ) = 'GH ' - ELSE - TASK( 1: 5 ) = 'CONV ' - END IF - RETURN - END - - DOUBLE PRECISION FUNCTION DGPNRM2(n,x,xl,xu,g) - INTEGER n - DOUBLE PRECISION x(n), xl(n), xu(n), g(n) - INTEGER i - dgpnrm2 = 0.0D+0 - DO i = 1, n - IF (xl(i) .ne. xu(i)) THEN - IF (x(i) .eq. xl(i)) THEN - dgpnrm2 = dgpnrm2 + min(g(i),0.0D+0)**2 - ELSE IF (x(i) .eq. xu(i)) THEN - dgpnrm2 = dgpnrm2 + max(g(i),0.0D+0)**2 - ELSE - dgpnrm2 = dgpnrm2 + g(i)**2 - END IF - END IF - END DO - dgpnrm2 = sqrt(dgpnrm2) - RETURN - END - - DOUBLE PRECISION FUNCTION dnrm2(n,x,lx) - INTEGER n, lx - DOUBLE PRECISION x(n) - INTEGER i - dnrm2 = 0.0D+0 - DO i = 1, n - dnrm2 = dnrm2 + x(i)**2 - END DO - dnrm2 = sqrt(dnrm2) - return - END diff --git a/src/uncmin/makemaster b/src/uncmin/makemaster index e185745..1eea922 100644 --- a/src/uncmin/makemaster +++ b/src/uncmin/makemaster @@ -3,9 +3,9 @@ # Nick Gould, for GALAHAD productions # This version: 2023-11-06 -# include standard GALAHAD makefile defaults before package-specifics +# include standard CUTEst makefile defaults before package-specifics -include $(GALAHAD)/src/makedefs/defaults +include $(CUTEST)/src/makedefs/defaults # =========================================================================== # ==================== package-dependent parts ============================ @@ -28,6 +28,10 @@ include $(CUTEST)/src/makedefs/definitions include $(CUTEST)/src/makedefs/instructions +# select specific run test + +run_test: run_unconstrained_test + # include standard package compilation instructions include $(CUTEST)/src/makedefs/compile diff --git a/src/uncmin/uncmin_main.F90 b/src/uncmin/uncmin_main.F90 index 98c7910..7dcbdf6 100644 --- a/src/uncmin/uncmin_main.F90 +++ b/src/uncmin/uncmin_main.F90 @@ -1,11 +1,11 @@ ! THIS VERSION: CUTEST 2.2 - 2023-11-07 AT 11:20 GMT. #include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM UNCMIN_main USE CUTEST_KINDS_precision - USE CUTEST_problem_precision IMPLICIT NONE @@ -26,7 +26,7 @@ PROGRAM UNCMIN_main REAL ( KIND = rp_ ), PARAMETER :: biginf = REAL( 9.0D+19, KIND = rp_ ) LOGICAL :: bounds CHARACTER ( LEN = 10 ) :: pname - REAL ( KIND = rp_ ) :: CPU( 2 ), CALLS( 4 ) + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 4 ) REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, TYPSIZ REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: XPLS, GPLS REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : , :) :: A, WRK @@ -69,7 +69,7 @@ PROGRAM UNCMIN_main ! find the problem dimension - CALL CUTEST_udimen( status, input, n ) + CALL CUTEST_udimen_r( status, input, n ) IF ( status /= 0 ) GO TO 910 ! allocate workspace @@ -81,11 +81,12 @@ PROGRAM UNCMIN_main ! set up SIF data - CALL CUTEST_usetup( status, input, out, io_buffer, n, X, BL, BU ) + CALL CUTEST_usetup_r( status, input, out, io_buffer, n, X, BL, BU ) + CLOSE( input ) ! obtain variable names - CALL CUTEST_unames( status, n, pname, XNAMES ) + CALL CUTEST_unames_r( status, n, pname, XNAMES ) IF ( status /= 0 ) GO TO 910 ! set up algorithmic input data @@ -109,7 +110,7 @@ PROGRAM UNCMIN_main ! output solution - CALL CUTEST_ureport( status, CALLS, CPU ) + CALL CUTEST_ureport_r( status, CALLS, CPU ) IF ( status /= 0 ) GO TO 910 gnorm = zero @@ -122,7 +123,8 @@ PROGRAM UNCMIN_main END DO WRITE ( out, 2000 ) pname, n, ( CALLS( i ), i = 1, 3 ), & itrmcd, fpls, CPU( 1 ), CPU( 2 ) - CLOSE( input ) + + CALL CUTEST_uterminate_r( status ) STOP 910 CONTINUE @@ -165,7 +167,7 @@ SUBROUTINE UNCMIN_evalf( n, X, f ) INTEGER ( KIND = ip_ ) :: status INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 - CALL CUTEST_ufn( status, n, X, f ) + CALL CUTEST_ufn_r( status, n, X, f ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )") & status @@ -180,7 +182,7 @@ SUBROUTINE UNCMIN_evalg( n, X, G ) REAL ( KIND = rp_ ) :: X( n ), G( n ) INTEGER ( KIND = ip_ ) :: status INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 - CALL CUTEST_ugr( status, n, X, G ) + CALL CUTEST_ugr_r( status, n, X, G ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) & status @@ -195,7 +197,7 @@ SUBROUTINE UNCMIN_evalh( nr, n, X, H ) REAL ( KIND = rp_ ) ::X( n ), H( nr, n ) INTEGER ( KIND = ip_ ) :: status INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 - CALL CUTEST_udh( status, n, X, nr, H ) + CALL CUTEST_udh_r( status, n, X, nr, H ) IF ( status .NE. 0 ) THEN WRITE( out, "( ' CUTEst error, status = ', i0, ', stopping' )" ) & status diff --git a/src/vf13/makemaster b/src/vf13/makemaster index 2a8a206..57e46bf 100644 --- a/src/vf13/makemaster +++ b/src/vf13/makemaster @@ -1,141 +1,37 @@ # Main body of the installation makefile for CUTEst VF13 interface -# N. Gould, D. Orban and Ph. L. Toint. -# This version: 5 I 2013 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-01 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = VF13 -package = vf13 - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a - -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a - -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a - -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings +include $(CUTEST)/src/makedefs/defaults -ARR = $(AR) $(ARREPFLAGS) $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -BARR = $(AR) $(ARREPFLAGS) $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) +# package name -DARR = $(AR) $(ARREPFLAGS) $(DLC) - -LARR = $(AR) $(ARREPFLAGS) $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda - -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o - -SUCC = precision version) compiled successfully - -# main compilations and runs - -all: $(package) - -# basic packages - -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) - -# run example tests - -run_test: tools test_cutest_constrained $(package) $(OBJ)/$(package)_test.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(FORTRAN) $(RUNFFLAGS) $(SPECIAL) -o run_test \ - $(package)_main.o $(package)_test.o $(C_TEST) -L$(OBJ) $(LIBS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d +PACKAGE = VF13 +package = vf13 -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -# individual compilations +# include standard CUTEst makefile definitions -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.f > \ - $(OBJ)/$(package)_test.f - cd $(OBJ); $(FORTRAN) -o $(package)_test.o $(FFLAGS77) \ - $(package)_test.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_test.o $(FFLAGS77N) $(package)_test.f ) - $(RM) $(OBJ)/$(package)_test.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/definitions -# CUTEst interface main programs +# include compilation and run instructions -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.f - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.f > \ - $(OBJ)/$(package)_main.f - cd $(OBJ); $(FORTRAN) -o $(package)_main.o $(FFLAGS77) \ - $(package)_main.f \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o $(package)_main.o $(FFLAGS77N) $(package)_main.f ) - $(RM) $(OBJ)/$(package)_main.f - @printf '[ OK ]\n' +include $(CUTEST)/src/makedefs/instructions -# book keeping +# select specific run test -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' +run_test: run_constrained_test -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/vf13/vf13_main.f b/src/vf13/vf13_main.F similarity index 81% rename from src/vf13/vf13_main.f rename to src/vf13/vf13_main.F index 55ed77f..9841a3f 100644 --- a/src/vf13/vf13_main.f +++ b/src/vf13/vf13_main.F @@ -1,25 +1,29 @@ -C ( Last modified on 5 Jan 2013 at 10:00:00 ) +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" +#include "cutest_routines.h" PROGRAM VF13MA -C + C VF13 test driver for problems derived from SIF files. C C Nick Gould, for CGT Productions C CUTE version July 1991 C CUTEst evolution January 2013 -C - INTEGER :: inf, m, n, maxfun, mcon, lcn, meq, lw, liw, iprint - INTEGER :: i, j, mgeq, mmax, status - INTEGER, PARAMETER :: input = 55, out = 6 + + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: inf, m, n, maxfun, mcon, lcn, meq, lw + INTEGER ( KIND = ip_ ) :: i, j, mgeq, mmax, status, liw, iprint + INTEGER ( KIND = ip_ ), PARAMETER :: input = 55, out = 6 LOGICAL :: firstg, debug CHARACTER ( LEN = 10 ) :: pname - DOUBLE PRECISION :: f, acc - DOUBLE PRECISION, PARAMETER :: accreq = 1.0D-7 - DOUBLE PRECISION :: CPU( 4 ), CALLS( 7 ) - INTEGER, ALLOCATABLE, DIMENSION( : ) :: IW - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, G, W - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( : ) :: C, CL, CU - DOUBLE PRECISION, ALLOCATABLE, DIMENSION( :, : ) :: CN + REAL ( KIND = rp_ ) :: f, acc + REAL ( KIND = rp_ ), PARAMETER :: accreq = 1.0E-7_rp_ + REAL ( KIND = rp_ ) :: CPU( 4 ), CALLS( 7 ) + INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: IW + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: X, BL, BU, G + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( : ) :: C, CL, CU, W + REAL ( KIND = rp_ ), ALLOCATABLE, DIMENSION( :, : ) :: CN CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: VNAME CHARACTER ( LEN = 10 ), ALLOCATABLE, DIMENSION( : ) :: CNAME LOGICAL, ALLOCATABLE, DIMENSION( : ) :: EQUATN, LINEAR @@ -35,7 +39,7 @@ PROGRAM VF13MA C compute problem dimensions - CALL CUTEST_cdimen( status, input, n, m ) + CALL CUTEST_cdimen_r( status, input, n, m ) IF ( status /= 0 ) GO TO 910 C allocate space @@ -98,8 +102,8 @@ PROGRAM VF13MA CALL VF13AD( n, m, meq, X, f, G, C, CN, lcn, maxfun, * acc, iprint, inf, W, lw, IW ) IF ( INF .EQ. 0 ) GO TO 10 - CALL CUTEST_creport( status, CALLS, CPU ) - CALL CUTEST_cnames( status, N, M, PNAME, VNAME, CNAME ) + CALL CUTEST_creport_r( status, CALLS, CPU ) + CALL CUTEST_cnames_r( status, N, M, PNAME, VNAME, CNAME ) WRITE( 6, 2110 ) f, ( i, VNAME( i ), X( i ), BL( i ), BU( i ), * i = 1, n ) IF ( mcon .GT. 0 ) WRITE( 6, 2120 ) ( i, CNAME( i ), C( i ), @@ -158,9 +162,11 @@ PROGRAM VF13MA SUBROUTINE VF13SE( input, out, n, m, mgeq, meq, * mcon, X, BL, BU, nmax, EQUATN, * LINEAR, V, CL, CU, mmax ) - INTEGER :: input, out, n, m, mgeq, meq, mcon, nmax, mmax - DOUBLE PRECISION :: X( nmax ), BL( nmax ), BU( nmax ) - DOUBLE PRECISION :: V( mmax ), CL( mmax ), CU( mmax ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: input, out, n, m, mgeq, meq, mcon + INTEGER ( KIND = ip_ ) :: nmax, mmax + REAL ( KIND = rp_ ) :: X( nmax ), BL( nmax ), BU( nmax ) + REAL ( KIND = rp_ ) :: V( mmax ), CL( mmax ), CU( mmax ) LOGICAL :: EQUATN( mmax ), LINEAR( mmax ) C Set up the input data for the the VF13 minimizer. @@ -168,13 +174,13 @@ SUBROUTINE VF13SE( input, out, n, m, mgeq, meq, C Nick Gould, for CGT productions, C 7th November, 1991. - INTEGER :: i, status - INTEGER, PARAMETER :: io_buffer = 11 - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19 + INTEGER ( KIND = ip_ ) :: i, status + INTEGER ( KIND = ip_ ), PARAMETER :: io_buffer = 11 + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ C Set up the data structures necessary to hold the problem functions. - CALL CUTEST_csetup( status, input, out, io_buffer, n, m, + CALL CUTEST_csetup_r( status, input, out, io_buffer, n, m, * X, BL, BU, V, CL, CU, EQUATN, LINEAR, * 1, 0, 0 ) IF ( status /= 0 ) GO TO 910 @@ -237,21 +243,22 @@ SUBROUTINE VF13SE( input, out, n, m, mgeq, meq, C SUBROUTINE VF13FN( n, mgeq, meq, mcon, X, f, lc, * C, BL, BU, CL, CU ) - INTEGER :: n, mgeq, meq, mcon, lc - DOUBLE PRECISION :: f - DOUBLE PRECISION :: X( n ), BL( n ), BU( n ) - DOUBLE PRECISION :: C( lc ), CL( lc ), CU( lc ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, mgeq, meq, mcon, lc + REAL ( KIND = rp_ ) :: f + REAL ( KIND = rp_ ) :: X( n ), BL( n ), BU( n ) + REAL ( KIND = rp_ ) :: C( lc ), CL( lc ), CU( lc ) C C Evaluate the objective function and constraints. C C Nick Gould, for CGT productions. C November 1991. C - INTEGER :: i, mt, mfixed, mfixva, status - INTEGER, PARAMETER :: out = 6 - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19 + INTEGER ( KIND = ip_ ) :: i, mt, mfixed, mfixva, status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ - CALL CUTEST_cfn( status, n, mcon, X, f, C ) + CALL CUTEST_cfn_r( status, n, mcon, X, f, C ) IF ( status /= 0 ) GO TO 910 C C If there are fixed variables, shift all the inequality constraint values. @@ -312,26 +319,26 @@ SUBROUTINE VF13FN( n, mgeq, meq, mcon, X, f, lc, SUBROUTINE VF13GR( n, mgeq, meq, mcon, X, lv, V, G, * lcn, mmax, CN, BL, BU, CL, CU, firstg ) - INTEGER :: n, mgeq, meq, mcon, lv, lcn, mmax + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, mgeq, meq, mcon, lv, lcn, mmax LOGICAL :: firstg - DOUBLE PRECISION X( n ), G( n ), V( lv ), CN( lcn, mmax ) - DOUBLE PRECISION BL( n ), BU( n) - DOUBLE PRECISION CL( mmax ), CU( mmax ) + REAL ( KIND = rp_ ) X( n ), G( n ), V( lv ), CN( lcn, mmax ) + REAL ( KIND = rp_ ) BL( n ), BU( n) + REAL ( KIND = rp_ ) CL( mmax ), CU( mmax ) C C Evaluate the gradient of the objective and constraint functions. C C Nick Gould, for CGT productions, C November 1991. C - INTEGER :: i, j, mt, mfixed, mfixva, status - INTEGER, PARAMETER :: out = 6 - DOUBLE PRECISION, PARAMETER :: zero = 0.0D+0, one = 1.0D+0 - DOUBLE PRECISION, PARAMETER :: biginf = 9.0D+19 + INTEGER ( KIND = ip_ ) :: i, j, mt, mfixed, mfixva, status + INTEGER ( KIND = ip_ ), PARAMETER :: out = 6 + REAL ( KIND = rp_ ), PARAMETER :: biginf = 9.0E+19_rp_ C Evaluate the gradient of the objective and constraint functions C at the initial point in a dense format. - CALL CUTEST_cgr( status, N, mcon, X, V, .FALSE., G, + CALL CUTEST_cgr_r( status, N, mcon, X, V, .FALSE., G, * .TRUE., lcn, mmax, CN ) IF ( status /= 0 ) GO TO 910 @@ -374,24 +381,24 @@ SUBROUTINE VF13GR( n, mgeq, meq, mcon, X, lv, V, G, IF ( BL( i ) .EQ. BU( i ) ) THEN mfixva = mfixva + 1 DO 60 j = 1, n - CN( j, mfixva ) = ZERO + CN( j, mfixva ) = 0.0_rp_ 60 CONTINUE - CN( i, mfixva ) = ONE + CN( i, mfixva ) = 1.0_rp_ ELSE IF ( FIRSTG ) THEN IF ( BL( i ) .GT. - biginf ) THEN mt = mt + 1 DO 70 J = 1, N - CN( j, mt ) = ZERO + CN( j, mt ) = 0.0_rp_ 70 CONTINUE - CN( i, mt ) = ONE + CN( i, mt ) = 1.0_rp_ END IF IF ( BU( i ) .LT. biginf ) THEN mt = mt + 1 DO 80 J = 1, N - CN( j, mt ) = ZERO + CN( j, mt ) = 0.0_rp_ 80 CONTINUE - CN( i, mt ) = - ONE + CN( i, mt ) = - 1.0_rp_ END IF END IF END IF diff --git a/src/vf13/vf13_test.F b/src/vf13/vf13_test.F new file mode 100644 index 0000000..f891292 --- /dev/null +++ b/src/vf13/vf13_test.F @@ -0,0 +1,25 @@ +! THIS VERSION: CUTEST 2.2 - 2023-12-01 AT 11:50 GMT. + +#include "cutest_modules.h" + +C Dummy VF13AD for testing vf13_main interface to CUTEst + +C Nick Gould, 4th January 2013 + + SUBROUTINE VF13AD( n, m, meq, X, f, G, C, CN, lcn, maxfun, + * acc, iprint, inf, W, lw, IW ) + USE CUTEST_KINDS_precision + INTEGER ( KIND = ip_ ) :: n, m, meq, lcn, maxfun, iprint, inf, lw + REAL ( KIND = rp_ ) :: f, acc + INTEGER ( KIND = ip_ ) :: IW( n + 1 ) + REAL ( KIND = rp_ ) :: X( n ), G( n ), C( m ), CN( lcn, m ) + REAL ( KIND = rp_ ) :: W( lw ) + + IF ( inf .EQ. - 1 ) THEN + inf = 0 + ELSE + inf = 1 + END IF + RETURN + END + diff --git a/src/vf13/vf13_test.f b/src/vf13/vf13_test.f deleted file mode 100644 index 818b967..0000000 --- a/src/vf13/vf13_test.f +++ /dev/null @@ -1,21 +0,0 @@ -C ( Last modified on 5 Jan 2013 at 11:00:00 ) - -C Dummy VF13AD for testing vf13_main interface to CUTEst -C Nick Gould, 4th January 2013 - - SUBROUTINE VF13AD( n, m, meq, X, f, G, C, CN, lcn, maxfun, - * acc, iprint, inf, W, lw, IW ) - INTEGER :: n, m, meq, lcn, maxfun, iprint, inf, lw - DOUBLE PRECISION :: f, acc - INTEGER :: IW( n + 1 ) - DOUBLE PRECISION :: X( n ), G( n ), C( m ), CN( lcn, m ) - DOUBLE PRECISION :: W( lw ) - - IF ( inf .EQ. - 1 ) THEN - inf = 0 - ELSE - inf = 1 - END IF - RETURN - END - diff --git a/src/worhp/makemaster b/src/worhp/makemaster index e3b972b..ee0ae83 100644 --- a/src/worhp/makemaster +++ b/src/worhp/makemaster @@ -1,154 +1,40 @@ # Main body of the installation makefile for CUTEst WORHP interface -# S. Geffken -# This version: 3rd, February 2014 +# Nick Gould, for GALAHAD productions +# This version: 2023-12-04 -# package +# include standard CUTEst makefile defaults before package-specifics -PACKAGE = WORHP -package = worhp - -SHELL = /bin/$(BINSHELL) - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) -FFLAGS7N = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) - -CFLAGS = $(CCBASIC) $(CCISO) $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -I$(CUTEST)/include/worhp -CFLAGSN = $(CCBASIC) $(CCISO) $(NOOPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -I$(CUTEST)/include/worhp -CRUNFFLAGS = $(OPTIMIZATION) $(CCDEBUG) -I$(CUTEST)/include -I$(CUTEST)/include/worhp $(CCFFLAGS) - -# names of random libraries - -LC = $(OBJ)/libcutest.a -LCS = $(OBJS)/libcutest.a -LCD = $(OBJD)/libcutest.a - -BLC = $(OBJ)/libcutest_blas.a -BLCS = $(OBJS)/libcutest_blas.a -BLCD = $(OBJD)/libcutest_blas.a +include $(CUTEST)/src/makedefs/defaults -DLC = $(OBJ)/libcutest_dummy.a -DLCS = $(OBJS)/libcutest_dummy.a -DLCD = $(OBJD)/libcutest_dummy.a +# =========================================================================== +# ==================== package-dependent parts ============================ +# =========================================================================== -LLC = $(OBJ)/libcutest_lapack.a -LLCS = $(OBJS)/libcutest_lapack.a -LLCD = $(OBJD)/libcutest_lapack.a +# package name -# Libraries used - -#LIBS = -lcutest -lcutest_lapack -lcutest_blas -LIBS = -lcutest -PLIBS = $(LIBS) -lcutest_problem - -# Archive manipulation strings - -ARR = $(AR) -rc $(LC) -RMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LC) -RMOBFILE = $(CUTEST)/bin/rmobfile $(RM) $(OBJ) - -BARR = $(AR) -rc $(BLC) -BRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(BLC) - -DARR = $(AR) -rc $(DLC) - -LARR = $(AR) -rc $(LLC) -LRMARFILE = $(CUTEST)/bin/rmarfile $(AR) $(GREP) $(LLC) - -# compilation agenda +PACKAGE = WORHP +package = worhp -$(PACKAGE) = $(OBJ)/$(package)_main.o -C_TEST = c_elfun.o c_group.o c_range.o +# =========================================================================== +# ================= end of package-dependent parts ======================== +# =========================================================================== -SUCC = precision version) compiled successfully +EXTRAINCLUDES = -I$(CUTEST)/include/worhp -# main compilations and runs +# include standard CUTEst makefile definitions -all: $(package) +include $(CUTEST)/src/makedefs/definitions -# basic packages +# include compilation and run instructions -$(package): $(package)_$(PRECIS) - @printf ' %-21s\n' "CUTEst: $(package) ($(PRECIS) $(SUCC)" -$(package)_single: $($(PACKAGE)) -$(package)_double: $($(PACKAGE)) +include $(CUTEST)/src/makedefs/instructions -# run example tests +# select specific run test run_test: echo " No $(PACKAGE) test program at the moment" -run_test_todo: tools test_cutest $(OBJ)/$(package)_main.o - echo " Test of unconstrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(U_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/u_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/u_test.output - cat ../$(package)/u_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - echo " Test of constrained $(package)" - cd $(OBJ) ; $(CC) -o run_test \ - $(package)_main.o $(C_TEST) -L$(OBJ) $(LIBS) $(CRUNFFLAGS) - ln -fs $(CUTEST)/src/test/c_OUTSDIF.d ../$(package)/OUTSDIF.d - - $(OBJ)/run_test >& ../$(package)/c_test.output - cat ../$(package)/c_test.output - rm $(OBJ)/run_test ../$(package)/OUTSDIF.d - -test_cutest_constrained: - ( cd ../test ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - test_cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../test ) -tools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -utools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_unconstrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) -ctools: - ( cd ../tools ; $(MAKE) -f $(CUTEST)/makefiles/$(VERSION) \ - cutest_constrained PRECIS=$(PRECIS) PWD=$(PWD)/../tools ) - -# individual compilations - -$(OBJ)/$(package)_test.o: ../$(package)/$(package)_test.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_test" - $(SED) -f $(SEDS) ../$(package)/$(package)_test.c > \ - $(OBJ)/$(package)_test.c - cd $(OBJ); $(CC) -o $(package)_test.o $(CFLAGS) \ - $(package)_test.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_test.o $(CFLAGSN) $(package)_test.c ) - $(RM) $(OBJ)/$(package)_test.c - @printf '[ OK ]\n' - -# CUTEst interface main programs - -$(OBJ)/$(package)_main.o: ../$(package)/$(package)_main.c - @printf ' %-9s %-15s\t\t' "Compiling" "$(package)_main" - $(SED) -f $(SEDS) ../$(package)/$(package)_main.c > \ - $(OBJ)/$(package)_main.c - cd $(OBJ); $(CC) -o $(package)_main.o $(CFLAGS) $(package)_main.c \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CC) -o $(package)_main.o $(CFLAGSN) $(package)_main.c ) - $(RM) $(OBJ)/$(package)_main.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s\t\t' "Cleaning" - $(RM) $(OBJ)/* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' +# include standard package compilation instructions +include $(CUTEST)/src/makedefs/compile diff --git a/src/worhp/worhp_main.c b/src/worhp/worhp_main.c index 39bf156..81fa31d 100644 --- a/src/worhp/worhp_main.c +++ b/src/worhp/worhp_main.c @@ -1,3 +1,5 @@ +/* THIS VERSION: CUTEST 2.2 - 2023-12-04 AT 16:00 GMT */ + #ifndef THIS_PROBLEM_NAME #define THIS_PROBLEM_NAME "WORHP/CUTEst" #endif @@ -10,6 +12,7 @@ #define NDEBUG #include "cutest.h" +#include "cutest_routines.h" #include "worhp.h" #include #include @@ -21,25 +24,25 @@ /* Declare user functions, implementation later */ /* Objective function */ void UserF(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *g_val_dummy); + rp_ *g_val_dummy); /* Function of constraints */ void UserG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *j_val, integer *j_var, integer *j_fun); + rp_ *j_val, integer *j_var, integer *j_fun); /* Objective function and function of constraints simultaneously */ void UserF_G(OptVar *opt, Workspace *wsp, Params *par, Control *cnt); /* Gradient of objective function */ void UserDF(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *g_val, integer *g_var); + rp_ *g_val, integer *g_var); /* Jacobian of constraints */ void UserDG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *j_val, integer *j_var, integer *j_fun, - doublereal *c_dummy); + rp_ *j_val, integer *j_var, integer *j_fun, + rp_ *c_dummy); /* Gradient of objective function and Jacobian of constraints simultaneously */ void UserDF_DG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *j_val, integer *j_var, integer *j_fun); + rp_ *j_val, integer *j_var, integer *j_fun); /* Hessian of Lagrangian */ void UserHM(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *h_val, integer *h_row, integer *h_col, + rp_ *h_val, integer *h_row, integer *h_col, integer hm_nnz, integer hm_nnz_init, integer *hm_perm_inverse); @@ -69,10 +72,10 @@ int MAINENTRY() { logical *equatn = NULL; logical *linear = NULL; - doublereal *j_val = NULL; - doublereal *h_val = NULL; - doublereal *g_val = NULL; - doublereal *c_dummy = NULL; + rp_ *j_val = NULL; + rp_ *h_val = NULL; + rp_ *g_val = NULL; + rp_ *c_dummy = NULL; integer *j_fun = NULL; integer *j_var = NULL; integer *h_row = NULL; @@ -140,7 +143,7 @@ int MAINENTRY() { * cutest_status: 0 - success, 1 - alloc/dealloc error, * 2 - array bound error, 3 - eval error */ - CUTEST_cdimen(&cutest_status, &cutest_input, &opt.n, &cutest_m); + CUTEST_cdimen_r(&cutest_status, &cutest_input, &opt.n, &cutest_m); if (cutest_status != 0) { return cutest_status; } @@ -170,12 +173,12 @@ int MAINENTRY() { /* Constrained case */ MALLOC(equatn, cutest_m, logical); MALLOC(linear, cutest_m, logical); - MALLOC(c_dummy, cutest_m, doublereal); + MALLOC(c_dummy, cutest_m, rp_); - CUTEST_csetup(&cutest_status, &cutest_input, &out, &io_buffer, - &opt.n, &cutest_m, opt.X, opt.XL, opt.XU, - opt.Mu, opt.GL, opt.GU, equatn, linear, - &order_none, &order_none, &order_none); + CUTEST_csetup_r(&cutest_status, &cutest_input, &out, &io_buffer, + &opt.n, &cutest_m, opt.X, opt.XL, opt.XU, + opt.Mu, opt.GL, opt.GU, equatn, linear, + &order_none, &order_none, &order_none); #if (WORHP_MAJOR > 1 || WORHP_MINOR > 9) for (i = 0; i < opt.m; i += 1) { if (linear[i]) { @@ -184,8 +187,8 @@ int MAINENTRY() { } #endif } else { - CUTEST_usetup(&cutest_status, &cutest_input, &out, &io_buffer, - &opt.n, opt.X, opt.XL, opt.XU); + CUTEST_usetup_r(&cutest_status, &cutest_input, &out, &io_buffer, + &opt.n, opt.X, opt.XL, opt.XU); } FORTRAN_close(&cutest_input, &cutest_status); @@ -194,10 +197,10 @@ int MAINENTRY() { * Initialise structure of gradient of objective function */ MALLOC(g_var, opt.n, integer); - MALLOC(g_val, opt.n, doublereal); + MALLOC(g_val, opt.n, rp_); - CUTEST_cofsg(&cutest_status, &opt.n, opt.X, &opt.F, &g_nnz, &opt.n, - g_val, g_var, &evaluate_derivative); + CUTEST_cofsg_r(&cutest_status, &opt.n, opt.X, &opt.F, &g_nnz, &opt.n, + g_val, g_var, &evaluate_derivative); wsp.DF.nnz = g_nnz; wsp.DF.dim_perm = g_nnz; @@ -215,7 +218,7 @@ int MAINENTRY() { SortWorhpMatrix(&wsp.DF); - CUTEST_cdimsj(&cutest_status, &jac_nnz_init); + CUTEST_cdimsj_r(&cutest_status, &jac_nnz_init); if (cutest_status != 0) { WorhpError("Error retrieving number of nonzeroes in DG from CUTEst", cutest_problem, par.NLPprint); @@ -227,12 +230,13 @@ int MAINENTRY() { * structure giving method. We misuse evaluation of the Jacobian to gain * the structure. */ - MALLOC(j_val, jac_nnz_init, doublereal); + MALLOC(j_val, jac_nnz_init, rp_); MALLOC(j_var, jac_nnz_init, integer); MALLOC(j_fun, jac_nnz_init, integer); - CUTEST_ccfsg(&cutest_status, &opt.n, &cutest_m, opt.X, opt.G, &jac_nnz, - &jac_nnz_init, j_val, j_var, j_fun, &evaluate_derivative); + CUTEST_ccfsg_r(&cutest_status, &opt.n, &cutest_m, opt.X, opt.G, + &jac_nnz, &jac_nnz_init, j_val, j_var, j_fun, + &evaluate_derivative); assert(jac_nnz + opt.n == jac_nnz_init); wsp.DG.nnz = jac_nnz; /* Initialise dimension of permutation vector for sorting */ @@ -256,16 +260,16 @@ int MAINENTRY() { if (par.UserHM || par.FidifHM || par.BFGSmethod > 1) { /* Retrieve number of nonzeros in hessian from SIF */ if (opt.m > 0) { - CUTEST_cdimsh(&cutest_status, &hm_nnz_init); + CUTEST_cdimsh_r(&cutest_status, &hm_nnz_init); } else { - CUTEST_udimsh(&cutest_status, &hm_nnz_init); + CUTEST_udimsh_r(&cutest_status, &hm_nnz_init); } if (cutest_status != 0) { WorhpError("Error retrieving number of nonzeroes in HM from CUTEst", cutest_problem, par.NLPprint); } /* Allocate corresponding vectors for first initilization */ - MALLOC(h_val, hm_nnz_init, doublereal); + MALLOC(h_val, hm_nnz_init, rp_); MALLOC(h_row, hm_nnz_init, integer); MALLOC(h_col, hm_nnz_init, integer); @@ -273,11 +277,11 @@ int MAINENTRY() { /* upper triangular part. Transposition is performed */ /* by changing row and col. */ if (opt.m > 0) { - CUTEST_cshp(&cutest_status, &opt.n, - &hm_nnz, &hm_nnz_init, h_col, h_row); + CUTEST_cshp_r(&cutest_status, &opt.n, + &hm_nnz, &hm_nnz_init, h_col, h_row); } else { - CUTEST_ushp(&cutest_status, &opt.n, - &hm_nnz, &hm_nnz_init, h_col, h_row); + CUTEST_ushp_r(&cutest_status, &opt.n, + &hm_nnz, &hm_nnz_init, h_col, h_row); } is_diag_entry_present = calloc(opt.n, sizeof(bool)); num_missing_diagonal = opt.n; @@ -431,9 +435,9 @@ int MAINENTRY() { /* Deallocate SIF / Cutest memory */ if (opt.m > 0) { - CUTEST_cterminate(&cutest_status); + CUTEST_cterminate_r(&cutest_status); } else { - CUTEST_uterminate(&cutest_status); + CUTEST_uterminate_r(&cutest_status); } if (par.UserHM || par.FidifHM || par.BFGSmethod > 1) { FREE(h_val); @@ -463,15 +467,15 @@ int MAINENTRY() { void UserF(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *g_val_dummy) { + rp_ *g_val_dummy) { const logical evaluate_gradient = FALSE_; integer cutest_status; if (opt->m > 0) { - CUTEST_cofg(&cutest_status, &opt->n, opt->X, &opt->F, g_val_dummy, - &evaluate_gradient); + CUTEST_cofg_r(&cutest_status, &opt->n, opt->X, &opt->F, g_val_dummy, + &evaluate_gradient); } else { - CUTEST_ufn(&cutest_status, &opt->n, opt->X, &opt->F); + CUTEST_ufn_r(&cutest_status, &opt->n, opt->X, &opt->F); } if (cutest_status != 0) { WorhpError("Error evaluating objective function.", "CUTEst", @@ -481,13 +485,13 @@ void UserF(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, } void UserG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *j_val, integer *j_var, integer *j_fun) { + rp_ *j_val, integer *j_var, integer *j_fun) { const logical evaluate_jacobian = FALSE_; const integer cutest_m = opt->m; integer cutest_status, nnzj, nnzjN; - CUTEST_ccfsg(&cutest_status, &opt->n, &cutest_m, opt->X, opt->G, - &nnzjN, &nnzj, j_val, j_var, j_fun, &evaluate_jacobian); + CUTEST_ccfsg_r(&cutest_status, &opt->n, &cutest_m, opt->X, opt->G, + &nnzjN, &nnzj, j_val, j_var, j_fun, &evaluate_jacobian); if (cutest_status != 0) { WorhpError("Error evaluating constraint functions.", "CUTEst", par->NLPprint); @@ -499,7 +503,7 @@ void UserF_G(OptVar *opt, Workspace *wsp, Params *par, Control *cnt) { integer cutest_status; assert(opt->m > 0); - CUTEST_cfn(&cutest_status, &opt->n, &cutest_m, opt->X, &opt->F, opt->G); + CUTEST_cfn_r(&cutest_status, &opt->n, &cutest_m, opt->X, &opt->F, opt->G); if (cutest_status != 0) { WorhpError("Error evaluating objective and constraint functions " "simultaneously.", "CUTEst", par->NLPprint); @@ -508,22 +512,22 @@ void UserF_G(OptVar *opt, Workspace *wsp, Params *par, Control *cnt) { } void UserDF(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *g_val, integer *g_var) { + rp_ *g_val, integer *g_var) { const logical evaluate_gradient = TRUE_; integer cutest_status; - doublereal f_dummy; + rp_ f_dummy; int i, g_nnz; if (opt->m > 0) { - CUTEST_cofsg(&cutest_status, &opt->n, opt->X, &f_dummy, - &g_nnz, &wsp->DF.nnz, g_val, g_var, &evaluate_gradient); + CUTEST_cofsg_r(&cutest_status, &opt->n, opt->X, &f_dummy, + &g_nnz, &wsp->DF.nnz, g_val, g_var, &evaluate_gradient); assert(g_nnz == wsp->DF.nnz); for (i = 0; i < wsp->DF.nnz; i += 1) { assert(wsp->DF.row[i] == g_var[wsp->DF.perm[i] - 1]); wsp->DF.val[i] = g_val[wsp->DF.perm[i] - 1]; } } else { - CUTEST_ugr(&cutest_status, &opt->n, opt->X, wsp->DF.val); + CUTEST_ugr_r(&cutest_status, &opt->n, opt->X, wsp->DF.val); } if (cutest_status != 0) { WorhpError("Error evaluating gradient of objective function", "CUTEst", @@ -536,17 +540,17 @@ void UserDF(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, } void UserDG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *j_val, integer *j_var, integer *j_fun, - doublereal *c_dummy) { + rp_ *j_val, integer *j_var, integer *j_fun, + rp_ *c_dummy) { const logical evaluate_jacobian = TRUE_; const integer cutest_m = opt->m; integer cutest_status, allocated_nnz, written_nnz; int i; allocated_nnz = wsp->DG.nnz + opt->n; - CUTEST_ccfsg(&cutest_status, &opt->n, &cutest_m, opt->X, c_dummy, - &written_nnz, &allocated_nnz, j_val, j_var, j_fun, - &evaluate_jacobian); + CUTEST_ccfsg_r(&cutest_status, &opt->n, &cutest_m, opt->X, c_dummy, + &written_nnz, &allocated_nnz, j_val, j_var, j_fun, + &evaluate_jacobian); if (cutest_status != 0) { WorhpError("Failed to evaluate DG.", "CUTEST_ccfsg", par->NLPprint); } @@ -560,7 +564,7 @@ void UserDG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, } void UserDF_DG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *j_val, integer *j_var, integer *j_fun) { + rp_ *j_val, integer *j_var, integer *j_fun) { const logical gradient_of_lagrangian = FALSE_; const integer objective_part = 0; const integer cutest_m = opt->m; @@ -570,9 +574,9 @@ void UserDF_DG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, assert(opt->m > 0); allocated_nnz = wsp->DG.nnz + opt->n; - CUTEST_csgr(&cutest_status, &opt->n, &cutest_m, opt->X, opt->Mu, - &gradient_of_lagrangian, &written_nnz, &allocated_nnz, - j_val, j_var, j_fun); + CUTEST_csgr_r(&cutest_status, &opt->n, &cutest_m, opt->X, opt->Mu, + &gradient_of_lagrangian, &written_nnz, &allocated_nnz, + j_val, j_var, j_fun); if (cutest_status != 0) { WorhpError("Failed to evaluate DF and DG simultaneously.", "CUTEST_csgr", par->NLPprint); @@ -603,7 +607,7 @@ void UserDF_DG(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, } void UserHM(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, - doublereal *h_val, integer *h_row, integer *h_col, + rp_ *h_val, integer *h_row, integer *h_col, integer hm_nnz, integer hm_nnz_init, integer *hm_perm_inverse) { const integer objective_part = 0; const integer cutest_m = opt->m; @@ -616,11 +620,11 @@ void UserHM(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, /* Evaluate F-Part of hessian of the lagrangian */ if (opt->m > 0) { - CUTEST_cish(&cutest_status, &opt->n, opt->X, &objective_part, + CUTEST_cish_r(&cutest_status, &opt->n, opt->X, &objective_part, &hm_nnz, &hm_nnz_init, h_val, h_col, h_row); } else { - CUTEST_ush(&cutest_status, &opt->n, opt->X, &hm_nnz, &hm_nnz_init, - h_val, h_col, h_row); + CUTEST_ush_r(&cutest_status, &opt->n, opt->X, &hm_nnz, &hm_nnz_init, + h_val, h_col, h_row); } for (i = 0; i < hm_nnz; i += 1) { @@ -631,8 +635,8 @@ void UserHM(OptVar *opt, Workspace *wsp, Params *par, Control *cnt, if (opt->m > 0) { /* Evaluate G-Part of hessian of the lagrangian */ - CUTEST_cshc(&cutest_status, &opt->n, &cutest_m, opt->X, opt->Mu, - &hm_nnz, &hm_nnz_init, h_val, h_col, h_row); + CUTEST_cshc_r(&cutest_status, &opt->n, &cutest_m, opt->X, opt->Mu, + &hm_nnz, &hm_nnz_init, h_val, h_col, h_row); for (i = 0; i < hm_nnz; i += 1) { assert(wsp->HM.row[hm_perm_inverse[i]] == h_row[i]); assert(wsp->HM.col[hm_perm_inverse[i]] == h_col[i]);