double ampl_get_Obj(double *varsX) { double objv=0; fint nerror = -1; if(varsX){ objv = objval(nobj, varsX, &nerror); }else{ double *dxWrk = (double*) malloc (n_var*sizeof(double)); objv = objval(nobj, dxWrk, &nerror); free(dxWrk); } return objv; }
double Ampl_Eval_Obj(ASL_pfgh *asl_, double *varsX) { ASL_pfgh *asl = asl_; double objv=0; fint nerror = -1; if(varsX){ objv = objval(nobj, varsX, &nerror); }else{ double *dxWrk = (double*) malloc (n_var*sizeof(double)); objv = objval(nobj, dxWrk, &nerror); free(dxWrk); } return objv; }
void JSObjectBuilder::ArrayPush(JS::HandleObject aArray, int value) { if (!mOk) return; uint32_t length; mOk = JS_GetArrayLength(mCx, aArray, &length); if (!mOk) return; JS::RootedValue objval(mCx, INT_TO_JSVAL(value)); mOk = JS_SetElement(mCx, aArray, length, &objval); }
/** This method to returns the value of an alternative objective function for upper bounding (if one has been declared by using the prefix UBObj).*/ bool AmplTMINLP::eval_upper_bound_f(Index n, const Number* x, Number& obj_value) { ASL_pfgh* asl = ampl_tnlp_->AmplSolverObject(); //xknown(x); // This tells ampl to use a new x fint nerror = -1; obj_value = objval(upperBoundingObj_, const_cast<double *>(x), &nerror); if (nerror > 0) { jnlst_->Printf(J_ERROR, J_MAIN, "Error in evaluating upper bounding objecting"); throw -1; } return nerror; }
void JSObjectBuilder::ArrayPush(JS::HandleObject aArray, const char *value) { if (!mOk) return; JS::RootedString string(mCx, JS_NewStringCopyN(mCx, value, strlen(value))); if (!string) { mOk = false; return; } uint32_t length; mOk = JS_GetArrayLength(mCx, aArray, &length); if (!mOk) return; JS::RootedValue objval(mCx, STRING_TO_JSVAL(string)); mOk = JS_SetElement(mCx, aArray, length, &objval); }
static bool internal_objval(CbcAmplInfo * info , double & obj_val) { ASL_pfgh* asl = info->asl_; info->objval_called_with_current_x_ = false; // in case the call below fails if (n_obj == 0) { obj_val = 0; info->objval_called_with_current_x_ = true; return true; } else { double retval = objval(0, info->non_const_x_, (fint*)&info->nerror_); if (!info->nerror_) { obj_val = info->obj_sign_ * retval; info->objval_called_with_current_x_ = true; return true; } else { abort(); } } return false; }
bool AmplTNLP::internal_objval(const Number* x, Number& obj_val) { DBG_START_METH("AmplTNLP::internal_objval", dbg_verbosity); ASL_pfgh* asl = asl_; DBG_ASSERT(asl_); objval_called_with_current_x_ = false; // in case the call below fails if (n_obj==0) { obj_val = 0; objval_called_with_current_x_ = true; return true; } else { Number retval = objval(obj_no, const_cast<Number*>(x), (fint*)nerror_); if (nerror_ok(nerror_)) { obj_val = obj_sign_*retval; objval_called_with_current_x_ = true; return true; } } return false; }
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { ASL_pfgh *asl = (ASL_pfgh*)cur_ASL; FILE *nl; Jmp_buf err_jmp0; cgrad *cg, **cgp; char *buf1, buf[512], *what, **whatp; fint *hcs, *hr, i, nerror; int *cs; mwIndex *Ir, *Jc; real *H, *He, *J1, *W, *c, *f, *g, *v, *t, *x; static fint n, nc, nhnz, nz; static real *Hsp; static char ignore_complementarity[] = "Warning: ignoring %d complementarity conditions.\n"; if (nrhs == 1 && mxIsChar(prhs[0])) { if (nlhs < 6 || nlhs > 7) usage(); if (mxGetString(prhs[0], buf1 = buf, sizeof(buf))) mexErrMsgTxt("Expected 'stub' as argument\n"); at_end(); mexAtExit(at_end); asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh); return_nofile = 1; if (!(nl = jac0dim(buf1,strlen(buf)))) { sprintf(msgbuf, "Can't open %.*s\n", sizeof(msgbuf)-20, buf); mexErrMsgTxt(msgbuf); } if (n_obj <= 0) printf("Warning: objectve == 0\n"); n = n_var; nc = n_con; nz = nzc; X0 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL)); LUv = mxGetPr(plhs[1] = mxCreateDoubleMatrix(n, 1, mxREAL)); Uvx = mxGetPr(plhs[2] = mxCreateDoubleMatrix(n, 1, mxREAL)); pi0 = mxGetPr(plhs[3] = mxCreateDoubleMatrix(nc, 1, mxREAL)); LUrhs = mxGetPr(plhs[4] = mxCreateDoubleMatrix(nc, 1, mxREAL)); Urhsx = mxGetPr(plhs[5] = mxCreateDoubleMatrix(nc, 1, mxREAL)); if (nlhs == 7) { cvar = (int*)M1alloc(nc*sizeof(int)); plhs[6] = mxCreateDoubleMatrix(nc, 1, mxREAL); x = mxGetPr(plhs[6]); } else if (n_cc) printf(ignore_complementarity, n_cc); pfgh_read(nl, ASL_findgroups); if (nlhs == 7) for(i = 0; i < nc; i++) x[i] = cvar[i]; /* Arrange to compute the whole sparese Hessian */ /* of the Lagrangian function (both triangles). */ nhnz = sphsetup(0, 0, nc > 0, 0); Hsp = (real *)M1alloc(nhnz*sizeof(real)); return; } if (!asl) mexErrMsgTxt("spamfunc(\"stub\") has not been called\n"); nerror = -1; err_jmp1 = &err_jmp0; what = "(?)"; whatp = &what; if (nlhs == 2) { if (nrhs != 2) usage(); x = sizechk(prhs[0],"x",n); t = sizechk(prhs[1],"0 or 1", 1); if (setjmp(err_jmp0.jb)) { sprintf(msgbuf, "Trouble evaluating %s\n", *whatp); mexErrMsgTxt(msgbuf); } if (t[0] == 0.) { f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL)); c = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, 1, mxREAL)); what = "f"; *f = n_obj > 0 ? objval(0, x, &nerror) : 0; what = "c"; conval(x, c, &nerror); return; } g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL)); J1 = mxGetPr(plhs[1] = mxCreateSparse(nc, n, nz, mxREAL)); what = "g"; if (n_obj > 0) objgrd(0, x, g, &nerror); else memset(g, 0, n*sizeof(real)); if (nc) { what = "J"; jacval(x, J1, &nerror); Ir = mxGetIr(plhs[1]); /*memcpy(mxGetJc(plhs[1]), A_colstarts, (n+1)*sizeof(int));*/ for(Jc = mxGetJc(plhs[1]), cs = A_colstarts, i = 0; i <= n; ++i) Jc[i] = cs[i]; cgp = Cgrad; for(i = 0; i < nc; i++) for(cg = *cgp++; cg; cg = cg->next) Ir[cg->goff] = i; } return; } if (nlhs == 0 && (nrhs == 3 || nrhs == 4)) { /* eval2('solution message', x, v): x = primal, v = dual */ /* optional 4th arg = solve_result_num */ if (!mxIsChar(prhs[0])) usage(); x = sizechk(prhs[1],"x",n); v = sizechk(prhs[2],"v",nc); if (mxGetString(prhs[0], buf, sizeof(buf))) mexErrMsgTxt( "Expected 'solution message' as first argument\n"); solve_result_num = nrhs == 3 ? -1 /* unknown */ : (int)*sizechk(prhs[3],"solve_result_num",1); write_sol(buf, x, v, 0); return; } if (nlhs != 1 || nrhs != 1) usage(); v = sizechk(prhs[0],"v",nc); W = mxGetPr(plhs[0] = mxCreateSparse(n, n, nhnz, mxREAL)); what = "W"; sphes(H = Hsp, 0, 0, v); /* Expand the Hessian lower triangle into the full Hessian... */ Ir = mxGetIr(plhs[0]); Jc = mxGetJc(plhs[0]); hcs = sputinfo->hcolstarts; hr = sputinfo->hrownos; for(i = 0; i <= n; i++) Jc[i] = hcs[i]; He = H + hcs[n]; while(H < He) { *W++ = *H++; *Ir++ = *hr++; } }
int main ( int argc, char **argv ) { FILE * nl; char * stub; FILE * point_file; char * point_file_name; int point_file_name_size; fint nerror = (fint)0; int n_badvals = 0; int n_con_tmp = 0; int i; real f; real * R; if( argc < 2 ) { fprintf ( stderr , "Usage: %s x.txt\n" , argv[0] ); return 1; } // get the point file name: point_file_name_size = strlen(argv[1]) + 1; point_file_name = (char*)Malloc(point_file_name_size * sizeof(char)); strcpy ( point_file_name , argv[1] ); strcpy ( argv[1] , MODEL_NAME ); // Read objectives and first derivative information. if( !(asl = ASL_alloc(ASL_read_fg)) ) exit(1); stub = getstub(&argv, &Oinfo); nl = jac0dim(stub, (fint)strlen(stub)); // Get command-line options. if (getopts(argv, &Oinfo)) exit(1); // Check command-line options. if( showgrad < 0 || showgrad > 1 ) { Printf("Invalid value for showgrad: %d\n", showgrad); n_badvals++; } if( showname < 0 || showname > 1 ) { Printf("Invalid value for showgrad: %d\n", showgrad); n_badvals++; } if(n_badvals) { Printf("Found %d errors in command-line options.\n", n_badvals); exit(1); } // Allocate memory for problem data. // The variables below must have precisely THESE names. X0 = (real*)Malloc(n_var * sizeof(real)); // Initial guess pi0 = (real*)Malloc(n_con * sizeof(real)); // Initial multipliers LUv = (real*)Malloc(n_var * sizeof(real)); // Lower bounds on variables Uvx = (real*)Malloc(n_var * sizeof(real)); // Upper bounds on variables LUrhs = (real*)Malloc(n_con * sizeof(real)); // Lower bounds on constraints Urhsx = (real*)Malloc(n_con * sizeof(real)); // Upper bounds on constraints R = (real*)Malloc(n_con * sizeof(real)); // constraints want_xpi0 = 3; // Read in ASL structure - trap read errors if( fg_read(nl, 0) ) { fprintf(stderr, "Error fg-reading nl file\n"); goto bailout; } #ifdef DISPLAY n_con_tmp = 0; for ( i = 0 ; i < n_con ; ++i ) { if ( LUrhs[i] > -Infinity ) ++n_con_tmp; if ( Urhsx[i] < Infinity ) ++n_con_tmp; } printf ( "n_obj=%i\nn_var=%i\nn_con=%i\nx0=[" , n_obj , n_var , n_con_tmp ); for ( i = 0 ; i < n_var ; ++i ) printf ( "%g " , X0[i] ); printf ( "]\n" ); #endif // read x: if ((point_file = fopen(point_file_name,"r")) == NULL) { fprintf(stderr, "Cannot open file %s.\n",point_file_name); goto bailout; } for ( i = 0 ; i < n_var ; ++i ) fscanf ( point_file , "%lf" , &X0[i] ); fclose(point_file); free ( point_file_name ); #ifdef DISPLAY printf ( "x =[" ); for ( i = 0 ; i < n_var ; ++i ) printf ( "%g " , X0[i] ); printf ( "]\n" ); #endif // objective functions: for ( i = 0 ; i < n_obj ; ++i ) { f = objval ( i , X0 , &nerror ); if ( nerror ) { fprintf(stderr, "Error while evaluating objective.\n"); goto bailout; } #ifdef DISPLAY Printf("f%i(x) = %21.15e\n", i , f ); #else Printf("%21.15e\n", f ); #endif } // constraints: conval ( X0 , R , &nerror ); for ( i = 0 ; i < n_con ; ++i ) { #ifdef DISPLAY printf ("%g <= %g <= %g\n" , LUrhs[i] , R[i] , Urhsx[i] ); #else if ( LUrhs[i] > -Infinity ) Printf("%21.15e\n", LUrhs[i]-R[i] ); if ( Urhsx[i] < Infinity ) Printf("%21.15e\n", R[i]-Urhsx[i] ); #endif } bailout: // Free data structure. DO NOT use free() on X0, pi0, etc. ASL_free((ASL**)(&asl)); return 0; }
int main(int argc, char **argv) { FILE *nl; char *stub; fint nerror = (fint)0; int n_badvals = 0; real f; if( argc < 2 ) { fprintf(stderr, "Usage: %s stub\n", argv[0]); return 1; } // Read objectives and first derivative information. if( !(asl = ASL_alloc(ASL_read_fg)) ) exit(1); stub = getstub(&argv, &Oinfo); nl = jac0dim(stub, (fint)strlen(stub)); // Get command-line options. if (getopts(argv, &Oinfo)) exit(1); // Check command-line options. if( showgrad < 0 || showgrad > 1 ) { Printf("Invalid value for showgrad: %d\n", showgrad); n_badvals++; } if( showname < 0 || showname > 1 ) { Printf("Invalid value for showname: %d\n", showname); n_badvals++; } if(n_badvals) { Printf("Found %d errors in command-line options.\n", n_badvals); exit(1); } // Allocate memory for problem data. // The variables below must have precisely THESE names. X0 = (real*)Malloc(n_var * sizeof(real)); // Initial guess pi0 = (real*)Malloc(n_con * sizeof(real)); // Initial multipliers LUv = (real*)Malloc(n_var * sizeof(real)); // Lower bounds on variables Uvx = (real*)Malloc(n_var * sizeof(real)); // Upper bounds on variables LUrhs = (real*)Malloc(n_con * sizeof(real)); // Lower bounds on constraints Urhsx = (real*)Malloc(n_con * sizeof(real)); // Upper bounds on constraints want_xpi0 = 3; // Read in ASL structure - trap read errors if( fg_read(nl, 0) ) { fprintf(stderr, "Error fg-reading nl file\n"); goto bailout; } if(showname) { // Display objective name if requested. Printf("Objective name: %s\n", obj_name(0)); } // This "solver" outputs the objective function value at X0. f = objval(0, X0, &nerror); if(nerror) { fprintf(stderr, "Error while evaluating objective.\n"); goto bailout; } Printf("f(x0) = %21.15e\n", f); // Optionally also output objective gradient at X0. if(showgrad) { real *g = (real*)malloc(n_var * sizeof(real)); objgrd(0, X0, g, &nerror); Printf("g(x0) = [ "); for(int i=0; i<n_var; i++) Printf("%8.1e ", g[i]); Printf("]\n"); free(g); } // Write solution to file. Here we just write the initial guess. Oinfo.wantsol = 9; // Suppress message echo. Force .sol writing write_sol(CHR"And the winner is", X0, pi0, &Oinfo); bailout: // Free data structure. DO NOT use free() on X0, pi0, etc. ASL_free((ASL**)(&asl)); return 0; }
void mexFunction(int nlhs, Matrix **plhs, int nrhs, Matrix **prhs) { FILE *nl; char *buf1, buf[512], *what; static fint n, nc, nz; fint nerror; real *J1, *W, *c, *f, *g, *v, *t, *x; static real *J; cgrad *cg, **cgp; static size_t Jsize; Jmp_buf err_jmp0; ASL_pfgh *asl = (ASL_pfgh*)cur_ASL; static fint nhnz; static real *Hsp; real *H, *He; int *Ir, *Jc; fint *hcs, *hr, i; if (nrhs == 1 && mxIsString(prhs[0])) { if (nlhs != 6) usage(); if (mxGetString(prhs[0], buf1 = buf, sizeof(buf))) mexErrMsgTxt("Expected 'stub' as argument\n"); at_end(); mexAtExit(at_end); asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh); return_nofile = 1; if (!(nl = jac0dim(buf1,strlen(buf)))) { sprintf(msgbuf, "Can't open %.*s\n", sizeof(msgbuf)-20, buf); mexErrMsgTxt(msgbuf); } if (n_obj <= 0) printf("Warning: objectve == 0\n"); n = n_var; nc = n_con; nz = nzc; J = (real *)M1alloc(nz*sizeof(real)); X0 = mxGetPr(plhs[0] = mxCreateFull(n, 1, REAL)); LUv = mxGetPr(plhs[1] = mxCreateFull(n, 1, REAL)); Uvx = mxGetPr(plhs[2] = mxCreateFull(n, 1, REAL)); pi0 = mxGetPr(plhs[3] = mxCreateFull(nc, 1, REAL)); LUrhs = mxGetPr(plhs[4] = mxCreateFull(nc, 1, REAL)); Urhsx = mxGetPr(plhs[5] = mxCreateFull(nc, 1, REAL)); pfgh_read(nl, ASL_findgroups); Jsize = nc*n*sizeof(real); /* Arrange to compute the whole sparese Hessian */ /* of the Lagrangian function (both triangles). */ nhnz = sphsetup(0, 0, nc > 0, 0); Hsp = (real *)M1alloc(nhnz*sizeof(real)); return; } if (!filename) mexErrMsgTxt("spamfunc(\"stub\") has not been called\n"); nerror = -1; err_jmp1 = &err_jmp0; if (nlhs == 2) { if (nrhs != 2) usage(); x = sizechk(prhs[0],"x",n); t = sizechk(prhs[1],"0 or 1", 1); if (t[0] == 0.) { f = mxGetPr(plhs[0] = mxCreateFull(1, 1, REAL)); c = mxGetPr(plhs[1] = mxCreateFull(nc, 1, REAL)); if (setjmp(err_jmp0.jb)) { sprintf(msgbuf, "Trouble evaluating %s\n", what); mexErrMsgTxt(msgbuf); } what = "f"; *f = objval(0, x, &nerror); what = "c"; conval(x, c, &nerror); return; } g = mxGetPr(plhs[0] = mxCreateFull(n, 1, REAL)); J1 = mxGetPr(plhs[1] = mxCreateSparse(nc, n, nz, REAL)); what = "g"; objgrd(0, x, g, &nerror); if (nc) { what = "J"; jacval(x, J1, &nerror); Ir = mxGetIr(plhs[1]); memcpy(mxGetJc(plhs[1]), A_colstarts, (n+1)*sizeof(int)); cgp = Cgrad; for(i = 0; i < nc; i++) for(cg = *cgp++; cg; cg = cg->next) Ir[cg->goff] = i; } return; } if (nlhs == 0 && nrhs == 3) { /* eval2('solution message', x, v): x = primal, v = dual */ if (!mxIsString(prhs[0])) usage(); x = sizechk(prhs[1],"x",n); v = sizechk(prhs[2],"v",nc); if (mxGetString(prhs[0], buf, sizeof(buf))) mexErrMsgTxt( "Expected 'solution message' as first argument\n"); write_sol(buf, x, v, 0); return; } if (nlhs != 1 || nrhs != 1) usage(); v = sizechk(prhs[0],"v",nc); W = mxGetPr(plhs[0] = mxCreateSparse(n, n, nhnz, REAL)); what = "W"; sphes(H = Hsp, 0, 0, v); /* Expand the Hessian lower triangle into the full Hessian... */ Ir = mxGetIr(plhs[0]); Jc = mxGetJc(plhs[0]); hcs = sputinfo->hcolstarts; hr = sputinfo->hrownos; for(i = 0; i <= n; i++) Jc[i] = hcs[i]; He = H + hcs[n]; while(H < He) { *W++ = *H++; *Ir++ = *hr++; } }
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { //Possible Inputs char fpath[FLEN]; char msg[FLEN]; char cmd[FLEN]; //user commmand int sp = 0; //Outputs const char *fnames[15] = {"H","f","lb","ub","A","cl","cu","Q","l","qcind","x0","v0","sense","objbias","conlin"}; double *sizes; //Internal Vars int ii; size_t i,j,k; //indexing vars char *what, **whatp; //error message vars static FILE *nl; //file handle ASL *asl = cur_ASL; //Current ASL instance int icmd = ASLCMD_ERROR; //Command Integer double *sense; //Objective sense double *objbias; //Objective bias int obj_lin; //linearity of the objectiuve (see ASL_DEGREE_ defines) double *con_lin; //linearity of the constraints (see ASL_DEGREE_ defines) double *isopen; //Is ASL open bool nlcon = false; //indicates whether any constraint is nonlinear double *x; //Evaluation point double *f, *g, *c = NULL; //Return pointers int nerror; //eval errors //Sparse Indexing mwIndex *Ir, *Jc; double *Pr; //QP Checking Vars int nqpz = 0; //number of nzs in quadratic objective int nqc_con = 0; //number of quadratic constraints int *QP_ir, *QP_jc; //Pointers used when calling nqpcheck double *QP_pr; double *pqi; //pointer to quadratic index vector ograd *og; //objective gradient structure //Jacobian Vars static double *J = NULL; //Memory to store intermediate Jacobian Values when using Dense Mode static double *J1 = NULL; //Memory to store Jacobian Values cgrad *cg, **cgp, **cgpe; //constraint gradient structures int *cs; //Column starts //Hessian Vars static double *Hsp = NULL; //Memory to store Hessian Values static int nhnz; //Number of Hessian nz double *s, *v; //Sigma, Lambda int *hcs, *hr; //Hessian column starts, row indexs double *H, *He, *W; //Error catching Jmp_buf err_jmp0; //If no inputs, just return info if(nrhs < 1) { if (nlhs >= 1) { sprintf(msgbuf,"%s %s",__TIME__,__DATE__); plhs[0] = mxCreateString(msgbuf); plhs[1] = mxCreateDoubleScalar(OPTI_VER); } else { printUtilityInfo(); } return; } //Get User Command icmd = getCommand(prhs[0]); //Switch Yard for Command switch(icmd) { case ASLCMD_ISOPEN: isopen = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL)); if(asl) *isopen = 1; else *isopen = 0; break; case ASLCMD_OPEN: //Check for Errors if(nrhs < 2) mexErrMsgTxt("Expected two arguments to open a file! [x0,v0,lb,ub,cl,cu,sense,sizes] = asl('open','file path')\n"); if(!mxIsChar(prhs[1])) mexErrMsgTxt("File path must be a char array!"); //Get String CHECK(mxGetString(prhs[1], fpath, FLEN) == 0,"error reading file path!"); //Clear any existing objects if (cur_ASL) ASL_free(&cur_ASL); //Set MEX exit function mexAtExit(mexExit); //Open file for LP/QP/QCQP checking asl = ASL_alloc(ASL_read_fg); //allocate for qp read return_nofile = 1; //return 0 if stub doesn't exist nl = jac0dim(fpath,(ftnlen)strlen(fpath)); //read in passed file //Check we got the file if(!nl) { sprintf(msgbuf, "Can't open (or error opening) %s\n", fpath); mexErrMsgTxt(msgbuf); } //Allocate Vector Memory pPROB = mxCreateStructMatrix(1,1,15,fnames); mxSetField(pPROB,0,fnames[eX0],mxCreateDoubleMatrix(n_var,1, mxREAL)); mxSetField(pPROB,0,fnames[eV0],mxCreateDoubleMatrix(n_con, 1, mxREAL)); mxSetField(pPROB,0,fnames[eLB],mxCreateDoubleMatrix(n_var, 1, mxREAL)); mxSetField(pPROB,0,fnames[eUB],mxCreateDoubleMatrix(n_var, 1, mxREAL)); mxSetField(pPROB,0,fnames[eCL],mxCreateDoubleMatrix(n_con, 1, mxREAL)); mxSetField(pPROB,0,fnames[eCU],mxCreateDoubleMatrix(n_con, 1, mxREAL)); mxSetField(pPROB,0,fnames[eSENSE],mxCreateDoubleMatrix(1, 1, mxREAL)); mxSetField(pPROB,0,fnames[eOBJBIAS],mxCreateDoubleMatrix(1, 1, mxREAL)); mxSetField(pPROB,0,fnames[eCONLIN],mxCreateDoubleMatrix(n_con, 1, mxREAL)); //Get Fields (ASL will fill) X0 = mxGetPr(mxGetField(pPROB,0,fnames[eX0])); pi0 = mxGetPr(mxGetField(pPROB,0,fnames[eV0])); LUv = mxGetPr(mxGetField(pPROB,0,fnames[eLB])); Uvx = mxGetPr(mxGetField(pPROB,0,fnames[eUB])); LUrhs = mxGetPr(mxGetField(pPROB,0,fnames[eCL])); Urhsx = mxGetPr(mxGetField(pPROB,0,fnames[eCU])); sense = mxGetPr(mxGetField(pPROB,0,fnames[eSENSE])); objbias = mxGetPr(mxGetField(pPROB,0,fnames[eOBJBIAS])); con_lin = mxGetPr(mxGetField(pPROB,0,fnames[eCONLIN])); //Other Output Args sizes = mxGetPr(pSIZE = mxCreateDoubleMatrix(16, 1, mxREAL)); //Check for complementarity problems if(n_cc) mexWarnMsgTxt("Ignoring Complementarity Constraints!"); //Assign asl problem sizes sizes[0] = (double)n_var; sizes[1] = (double)n_con; sizes[2] = (double)nzc; sizes[3] = (double)lnc; sizes[4] = (double)nbv; sizes[5] = (double)niv; sizes[6] = (double)nlc; sizes[7] = (double)nlnc; sizes[8] = (double)nlo; sizes[9] = (double)nlvb; sizes[10] = (double)nlvc; sizes[11] = (double)nlvo; sizes[12] = (double)nlvbi; sizes[13] = (double)nlvci; sizes[14] = (double)nlvoi; sizes[15] = (double)nwv; //Read In For QP Checking qp_read(nl,0); //Assign sense if(objtype[0] == 1) *sense = -1; //max else *sense = 1; //min //Determine Objective Linearity obj_lin = linCheck(asl, 0); //Determine Constraints Linearity for(ii = 0; ii < n_con; ii++) { con_lin[ii] = linCheck(asl, -(ii+1)); //Check if nonlinear or quadratic if(con_lin[ii] >= ASL_DEGREE_NLIN) nlcon = true; else if(con_lin[ii] == ASL_DEGREE_QUAD) { //con_lin indicates quadratic constraint, ensure is inequality if(LUrhs[ii] != Urhsx[ii]) nqc_con++; else nlcon = true; //quadratic equalities not currently handled by any explicit QCQP solver (I know of), make nl } } //Check to force to read as nonlinear problem if(nrhs > 2 && *mxGetPr(prhs[2])==1) nlcon = true; //If objective or any constraint is nonlinear, then we have to process as an NLP if(obj_lin == ASL_DEGREE_NLIN || nlcon) { //Free the QP read memory ASL_free(&asl); //Re-open for full NLP read asl = ASL_alloc(ASL_read_pfgh); //allocate memory for pfgh read nl = jac0dim(fpath,(ftnlen)strlen(fpath)); //read passed file (full nl read) //Allocate Jacobian Memory [note use M1alloc to let ASL clean it up if multiple instances opened] J = (double*)M1alloc(nzc*sizeof(double)); //Memory to store Jacobian nzs //Assign memory for saving obj + con x objx = (double*)M1alloc(n_var*sizeof(double)); conx = (double*)M1alloc(n_var*sizeof(double)); //Read File (f + g + H) pfgh_read(nl, ASL_findgroups); //Assign Hessian Memory nhnz = sphsetup(1, 1, n_con > 0, 0); //one obj, use sigma, optionally use lambda, full hessian Hsp = (double*)M1alloc(nhnz*sizeof(double)); //memory to store hessian nzs } //Otherwise we can process as a LP, QP or QCQP else { //Assign objective bias *objbias = objconst(0); //Check for quadratic objective if(obj_lin == ASL_DEGREE_QUAD) { //Capture Pointers nqpz = nqpcheck(0, &QP_ir, &QP_jc, &QP_pr); //check objective for qp //Create QP H mxSetField(pPROB,0,fnames[eH],mxCreateSparse(n_var,n_var,nqpz,mxREAL)); //Copy in Objective Quadratic Elements (copy-cast where appropriate) memcpy(mxGetPr(mxGetField(pPROB,0,fnames[eH])),QP_pr,nqpz*sizeof(double)); Jc = mxGetJc(mxGetField(pPROB,0,fnames[eH])); Ir = mxGetIr(mxGetField(pPROB,0,fnames[eH])); for(i = 0; i <= n_var; i++) Jc[i] = (mwIndex)QP_jc[i]; for(i = 0; i < nqpz; i++) Ir[i] = (mwIndex)QP_ir[i]; } else //create an empty sparse matrix mxSetField(pPROB,0,fnames[eH],mxCreateSparse(n_var,n_var,0,mxREAL)); //Create QP f mxSetField(pPROB,0,fnames[eF],mxCreateDoubleMatrix(n_var,1,mxREAL)); Pr = mxGetPr(mxGetField(pPROB,0,fnames[eF])); //Copy in Objective Linear Elements for( og = Ograd[0]; og; og = og->next ) Pr[og->varno] = og->coef; //Create A (linear constraints) mxSetField(pPROB,0,fnames[eA],mxCreateSparse(n_con, n_var, nzc, mxREAL)); if(n_con) { Pr = mxGetPr(mxGetField(pPROB,0,fnames[eA])); Ir = mxGetIr(mxGetField(pPROB,0,fnames[eA]));; //Fill in A (will double on quadratic linear sections, but easier to remove once in MATLAB) for(Jc = mxGetJc(mxGetField(pPROB,0,fnames[eA])), cs = A_colstarts, i = 0; i <= n_var; ++i) Jc[i] = (mwIndex)cs[i]; cgp = Cgrad; for(i = 0; i < n_con; i++) for(cg = *cgp++; cg; cg = cg->next) { Ir[cg->goff] = (mwIndex)i; Pr[cg->goff] = cg->coef; } } //Add quadratic constraints if present if(nqc_con) { //Allocate a Cell Array to store the quadratic constraint Qs, and vector to store indices mxSetField(pPROB,0,fnames[eQ],mxCreateCellMatrix(nqc_con,1)); //Q mxSetField(pPROB,0,fnames[eL],mxCreateDoubleMatrix(n_var, nqc_con,mxREAL)); //l mxSetField(pPROB,0,fnames[eQCIND],mxCreateDoubleMatrix(nqc_con,1,mxREAL)); //ind pqi = mxGetPr(mxGetField(pPROB,0,fnames[eQCIND])); //Fill In Constraints for(ii=0,j=0;ii<n_con;ii++) { //Quadratic Constraints if(con_lin[ii] == ASL_DEGREE_QUAD) { //Create index pqi[j] = ii+1; //increment for matlab index //Capture Pointers nqpz = nqpcheck(-(ii+1), &QP_ir, &QP_jc, &QP_pr); //check constraint for qp; if(nqpz <= 0) mexErrMsgTxt("Error reading quadratic constraints. Assumed constraint was quadratic based on prescan, now appears not?"); //Create QC Q mxSetCell(mxGetField(pPROB,0,fnames[eQ]),j,mxCreateSparse(n_var,n_var,nqpz,mxREAL)); //Copy in Constraint Quadratic Elements (copy-cast where appropriate) Pr = mxGetPr(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j)); Jc = mxGetJc(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j)); Ir = mxGetIr(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j)); for(k = 0; k <= n_var; k++) Jc[k] = (mwIndex)QP_jc[k]; for(k = 0; k < nqpz; k++) { Ir[k] = (mwIndex)QP_ir[k]; Pr[k] = 0.5*QP_pr[k]; //to QP form } //Create QC l (not sure why we can't extract this from Jacobian, values are wrong) Pr = mxGetPr(mxGetField(pPROB,0,fnames[eL])); for( cg = Cgrad[ii]; cg; cg = cg->next ) Pr[j*n_var + cg->varno] = cg->coef; //Increment for next cell / col j++; } } } //Put back into function eval mode (just in case) qp_opify(); } break; case ASLCMD_CLOSE: //Check for Errors CHECKASL(asl); //Call Exit Function mexExit(); break; case ASLCMD_FUN: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,2); //Get x and check dimensions x = sizechk(prhs[1],"x",n_var); //Save x if(objx) memcpy(objx,x,n_var*sizeof(double)); //Create objective val memory and get it from ASL SETERRJMP(); what = "objective"; f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL)); *f = objval(0, x, &nerror); break; case ASLCMD_GRAD: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,2); //Get x and check dimensions x = sizechk(prhs[1],"x",n_var); //Save x if(objx) memcpy(objx,x,n_var*sizeof(double)); //Create objective grad memory and get it from ASL SETERRJMP(); what = "gradient"; g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, n_var, mxREAL)); objgrd(0, x, g, &nerror); break; case ASLCMD_CON: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,2); //Get x and check dimensions x = sizechk(prhs[1],"x",n_var); //Save x if(conx) memcpy(conx,x,n_var*sizeof(double)); //Create constraint memory and get it from ASL SETERRJMP(); what = "constraints"; c = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_con, 1, mxREAL)); if(n_con) conval(x, c, &nerror); break; case ASLCMD_JAC: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,2); //Get x and check dimensions x = sizechk(prhs[1],"x",n_var); //Save x if(conx) memcpy(conx,x,n_var*sizeof(double)); //Create constraint jac memory and get it from ASL SETERRJMP(); what = "Jacobian"; //Check for sparsity if(nrhs > 2 && *mxGetPr(prhs[2])) { sp = 1; J1 = mxGetPr(plhs[0] = mxCreateSparse(n_con, n_var, nzc, mxREAL)); } else { sp = 0; J1 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_con, n_var, mxREAL)); } //Evaluate if we have constraints if (n_con) { //Sparse if(sp) { jacval(x, J1, &nerror); Ir = mxGetIr(plhs[0]); for(Jc = mxGetJc(plhs[0]), cs = A_colstarts, i = 0; i <= n_var; ++i) Jc[i] = (mwIndex)cs[i]; cgp = Cgrad; for(i = 0; i < n_con; i++) for(cg = *cgp++; cg; cg = cg->next) Ir[cg->goff] = (mwIndex)i; } //Dense else { jacval(x, J, &nerror); cgp = Cgrad; for(cgpe = cgp + n_con; cgp < cgpe; J1++) for(cg = *cgp++; cg; cg = cg->next) J1[n_con*cg->varno] = J[cg->goff]; } } break; case ASLCMD_JACSTR: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,1); //Create constraint jacstr memory and get it from ASL SETERRJMP(); what = "Jacobian Structure)"; J1 = mxGetPr(plhs[0] = mxCreateSparse(n_con, n_var, nzc, mxREAL)); //Fill In Structure for(i=0;i<nzc;i++) J1[i] = 1.0; for(Jc = mxGetJc(plhs[0]), cs = A_colstarts, i = 0; i <= n_var; ++i) Jc[i] = (mwIndex)cs[i]; cgp = Cgrad; Ir = mxGetIr(plhs[0]); for(i = 0; i < n_con; i++) for(cg = *cgp++; cg; cg = cg->next) Ir[cg->goff] = (mwIndex)i; break; case ASLCMD_HES: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,4); //assume hess(x,sigma,lambda) and optionally sparse //Check dimensions & get args x = sizechk(prhs[1],"x",n_var); s = sizechk(prhs[2],"sigma",1); v = sizechk(prhs[3],"lambda",n_con); //Check for sparsity if(nrhs > 4 && *mxGetPr(prhs[4])) { sp = 1; W = mxGetPr(plhs[0] = mxCreateSparse(n_var, n_var, nhnz, mxREAL)); } else { sp = 0; W = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_var, n_var, mxREAL)); } //Check if we need to recalculate objective / constraints if(!comp_x(objx,x,n_var)) { //Setup Error Catching SETERRJMP(); what = "Objective for Hessian"; //Re-evaluate Objective objval(0, x, &nerror); } if(!comp_x(conx,x,n_var)){ if(!c) c = mxGetPr(mxCreateDoubleMatrix(n_con, 1, mxREAL)); //Setup Error Catching SETERRJMP(); what = "Constraints for Hessian"; //Re-evaluate Constraints conval(x, c, &nerror); } //Setup Error Catching SETERRJMP(); what = "Hessian"; //Sparse if(sp) { //This function returns the full (symmetric) Hessian as setup above sphes(H = Hsp, 1, s, v); Ir = mxGetIr(plhs[0]); Jc = mxGetJc(plhs[0]); hcs = sputinfo->hcolstarts; hr = sputinfo->hrownos; for(i = 0; i <= n_var; i++) Jc[i] = (mwIndex)hcs[i]; He = H + hcs[n_var]; while(H < He) { *W++ = *H++; *Ir++ = (mwIndex)*hr++; } } //Dense else fullhes(W, n_var, 1, s, v); break; case ASLCMD_HESSTR: //mexPrintf("CMD: Get Hessian Structure\n"); //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,1); //Create hessianstr memory and get it from ASL SETERRJMP(); what = "Hessian Structure"; W = mxGetPr(plhs[0] = mxCreateSparse(n_var, n_var, nhnz, mxREAL)); Ir = mxGetIr(plhs[0]); Jc = mxGetJc(plhs[0]); //Get Sparse Info hcs = sputinfo->hcolstarts; hr = sputinfo->hrownos; //Assign col starts for(i = 0; i <= n_var; i++) Jc[i] = (mwIndex)hcs[i]; //Assign rows + 1.0 for nz positions H = Hsp; //Start of nz Hsp elements He = H + hcs[n_var]; //End of nz Hsp elements while(H < He) { *W++ = 1.0; *Ir++ = (mwIndex)*hr++; *H++; //increment nz element position } break; case ASLCMD_WRITESOL: //Check for Errors CHECKASL(asl); CHECKNRHS(nrhs,2); //asl('writesol',msg,x) //Get Input Args CHECK(mxGetString(prhs[1], msg, FLEN) == 0,"error reading message!"); x = sizechk(prhs[2],"x",n_var); //Write to solution stub file write_sol(msg,x,NULL,NULL); break; default: mexExit(); //clean up mxGetString(prhs[0], cmd, FLEN); sprintf(msgbuf, "ASL Command Error! Unknown Command: '%s'\n", cmd); mexErrMsgTxt(msgbuf); break; } }
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { FILE *nl; char *buf1, buf[512], *what, **whatp; static fint n, nc, nz; fint i, nerror; real *J1, *W, *c, *f, *g, *v, *t, *x; static real *J; cgrad *cg, **cgp, **cgpe; static size_t Jsize; Jmp_buf err_jmp0; ASL *asl = cur_ASL; static char ignore_complementarity[] = "Warning: ignoring %d complementarity conditions.\n"; if (nrhs == 1 && mxIsChar(prhs[0])) { if (nlhs < 6 || nlhs > 7) usage(); if (mxGetString(prhs[0], buf1 = buf, sizeof(buf))) mexErrMsgTxt("Expected 'stub' as argument\n"); at_end(); mexAtExit(at_end); asl = ASL_alloc(ASL_read_pfgh); return_nofile = 1; if (!(nl = jac0dim(buf1,strlen(buf)))) { sprintf(msgbuf, "Can't open %.*s\n", sizeof(msgbuf)-20, buf); mexErrMsgTxt(msgbuf); } if (n_obj <= 0) printf("Warning: objectve == 0\n"); n = n_var; nc = n_con; nz = nzc; J = (real *)M1alloc(nz*sizeof(real)); X0 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL)); LUv = mxGetPr(plhs[1] = mxCreateDoubleMatrix(n, 1, mxREAL)); Uvx = mxGetPr(plhs[2] = mxCreateDoubleMatrix(n, 1, mxREAL)); pi0 = mxGetPr(plhs[3] = mxCreateDoubleMatrix(nc, 1, mxREAL)); LUrhs = mxGetPr(plhs[4] = mxCreateDoubleMatrix(nc, 1, mxREAL)); Urhsx = mxGetPr(plhs[5] = mxCreateDoubleMatrix(nc, 1, mxREAL)); if (nlhs == 7) { cvar = (int*)M1alloc(nc*sizeof(int)); plhs[6] = mxCreateDoubleMatrix(nc, 1, mxREAL); x = mxGetPr(plhs[6]); } else if (n_cc) printf(ignore_complementarity, n_cc); pfgh_read(nl, ASL_findgroups); Jsize = nc*n*sizeof(real); if (nlhs == 7) for(i = 0; i < nc; i++) x[i] = cvar[i]; return; } if (!asl) mexErrMsgTxt("amplfunc(\"stub\") has not been called\n"); nerror = -1; err_jmp1 = &err_jmp0; what = "(?)"; whatp = &what; if (nlhs == 2) { if (nrhs != 2) usage(); x = sizechk(prhs[0],"x",n); t = sizechk(prhs[1],"0 or 1", 1); if (setjmp(err_jmp0.jb)) { sprintf(msgbuf, "Trouble evaluating %s\n", *whatp); mexErrMsgTxt(msgbuf); } if (t[0] == 0.) { f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL)); c = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, 1, mxREAL)); what = "f"; *f = objval(0, x, &nerror); what = "c"; conval(x, c, &nerror); return; } g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL)); J1 = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, n, mxREAL)); what = "g"; objgrd(0, x, g, &nerror); if (nc) { memset(J1, 0, Jsize); what = "J"; jacval(x, J, &nerror); cgp = Cgrad; for(cgpe = cgp + nc; cgp < cgpe; J1++) for(cg = *cgp++; cg; cg = cg->next) J1[nc*cg->varno] = J[cg->goff]; } return; } if (nlhs == 0 && (nrhs == 3 || nrhs == 4)) { /* eval2('solution message', x, v): x = primal, v = dual */ /* optional 4th arg = solve_result_num */ if (!mxIsChar(prhs[0])) usage(); x = sizechk(prhs[1],"x",n); v = sizechk(prhs[2],"v",nc); if (mxGetString(prhs[0], buf, sizeof(buf))) mexErrMsgTxt( "Expected 'solution message' as first argument\n"); solve_result_num = nrhs == 3 ? -1 /* unknown */ : (int)*sizechk(prhs[3],"solve_result_num",1); write_sol(buf, x, v, 0); return; } if (nlhs != 1 || nrhs != 1) usage(); v = sizechk(prhs[0],"v",nc); W = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, n, mxREAL)); what = "W"; fullhes(W, n, 0, 0, v); }
int main(int argc, char *argv[]) { /* initialize Madagascar */ sf_init(argc, argv); Logger::instance().init("serial-fwi"); FwiParams ¶ms = FwiParams::instance(); std::vector<float> dobs(params.ns * params.nt * params.ng); /* observed data */ std::vector<float> cg(params.nz * params.nx, 0); /* conjugate gradient */ std::vector<float> g0(params.nz * params.nx, 0); /* gradient at previous step */ std::vector<float> wlt(params.nt); /* ricker wavelet */ std::vector<float> objval(params.niter, 0); /* objective/misfit function */ /* initialize wavelet */ rickerWavelet(&wlt[0], params.nt, params.fm, params.dt, params.amp); ShotPosition allSrcPos(params.szbeg, params.sxbeg, params.jsz, params.jsx, params.ns, params.nz); ShotPosition allGeoPos(params.gzbeg, params.gxbeg, params.jgz, params.jgx, params.ng, params.nz); // read velocity Velocity v0 = SfVelocityReader::read(params.vinit, params.nx, params.nz); // read observed data ShotDataReader::serialRead(params.shots, &dobs[0], params.ns, params.nt, params.ng); EnquistAbc2d fmMethod(params.dt, params.dx, params.dz); Velocity vel = fmMethod.expandDomain(v0); float obj0 = 0; for (int iter = 0; iter < params.niter; iter++) { boost::timer::cpu_timer timer; std::vector<float> g1(params.nz * params.nx, 0); /* gradient at curret step */ std::vector<float> derr(params.ns * params.ng * params.nt, 0); /* residual/error between synthetic and observation */ std::vector<float> illum(params.nz * params.nx, 0); /* illumination of the source wavefield */ Velocity vtmp = vel; /* temporary velocity computed with epsil */ fmMethod.bindVelocity(vel); /** * calculate local objective function & derr & illum & g1(gradient) */ float obj = cal_obj_derr_illum_grad(params, &derr[0], &illum[0], &g1[0], &wlt[0], &dobs[0], fmMethod, allSrcPos, allGeoPos); DEBUG() << format("sum_derr %f, sum_illum %f, sum_g1 %f") % sum(derr) % sum(illum) % sum(g1); objval[iter] = iter == 0 ? obj0 = obj, 1.0 : obj / obj0; float epsil = 0; float beta = 0; sf_floatwrite(&illum[0], params.nz * params.nx, params.illums); scale_gradient(&g1[0], &vel.dat[0], &illum[0], params.nz, params.nx, params.precon); bell_smoothz(&g1[0], &illum[0], params.rbell, params.nz, params.nx); bell_smoothx(&illum[0], &g1[0], params.rbell, params.nz, params.nx); sf_floatwrite(&g1[0], params.nz * params.nx, params.grads); DEBUG() << format("before beta: sum_g0: %f, sum_g1: %f, sum_cg: %f") % sum(g0) % sum(g1) % sum(cg); beta = iter == 0 ? 0.0 : cal_beta(&g0[0], &g1[0], &cg[0], params.nz, params.nx); cal_conjgrad(&g1[0], &cg[0], beta, params.nz, params.nx); epsil = cal_epsilon(&vel.dat[0], &cg[0], params.nz, params.nx); cal_vtmp(&vtmp.dat[0], &vel.dat[0], &cg[0], epsil, params.nz, params.nx); std::swap(g1, g0); // let g0 be the previous gradient fmMethod.bindVelocity(vtmp); float alpha = calVelUpdateStepLen(params, &wlt[0], &dobs[0], &derr[0], epsil, fmMethod, allSrcPos, allGeoPos); update_vel(&vel.dat[0], &cg[0], alpha, params.nz, params.nx); sf_floatwrite(&vel.dat[0], params.nz * params.nx, params.vupdates); // output important information at each FWI iteration INFO() << format("iteration %d obj=%f beta=%f epsil=%f alpha=%f") % (iter + 1) % obj % beta % epsil % alpha; // INFO() << timer.format(2); } /// end of iteration sf_floatwrite(&objval[0], params.niter, params.objs); sf_close(); return 0; }