lsqnonlin.c

ASUFIT－Matlab－全局拟合程序

    mxArray * LAMBDA = mclUnassigned();
    mxArray * JACOB = mclUnassigned();
    mlfVarargin(&varargin, options, 0);
    mlfEnterNewContext(0, -6, FUN, x_, LB, UB, options, varargin);
    x
      = Mlsqnonlin(
          &Resnorm,
          &FVAL,
          &EXITFLAG,
          &OUTPUT,
          &LAMBDA,
          &JACOB,
          0,
          FUN,
          x_,
          LB,
          UB,
          options,
          varargin);
    mlfRestorePreviousContext(0, 5, FUN, x_, LB, UB, options);
    mxDestroyArray(varargin);
    mxDestroyArray(x);
    mxDestroyArray(Resnorm);
    mxDestroyArray(FVAL);
    mxDestroyArray(EXITFLAG);
    mxDestroyArray(OUTPUT);
    mxDestroyArray(LAMBDA);
}

/*
 * The function "mlxLsqnonlin" contains the feval interface for the "lsqnonlin"
 * M-function from file "C:\MATLABR11\toolbox\optim\lsqnonlin.m" (lines 1-254).
 * The feval function calls the implementation version of lsqnonlin through
 * this function. This function processes any input arguments and passes them
 * to the implementation version of the function, appearing above.
 */
void mlxLsqnonlin(int nlhs, mxArray * plhs[], int nrhs, mxArray * prhs[]) {
    mxArray * mprhs[6];
    mxArray * mplhs[7];
    int i;
    if (nlhs > 7) {
        mlfError(
          mxCreateString(
            "Run-time Error: File: lsqnonlin Line: 1 Column:"
            " 0 The function \"lsqnonlin\" was called with m"
            "ore than the declared number of outputs (7)"));
    }
    for (i = 0; i < 7; ++i) {
        mplhs[i] = NULL;
    }
    for (i = 0; i < 5 && i < nrhs; ++i) {
        mprhs[i] = prhs[i];
    }
    for (; i < 5; ++i) {
        mprhs[i] = NULL;
    }
    mlfEnterNewContext(0, 5, mprhs[0], mprhs[1], mprhs[2], mprhs[3], mprhs[4]);
    mprhs[5] = NULL;
    mlfAssign(&mprhs[5], mclCreateVararginCell(nrhs - 5, prhs + 5));
    mplhs[0]
      = Mlsqnonlin(
          &mplhs[1],
          &mplhs[2],
          &mplhs[3],
          &mplhs[4],
          &mplhs[5],
          &mplhs[6],
          nlhs,
          mprhs[0],
          mprhs[1],
          mprhs[2],
          mprhs[3],
          mprhs[4],
          mprhs[5]);
    mlfRestorePreviousContext(
      0, 5, mprhs[0], mprhs[1], mprhs[2], mprhs[3], mprhs[4]);
    plhs[0] = mplhs[0];
    for (i = 1; i < 7 && i < nlhs; ++i) {
        plhs[i] = mplhs[i];
    }
    for (; i < 7; ++i) {
        mxDestroyArray(mplhs[i]);
    }
    mxDestroyArray(mprhs[5]);
}

/*
 * The function "Mlsqnonlin_fprefcnchk" is the implementation version of the
 * "lsqnonlin/fprefcnchk" M-function from file
 * "C:\MATLABR11\toolbox\optim\lsqnonlin.m" (lines 254-347). It contains the
 * actual compiled code for that M-function. It is a static function and must
 * only be called from one of the interface functions, appearing below.
 */
/*
 * function [allfcns,msg] = fprefcnchk(funstr,caller,lenVarIn,gradflag)
 */
static mxArray * Mlsqnonlin_fprefcnchk(mxArray * * msg,
                                       int nargout_,
                                       mxArray * funstr,
                                       mxArray * caller,
                                       mxArray * lenVarIn,
                                       mxArray * gradflag) {
    mxArray * allfcns = mclGetUninitializedArray();
    mxArray * ans = mclInitializeAns();
    mxArray * calltype = mclGetUninitializedArray();
    mxArray * errmsg = mclGetUninitializedArray();
    mxArray * funfcn = mclGetUninitializedArray();
    mxArray * gradfcn = mclGetUninitializedArray();
    mxArray * warnstr = mclGetUninitializedArray();
    mclValidateInputs(
      "lsqnonlin/fprefcnchk", 4, &funstr, &caller, &lenVarIn, &gradflag);
    /*
     * %PREFCNCHK Pre- and post-process function expression for FUNCHK.
     * %   [ALLFCNS,MSG] = PREFUNCHK(FUNSTR,CALLER,lenVarIn,GRADFLAG) takes
     * %   the (nonempty) expression FUNSTR from CALLER with LenVarIn extra arguments,
     * %   parses it according to what CALLER is, then returns a string or inline
     * %   object in ALLFCNS.  If an error occurs, this message is put in MSG.
     * %
     * %   ALLFCNS is a cell array: 
     * %    ALLFCNS{1} contains a flag 
     * %    that says if the objective and gradients are together in one function 
     * %    (calltype=='fungrad') or in two functions (calltype='fun_then_grad')
     * %    or there is no gradient (calltype=='fun'), etc.
     * %    ALLFCNS{2} contains the string CALLER.
     * %    ALLFCNS{3}  contains the objective function
     * %    ALLFCNS{4}  contains the gradient function (transpose of Jacobian).
     * %  
     * %    NOTE: we assume FUNSTR is nonempty.
     * % Initialize
     * msg='';
     */
    mlfAssign(msg, mxCreateString(""));
    /*
     * allfcns = {};
     */
    mlfAssign(&allfcns, mclCreateEmptyCell());
    /*
     * funfcn = [];
     */
    mlfAssign(&funfcn, mclCreateEmptyArray());
    /*
     * gradfcn = [];
     */
    mlfAssign(&gradfcn, mclCreateEmptyArray());
    /*
     * 
     * if gradflag
     */
    if (mlfTobool(gradflag)) {
        /*
         * calltype = 'fungrad';
         */
        mlfAssign(&calltype, mxCreateString("fungrad"));
    /*
     * else
     */
    } else {
        /*
         * calltype = 'fun';
         */
        mlfAssign(&calltype, mxCreateString("fun"));
    /*
     * end
     */
    }
    /*
     * 
     * % {fun}
     * if isa(funstr, 'cell') & length(funstr)==1
     */
    {
        mxArray * a_ = mclInitialize(mlfIsa(funstr, mxCreateString("cell")));
        if (mlfTobool(a_)
            && mlfTobool(
                 mlfAnd(a_, mlfEq(mlfLength(funstr), mlfScalar(1.0))))) {
            mxDestroyArray(a_);
            /*
             * % take the cellarray apart: we know it is nonempty
             * if gradflag
             */
            if (mlfTobool(gradflag)) {
                /*
                 * calltype = 'fungrad';
                 */
                mlfAssign(&calltype, mxCreateString("fungrad"));
            /*
             * end
             */
            }
            /*
             * [funfcn, msg] = fcnchk(funstr{1},lenVarIn);
             */
            mlfFeval(
              mlfVarargout(&funfcn, msg, NULL),
              mlxFcnchk,
              mlfIndexRef(funstr, "{?}", mlfScalar(1.0)),
              lenVarIn,
              NULL);
            /*
             * if ~isempty(msg)
             */
            if (mlfTobool(mlfNot(mlfIsempty(*msg)))) {
                /*
                 * error(msg);
                 */
                mlfError(*msg);
            /*
             * end
             */
            }
        /*
         * 
         * % {fun,[]}      
         * elseif isa(funstr, 'cell') & length(funstr)==2 & isempty(funstr{2})
         */
        } else {
            mxDestroyArray(a_);
            {
                mxArray * a_ = mclInitialize(
                                 mlfIsa(funstr, mxCreateString("cell")));
                if (mlfTobool(a_)) {
                    mlfAssign(
                      &a_,
                      mlfAnd(a_, mlfEq(mlfLength(funstr), mlfScalar(2.0))));
                } else {
                    mlfAssign(&a_, mlfScalar(0));
                }
                if (mlfTobool(a_)
                    && mlfTobool(
                         mlfAnd(
                           a_,
                           mlfFeval(
                             mclValueVarargout(),
                             mlxIsempty,
                             mlfIndexRef(funstr, "{?}", mlfScalar(2.0)),
                             NULL)))) {
                    mxDestroyArray(a_);
                    /*
                     * if gradflag
                     */
                    if (mlfTobool(gradflag)) {
                        /*
                         * calltype = 'fungrad';
                         */
                        mlfAssign(&calltype, mxCreateString("fungrad"));
                    /*
                     * end
                     */
                    }
                    /*
                     * [funfcn, msg] = fcnchk(funstr{1},lenVarIn);
                     */
                    mlfFeval(
                      mlfVarargout(&funfcn, msg, NULL),
                      mlxFcnchk,
                      mlfIndexRef(funstr, "{?}", mlfScalar(1.0)),
                      lenVarIn,
                      NULL);
                    /*
                     * if ~isempty(msg)
                     */
                    if (mlfTobool(mlfNot(mlfIsempty(*msg)))) {
                        /*
                         * error(msg);
                         */
                        mlfError(*msg);
                    /*
                     * end  
                     */
                    }
                /*
                 * 
                 * % {fun, grad}   
                 * elseif isa(funstr, 'cell') & length(funstr)==2 % and ~isempty(funstr{2})
                 */
                } else {
                    mxDestroyArray(a_);
                    {
                        mxArray * a_ = mclInitialize(
                                         mlfIsa(
                                           funstr, mxCreateString("cell")));
                        if (mlfTobool(a_)
                            && mlfTobool(
                                 mlfAnd(
                                   a_,
                                   mlfEq(
                                     mlfLength(funstr), mlfScalar(2.0))))) {
                            mxDestroyArray(a_);
                            /*
                             * 
                             * [funfcn, msg] = fcnchk(funstr{1},lenVarIn);
                             */
                            mlfFeval(
                              mlfVarargout(&funfcn, msg, NULL),
                              mlxFcnchk,
                              mlfIndexRef(funstr, "{?}", mlfScalar(1.0)),
                              lenVarIn,
                              NULL);
                            /*
                             * if ~isempty(msg)
                             */
                            if (mlfTobool(mlfNot(mlfIsempty(*msg)))) {
                                /*
                                 * error(msg);
                                 */
                                mlfError(*msg);
                            /*
                             * end  
                             */
                            }
                            /*
                             * [gradfcn, msg] = fcnchk(funstr{2},lenVarIn);
                             */
                            mlfFeval(
                              mlfVarargout(&gradfcn, msg, NULL),
                              mlxFcnchk,
                              mlfIndexRef(funstr, "{?}", mlfScalar(2.0)),
                              lenVarIn,
                              NULL);
                            /*
                             * if ~isempty(msg)
                             */
                            if (mlfTobool(mlfNot(mlfIsempty(*msg)))) {
                                /*
                                 * error(msg);
                                 */
                                mlfError(*msg);
                            /*
                             * end
                             */
                            }
                            /*
                             * calltype = 'fun_then_grad';
                             */
                            mlfAssign(
                              &calltype, mxCreateString("fun_then_grad"));
                            /*
                             * if ~gradflag
                             */
                            if (mlfTobool(mlfNot(gradflag))) {
                                /*
                                 * warnstr = ...
                                 */
                                mlfAssign(
                                  &warnstr,
                                  mlfSprintf(
                                    NULL,
                                    mxCreateString("%s\\n%s\\n%s\\n"),
                                    mxCreateString(
                                      "Jacobian function provided b"
                                      "ut OPTIONS.Jacobian='off';"),
                                    mxCreateString(
                                      "  ignoring Jacobian function an"
                                      "d using finite-differencing."),
                                    mxCreateString(
                                      "  Rerun with OPTIONS.Jacobian='"
                                      "on' to use Jacobian function."),
                                    NULL));
                                /*
                                 * sprintf('%s\n%s\n%s\n','Jacobian function provided but OPTIONS.Jacobian=''off'';', ...
                                 * '  ignoring Jacobian function and using finite-differencing.', ...