xref: /petsc/src/snes/impls/vi/vi.c (revision 9521db3c7eadbb71cf7301783c021bd3eef44511)
1 
2 #include <../src/snes/impls/vi/viimpl.h> /*I "petscsnes.h" I*/
3 #include <../include/private/kspimpl.h>
4 #include <../include/private/matimpl.h>
5 
6 #undef __FUNCT__
7 #define __FUNCT__ "SNESMonitorVI"
8 PetscErrorCode  SNESMonitorVI(SNES snes,PetscInt its,PetscReal fgnorm,void *dummy)
9 {
10   PetscErrorCode          ierr;
11   SNES_VI                 *vi = (SNES_VI*)snes->data;
12   PetscViewerASCIIMonitor viewer = (PetscViewerASCIIMonitor) dummy;
13   const PetscScalar       *x,*xl,*xu,*f;
14   PetscInt                i,n,act = 0;
15   PetscReal               rnorm,fnorm;
16 
17   PetscFunctionBegin;
18   if (!dummy) {
19     ierr = PetscViewerASCIIMonitorCreate(((PetscObject)snes)->comm,"stdout",0,&viewer);CHKERRQ(ierr);
20   }
21   ierr = VecGetLocalSize(snes->vec_sol,&n);CHKERRQ(ierr);
22   ierr = VecGetArrayRead(vi->xl,&xl);CHKERRQ(ierr);
23   ierr = VecGetArrayRead(vi->xu,&xu);CHKERRQ(ierr);
24   ierr = VecGetArrayRead(snes->vec_sol,&x);CHKERRQ(ierr);
25   ierr = VecGetArrayRead(snes->vec_func,&f);CHKERRQ(ierr);
26 
27   rnorm = 0.0;
28   for (i=0; i<n; i++) {
29     if (((x[i] > xl[i] + 1.e-8 || (f[i] < 0.0)) && ((x[i] < xu[i] - 1.e-8) || f[i] > 0.0))) rnorm += f[i]*f[i];
30     else act++;
31   }
32   ierr = VecRestoreArrayRead(snes->vec_func,&f);CHKERRQ(ierr);
33   ierr = VecRestoreArrayRead(vi->xl,&xl);CHKERRQ(ierr);
34   ierr = VecRestoreArrayRead(vi->xu,&xu);CHKERRQ(ierr);
35   ierr = VecRestoreArrayRead(snes->vec_sol,&x);CHKERRQ(ierr);
36   ierr = MPI_Allreduce(&rnorm,&fnorm,1,MPIU_REAL,MPIU_SUM,((PetscObject)snes)->comm);CHKERRQ(ierr);
37   fnorm = sqrt(fnorm);
38   ierr = PetscViewerASCIIMonitorPrintf(viewer,"%3D SNES VI Function norm %14.12e Active constraints %D\n",its,fnorm,act);CHKERRQ(ierr);
39   if (!dummy) {
40     ierr = PetscViewerASCIIMonitorDestroy(viewer);CHKERRQ(ierr);
41   }
42   PetscFunctionReturn(0);
43 }
44 
45 /*
46      Checks if J^T F = 0 which implies we've found a local minimum of the norm of the function,
47     || F(u) ||_2 but not a zero, F(u) = 0. In the case when one cannot compute J^T F we use the fact that
48     0 = (J^T F)^T W = F^T J W iff W not in the null space of J. Thanks for Jorge More
49     for this trick. One assumes that the probability that W is in the null space of J is very, very small.
50 */
51 #undef __FUNCT__
52 #define __FUNCT__ "SNESVICheckLocalMin_Private"
53 PetscErrorCode SNESVICheckLocalMin_Private(SNES snes,Mat A,Vec F,Vec W,PetscReal fnorm,PetscBool *ismin)
54 {
55   PetscReal      a1;
56   PetscErrorCode ierr;
57   PetscBool     hastranspose;
58 
59   PetscFunctionBegin;
60   *ismin = PETSC_FALSE;
61   ierr = MatHasOperation(A,MATOP_MULT_TRANSPOSE,&hastranspose);CHKERRQ(ierr);
62   if (hastranspose) {
63     /* Compute || J^T F|| */
64     ierr = MatMultTranspose(A,F,W);CHKERRQ(ierr);
65     ierr = VecNorm(W,NORM_2,&a1);CHKERRQ(ierr);
66     ierr = PetscInfo1(snes,"|| J^T F|| %G near zero implies found a local minimum\n",a1/fnorm);CHKERRQ(ierr);
67     if (a1/fnorm < 1.e-4) *ismin = PETSC_TRUE;
68   } else {
69     Vec         work;
70     PetscScalar result;
71     PetscReal   wnorm;
72 
73     ierr = VecSetRandom(W,PETSC_NULL);CHKERRQ(ierr);
74     ierr = VecNorm(W,NORM_2,&wnorm);CHKERRQ(ierr);
75     ierr = VecDuplicate(W,&work);CHKERRQ(ierr);
76     ierr = MatMult(A,W,work);CHKERRQ(ierr);
77     ierr = VecDot(F,work,&result);CHKERRQ(ierr);
78     ierr = VecDestroy(work);CHKERRQ(ierr);
79     a1   = PetscAbsScalar(result)/(fnorm*wnorm);
80     ierr = PetscInfo1(snes,"(F^T J random)/(|| F ||*||random|| %G near zero implies found a local minimum\n",a1);CHKERRQ(ierr);
81     if (a1 < 1.e-4) *ismin = PETSC_TRUE;
82   }
83   PetscFunctionReturn(0);
84 }
85 
86 /*
87      Checks if J^T(F - J*X) = 0
88 */
89 #undef __FUNCT__
90 #define __FUNCT__ "SNESVICheckResidual_Private"
91 PetscErrorCode SNESVICheckResidual_Private(SNES snes,Mat A,Vec F,Vec X,Vec W1,Vec W2)
92 {
93   PetscReal      a1,a2;
94   PetscErrorCode ierr;
95   PetscBool     hastranspose;
96 
97   PetscFunctionBegin;
98   ierr = MatHasOperation(A,MATOP_MULT_TRANSPOSE,&hastranspose);CHKERRQ(ierr);
99   if (hastranspose) {
100     ierr = MatMult(A,X,W1);CHKERRQ(ierr);
101     ierr = VecAXPY(W1,-1.0,F);CHKERRQ(ierr);
102 
103     /* Compute || J^T W|| */
104     ierr = MatMultTranspose(A,W1,W2);CHKERRQ(ierr);
105     ierr = VecNorm(W1,NORM_2,&a1);CHKERRQ(ierr);
106     ierr = VecNorm(W2,NORM_2,&a2);CHKERRQ(ierr);
107     if (a1 != 0.0) {
108       ierr = PetscInfo1(snes,"||J^T(F-Ax)||/||F-AX|| %G near zero implies inconsistent rhs\n",a2/a1);CHKERRQ(ierr);
109     }
110   }
111   PetscFunctionReturn(0);
112 }
113 
114 /*
115   SNESDefaultConverged_VI - Checks the convergence of the semismooth newton algorithm.
116 
117   Notes:
118   The convergence criterion currently implemented is
119   merit < abstol
120   merit < rtol*merit_initial
121 */
122 #undef __FUNCT__
123 #define __FUNCT__ "SNESDefaultConverged_VI"
124 PetscErrorCode SNESDefaultConverged_VI(SNES snes,PetscInt it,PetscReal xnorm,PetscReal gradnorm,PetscReal fnorm,SNESConvergedReason *reason,void *dummy)
125 {
126   PetscErrorCode ierr;
127 
128   PetscFunctionBegin;
129   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
130   PetscValidPointer(reason,6);
131 
132   *reason = SNES_CONVERGED_ITERATING;
133 
134   if (!it) {
135     /* set parameter for default relative tolerance convergence test */
136     snes->ttol = fnorm*snes->rtol;
137   }
138   if (fnorm != fnorm) {
139     ierr = PetscInfo(snes,"Failed to converged, function norm is NaN\n");CHKERRQ(ierr);
140     *reason = SNES_DIVERGED_FNORM_NAN;
141   } else if (fnorm < snes->abstol) {
142     ierr = PetscInfo2(snes,"Converged due to function norm %G < %G\n",fnorm,snes->abstol);CHKERRQ(ierr);
143     *reason = SNES_CONVERGED_FNORM_ABS;
144   } else if (snes->nfuncs >= snes->max_funcs) {
145     ierr = PetscInfo2(snes,"Exceeded maximum number of function evaluations: %D > %D\n",snes->nfuncs,snes->max_funcs);CHKERRQ(ierr);
146     *reason = SNES_DIVERGED_FUNCTION_COUNT;
147   }
148 
149   if (it && !*reason) {
150     if (fnorm < snes->ttol) {
151       ierr = PetscInfo2(snes,"Converged due to function norm %G < %G (relative tolerance)\n",fnorm,snes->ttol);CHKERRQ(ierr);
152       *reason = SNES_CONVERGED_FNORM_RELATIVE;
153     }
154   }
155   PetscFunctionReturn(0);
156 }
157 
158 /*
159   SNESVIComputeMeritFunction - Evaluates the merit function for the mixed complementarity problem.
160 
161   Input Parameter:
162 . phi - the semismooth function
163 
164   Output Parameter:
165 . merit - the merit function
166 . phinorm - ||phi||
167 
168   Notes:
169   The merit function for the mixed complementarity problem is defined as
170      merit = 0.5*phi^T*phi
171 */
172 #undef __FUNCT__
173 #define __FUNCT__ "SNESVIComputeMeritFunction"
174 static PetscErrorCode SNESVIComputeMeritFunction(Vec phi, PetscReal* merit,PetscReal* phinorm)
175 {
176   PetscErrorCode ierr;
177 
178   PetscFunctionBegin;
179   ierr = VecNormBegin(phi,NORM_2,phinorm);CHKERRQ(ierr);
180   ierr = VecNormEnd(phi,NORM_2,phinorm);CHKERRQ(ierr);
181 
182   *merit = 0.5*(*phinorm)*(*phinorm);
183   PetscFunctionReturn(0);
184 }
185 
186 PETSC_STATIC_INLINE PetscScalar Phi(PetscScalar a,PetscScalar b)
187 {
188   return a + b - sqrt(a*a + b*b);
189 }
190 
191 PETSC_STATIC_INLINE PetscScalar DPhi(PetscScalar a,PetscScalar b)
192 {
193   if ((PetscAbsScalar(a) >= 1.e-6) || (PetscAbsScalar(b) >= 1.e-6)) return  1.0 - a/ sqrt(a*a + b*b);
194   else return .5;
195 }
196 
197 /*
198    SNESVIComputeFunction - Reformulates a system of nonlinear equations in mixed complementarity form to a system of nonlinear equations in semismooth form.
199 
200    Input Parameters:
201 .  snes - the SNES context
202 .  x - current iterate
203 .  functx - user defined function context
204 
205    Output Parameters:
206 .  phi - Semismooth function
207 
208 */
209 #undef __FUNCT__
210 #define __FUNCT__ "SNESVIComputeFunction"
211 static PetscErrorCode SNESVIComputeFunction(SNES snes,Vec X,Vec phi,void* functx)
212 {
213   PetscErrorCode  ierr;
214   SNES_VI         *vi = (SNES_VI*)snes->data;
215   Vec             Xl = vi->xl,Xu = vi->xu,F = snes->vec_func;
216   PetscScalar     *phi_arr,*x_arr,*f_arr,*l,*u;
217   PetscInt        i,nlocal;
218 
219   PetscFunctionBegin;
220   ierr = (*vi->computeuserfunction)(snes,X,F,functx);CHKERRQ(ierr);
221   ierr = VecGetLocalSize(X,&nlocal);CHKERRQ(ierr);
222   ierr = VecGetArray(X,&x_arr);CHKERRQ(ierr);
223   ierr = VecGetArray(F,&f_arr);CHKERRQ(ierr);
224   ierr = VecGetArray(Xl,&l);CHKERRQ(ierr);
225   ierr = VecGetArray(Xu,&u);CHKERRQ(ierr);
226   ierr = VecGetArray(phi,&phi_arr);CHKERRQ(ierr);
227 
228   for (i=0;i < nlocal;i++) {
229     if ((l[i] <= PETSC_VI_NINF) && (u[i] >= PETSC_VI_INF)) { /* no constraints on variable */
230       phi_arr[i] = f_arr[i];
231     } else if (l[i] <= PETSC_VI_NINF) {                      /* upper bound on variable only */
232       phi_arr[i] = -Phi(u[i] - x_arr[i],-f_arr[i]);
233     } else if (u[i] >= PETSC_VI_INF) {                       /* lower bound on variable only */
234       phi_arr[i] = Phi(x_arr[i] - l[i],f_arr[i]);
235     } else if (l[i] == u[i]) {
236       phi_arr[i] = l[i] - x_arr[i];
237     } else {                                                /* both bounds on variable */
238       phi_arr[i] = Phi(x_arr[i] - l[i],-Phi(u[i] - x_arr[i],-f_arr[i]));
239     }
240   }
241 
242   ierr = VecRestoreArray(X,&x_arr);CHKERRQ(ierr);
243   ierr = VecRestoreArray(F,&f_arr);CHKERRQ(ierr);
244   ierr = VecRestoreArray(Xl,&l);CHKERRQ(ierr);
245   ierr = VecRestoreArray(Xu,&u);CHKERRQ(ierr);
246   ierr = VecRestoreArray(phi,&phi_arr);CHKERRQ(ierr);
247   PetscFunctionReturn(0);
248 }
249 
250 /*
251    SNESVIComputeBsubdifferentialVectors - Computes the diagonal shift (Da) and row scaling (Db) vectors needed for the
252                                           the semismooth jacobian.
253 */
254 #undef __FUNCT__
255 #define __FUNCT__ "SNESVIComputeBsubdifferentialVectors"
256 PetscErrorCode SNESVIComputeBsubdifferentialVectors(SNES snes,Vec X,Vec F,Mat jac,Vec Da,Vec Db)
257 {
258   PetscErrorCode ierr;
259   SNES_VI      *vi = (SNES_VI*)snes->data;
260   PetscScalar    *l,*u,*x,*f,*da,*db,da1,da2,db1,db2;
261   PetscInt       i,nlocal;
262 
263   PetscFunctionBegin;
264 
265   ierr = VecGetArray(X,&x);CHKERRQ(ierr);
266   ierr = VecGetArray(F,&f);CHKERRQ(ierr);
267   ierr = VecGetArray(vi->xl,&l);CHKERRQ(ierr);
268   ierr = VecGetArray(vi->xu,&u);CHKERRQ(ierr);
269   ierr = VecGetArray(Da,&da);CHKERRQ(ierr);
270   ierr = VecGetArray(Db,&db);CHKERRQ(ierr);
271   ierr = VecGetLocalSize(X,&nlocal);CHKERRQ(ierr);
272 
273   for (i=0;i< nlocal;i++) {
274     if ((l[i] <= PETSC_VI_NINF) && (u[i] >= PETSC_VI_INF)) {/* no constraints on variable */
275       da[i] = 0;
276       db[i] = 1;
277     } else if (l[i] <= PETSC_VI_NINF) {                     /* upper bound on variable only */
278       da[i] = DPhi(u[i] - x[i], -f[i]);
279       db[i] = DPhi(-f[i],u[i] - x[i]);
280     } else if (u[i] >= PETSC_VI_INF) {                      /* lower bound on variable only */
281       da[i] = DPhi(x[i] - l[i], f[i]);
282       db[i] = DPhi(f[i],x[i] - l[i]);
283     } else if (l[i] == u[i]) {                              /* fixed variable */
284       da[i] = 1;
285       db[i] = 0;
286     } else {                                                /* upper and lower bounds on variable */
287       da1 = DPhi(x[i] - l[i], -Phi(u[i] - x[i], -f[i]));
288       db1 = DPhi(-Phi(u[i] - x[i], -f[i]),x[i] - l[i]);
289       da2 = DPhi(u[i] - x[i], -f[i]);
290       db2 = DPhi(-f[i],u[i] - x[i]);
291       da[i] = da1 + db1*da2;
292       db[i] = db1*db2;
293     }
294   }
295 
296   ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
297   ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
298   ierr = VecRestoreArray(vi->xl,&l);CHKERRQ(ierr);
299   ierr = VecRestoreArray(vi->xu,&u);CHKERRQ(ierr);
300   ierr = VecRestoreArray(Da,&da);CHKERRQ(ierr);
301   ierr = VecRestoreArray(Db,&db);CHKERRQ(ierr);
302   PetscFunctionReturn(0);
303 }
304 
305 /*
306    SNESVIComputeJacobian - Computes the jacobian of the semismooth function.The Jacobian for the semismooth function is an element of the B-subdifferential of the Fischer-Burmeister function for complementarity problems.
307 
308    Input Parameters:
309 .  Da       - Diagonal shift vector for the semismooth jacobian.
310 .  Db       - Row scaling vector for the semismooth jacobian.
311 
312    Output Parameters:
313 .  jac      - semismooth jacobian
314 .  jac_pre  - optional preconditioning matrix
315 
316    Notes:
317    The semismooth jacobian matrix is given by
318    jac = Da + Db*jacfun
319    where Db is the row scaling matrix stored as a vector,
320          Da is the diagonal perturbation matrix stored as a vector
321    and   jacfun is the jacobian of the original nonlinear function.
322 */
323 #undef __FUNCT__
324 #define __FUNCT__ "SNESVIComputeJacobian"
325 PetscErrorCode SNESVIComputeJacobian(Mat jac, Mat jac_pre,Vec Da, Vec Db)
326 {
327   PetscErrorCode ierr;
328 
329   /* Do row scaling  and add diagonal perturbation */
330   ierr = MatDiagonalScale(jac,Db,PETSC_NULL);CHKERRQ(ierr);
331   ierr = MatDiagonalSet(jac,Da,ADD_VALUES);CHKERRQ(ierr);
332   if (jac != jac_pre) { /* If jac and jac_pre are different */
333     ierr = MatDiagonalScale(jac_pre,Db,PETSC_NULL);
334     ierr = MatDiagonalSet(jac_pre,Da,ADD_VALUES);CHKERRQ(ierr);
335   }
336   PetscFunctionReturn(0);
337 }
338 
339 /*
340    SNESVIComputeMeritFunctionGradient - Computes the gradient of the merit function psi.
341 
342    Input Parameters:
343    phi - semismooth function.
344    H   - semismooth jacobian
345 
346    Output Parameters:
347    dpsi - merit function gradient
348 
349    Notes:
350   The merit function gradient is computed as follows
351         dpsi = H^T*phi
352 */
353 #undef __FUNCT__
354 #define __FUNCT__ "SNESVIComputeMeritFunctionGradient"
355 PetscErrorCode SNESVIComputeMeritFunctionGradient(Mat H, Vec phi, Vec dpsi)
356 {
357   PetscErrorCode ierr;
358 
359   PetscFunctionBegin;
360   ierr = MatMultTranspose(H,phi,dpsi);CHKERRQ(ierr);
361   PetscFunctionReturn(0);
362 }
363 
364 /* -------------------------------------------------------------------------- */
365 /*
366    SNESVIProjectOntoBounds - Projects X onto the feasible region so that Xl[i] <= X[i] <= Xu[i] for i = 1...n.
367 
368    Input Parameters:
369 .  SNES - nonlinear solver context
370 
371    Output Parameters:
372 .  X - Bound projected X
373 
374 */
375 
376 #undef __FUNCT__
377 #define __FUNCT__ "SNESVIProjectOntoBounds"
378 PetscErrorCode SNESVIProjectOntoBounds(SNES snes,Vec X)
379 {
380   PetscErrorCode    ierr;
381   SNES_VI           *vi = (SNES_VI*)snes->data;
382   const PetscScalar *xl,*xu;
383   PetscScalar       *x;
384   PetscInt          i,n;
385 
386   PetscFunctionBegin;
387   ierr = VecGetLocalSize(X,&n);CHKERRQ(ierr);
388   ierr = VecGetArray(X,&x);CHKERRQ(ierr);
389   ierr = VecGetArrayRead(vi->xl,&xl);CHKERRQ(ierr);
390   ierr = VecGetArrayRead(vi->xu,&xu);CHKERRQ(ierr);
391 
392   for(i = 0;i<n;i++) {
393     if (x[i] < xl[i]) x[i] = xl[i];
394     else if (x[i] > xu[i]) x[i] = xu[i];
395   }
396   ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
397   ierr = VecRestoreArrayRead(vi->xl,&xl);CHKERRQ(ierr);
398   ierr = VecRestoreArrayRead(vi->xu,&xu);CHKERRQ(ierr);
399   PetscFunctionReturn(0);
400 }
401 
402 /*  --------------------------------------------------------------------
403 
404      This file implements a semismooth truncated Newton method with a line search,
405      for solving a system of nonlinear equations in complementarity form, using the KSP, Vec,
406      and Mat interfaces for linear solvers, vectors, and matrices,
407      respectively.
408 
409      The following basic routines are required for each nonlinear solver:
410           SNESCreate_XXX()          - Creates a nonlinear solver context
411           SNESSetFromOptions_XXX()  - Sets runtime options
412           SNESSolve_XXX()           - Solves the nonlinear system
413           SNESDestroy_XXX()         - Destroys the nonlinear solver context
414      The suffix "_XXX" denotes a particular implementation, in this case
415      we use _VI (e.g., SNESCreate_VI, SNESSolve_VI) for solving
416      systems of nonlinear equations with a line search (LS) method.
417      These routines are actually called via the common user interface
418      routines SNESCreate(), SNESSetFromOptions(), SNESSolve(), and
419      SNESDestroy(), so the application code interface remains identical
420      for all nonlinear solvers.
421 
422      Another key routine is:
423           SNESSetUp_XXX()           - Prepares for the use of a nonlinear solver
424      by setting data structures and options.   The interface routine SNESSetUp()
425      is not usually called directly by the user, but instead is called by
426      SNESSolve() if necessary.
427 
428      Additional basic routines are:
429           SNESView_XXX()            - Prints details of runtime options that
430                                       have actually been used.
431      These are called by application codes via the interface routines
432      SNESView().
433 
434      The various types of solvers (preconditioners, Krylov subspace methods,
435      nonlinear solvers, timesteppers) are all organized similarly, so the
436      above description applies to these categories also.
437 
438     -------------------------------------------------------------------- */
439 /*
440    SNESSolveVI_SS - Solves the complementarity problem with a semismooth Newton
441    method using a line search.
442 
443    Input Parameters:
444 .  snes - the SNES context
445 
446    Output Parameter:
447 .  outits - number of iterations until termination
448 
449    Application Interface Routine: SNESSolve()
450 
451    Notes:
452    This implements essentially a semismooth Newton method with a
453    line search. The default line search does not do any line seach
454    but rather takes a full newton step.
455 */
456 #undef __FUNCT__
457 #define __FUNCT__ "SNESSolveVI_SS"
458 PetscErrorCode SNESSolveVI_SS(SNES snes)
459 {
460   SNES_VI            *vi = (SNES_VI*)snes->data;
461   PetscErrorCode     ierr;
462   PetscInt           maxits,i,lits;
463   PetscBool          lssucceed;
464   MatStructure       flg = DIFFERENT_NONZERO_PATTERN;
465   PetscReal          gnorm,xnorm=0,ynorm;
466   Vec                Y,X,F,G,W;
467   KSPConvergedReason kspreason;
468 
469   PetscFunctionBegin;
470   vi->computeuserfunction    = snes->ops->computefunction;
471   snes->ops->computefunction = SNESVIComputeFunction;
472 
473   snes->numFailures            = 0;
474   snes->numLinearSolveFailures = 0;
475   snes->reason                 = SNES_CONVERGED_ITERATING;
476 
477   maxits	= snes->max_its;	/* maximum number of iterations */
478   X		= snes->vec_sol;	/* solution vector */
479   F		= snes->vec_func;	/* residual vector */
480   Y		= snes->work[0];	/* work vectors */
481   G		= snes->work[1];
482   W		= snes->work[2];
483 
484   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
485   snes->iter = 0;
486   snes->norm = 0.0;
487   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
488 
489   ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
490   ierr = SNESComputeFunction(snes,X,vi->phi);CHKERRQ(ierr);
491   if (snes->domainerror) {
492     snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
493     snes->ops->computefunction = vi->computeuserfunction;
494     PetscFunctionReturn(0);
495   }
496    /* Compute Merit function */
497   ierr = SNESVIComputeMeritFunction(vi->phi,&vi->merit,&vi->phinorm);CHKERRQ(ierr);
498 
499   ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr);	/* xnorm <- ||x||  */
500   ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
501   if (PetscIsInfOrNanReal(vi->merit)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
502 
503   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
504   snes->norm = vi->phinorm;
505   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
506   SNESLogConvHistory(snes,vi->phinorm,0);
507   SNESMonitor(snes,0,vi->phinorm);
508 
509   /* set parameter for default relative tolerance convergence test */
510   snes->ttol = vi->phinorm*snes->rtol;
511   /* test convergence */
512   ierr = (*snes->ops->converged)(snes,0,0.0,0.0,vi->phinorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
513   if (snes->reason) {
514     snes->ops->computefunction = vi->computeuserfunction;
515     PetscFunctionReturn(0);
516   }
517 
518   for (i=0; i<maxits; i++) {
519 
520     /* Call general purpose update function */
521     if (snes->ops->update) {
522       ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
523     }
524 
525     /* Solve J Y = Phi, where J is the semismooth jacobian */
526     /* Get the nonlinear function jacobian */
527     ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
528     /* Get the diagonal shift and row scaling vectors */
529     ierr = SNESVIComputeBsubdifferentialVectors(snes,X,F,snes->jacobian,vi->Da,vi->Db);CHKERRQ(ierr);
530     /* Compute the semismooth jacobian */
531     ierr = SNESVIComputeJacobian(snes->jacobian,snes->jacobian_pre,vi->Da,vi->Db);CHKERRQ(ierr);
532     /* Compute the merit function gradient */
533     ierr = SNESVIComputeMeritFunctionGradient(snes->jacobian,vi->phi,vi->dpsi);CHKERRQ(ierr);
534     ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre,flg);CHKERRQ(ierr);
535     ierr = SNES_KSPSolve(snes,snes->ksp,vi->phi,Y);CHKERRQ(ierr);
536     ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
537 
538     if (kspreason < 0) {
539       if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
540         ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
541         snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
542         break;
543       }
544     }
545     ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
546     snes->linear_its += lits;
547     ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
548     /*
549     if (vi->precheckstep) {
550       PetscBool changed_y = PETSC_FALSE;
551       ierr = (*vi->precheckstep)(snes,X,Y,vi->precheck,&changed_y);CHKERRQ(ierr);
552     }
553 
554     if (PetscLogPrintInfo){
555       ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
556     }
557     */
558     /* Compute a (scaled) negative update in the line search routine:
559          Y <- X - lambda*Y
560        and evaluate G = function(Y) (depends on the line search).
561     */
562     ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
563     ynorm = 1; gnorm = vi->phinorm;
564     ierr = (*vi->LineSearch)(snes,vi->lsP,X,vi->phi,G,Y,W,vi->phinorm,xnorm,&ynorm,&gnorm,&lssucceed);CHKERRQ(ierr);
565     ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",vi->phinorm,gnorm,ynorm,(int)lssucceed);CHKERRQ(ierr);
566     if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
567     if (snes->domainerror) {
568       snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
569       snes->ops->computefunction = vi->computeuserfunction;
570       PetscFunctionReturn(0);
571     }
572     if (!lssucceed) {
573       if (++snes->numFailures >= snes->maxFailures) {
574 	PetscBool ismin;
575         snes->reason = SNES_DIVERGED_LINE_SEARCH;
576         ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,G,W,gnorm,&ismin);CHKERRQ(ierr);
577         if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
578         break;
579       }
580     }
581     /* Update function and solution vectors */
582     vi->phinorm = gnorm;
583     vi->merit = 0.5*vi->phinorm*vi->phinorm;
584     ierr = VecCopy(G,vi->phi);CHKERRQ(ierr);
585     ierr = VecCopy(W,X);CHKERRQ(ierr);
586     /* Monitor convergence */
587     ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
588     snes->iter = i+1;
589     snes->norm = vi->phinorm;
590     ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
591     SNESLogConvHistory(snes,snes->norm,lits);
592     SNESMonitor(snes,snes->iter,snes->norm);
593     /* Test for convergence, xnorm = || X || */
594     if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
595     ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,vi->phinorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
596     if (snes->reason) break;
597   }
598   if (i == maxits) {
599     ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
600     if(!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
601   }
602   snes->ops->computefunction = vi->computeuserfunction;
603   PetscFunctionReturn(0);
604 }
605 
606 #undef __FUNCT__
607 #define __FUNCT__ "SNESVIGetActiveSetIS"
608 /*
609    SNESVIGetActiveSetIndices - Gets the global indices for the active set variables
610 
611    Input parameter
612 .  snes - the SNES context
613 .  X    - the snes solution vector
614 .  F    - the nonlinear function vector
615 
616    Output parameter
617 .  ISact - active set index set
618  */
619 PetscErrorCode SNESVIGetActiveSetIS(SNES snes,Vec X,Vec F,IS* ISact)
620 {
621   PetscErrorCode   ierr;
622   SNES_VI          *vi = (SNES_VI*)snes->data;
623   Vec               Xl=vi->xl,Xu=vi->xu;
624   const PetscScalar *x,*f,*xl,*xu;
625   PetscInt          *idx_act,i,nlocal,nloc_isact=0,ilow,ihigh,i1=0;
626 
627   PetscFunctionBegin;
628   ierr = VecGetLocalSize(X,&nlocal);CHKERRQ(ierr);
629   ierr = VecGetOwnershipRange(X,&ilow,&ihigh);CHKERRQ(ierr);
630   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
631   ierr = VecGetArrayRead(Xl,&xl);CHKERRQ(ierr);
632   ierr = VecGetArrayRead(Xu,&xu);CHKERRQ(ierr);
633   ierr = VecGetArrayRead(F,&f);CHKERRQ(ierr);
634   /* Compute active set size */
635   for (i=0; i < nlocal;i++) {
636     if (!((x[i] > xl[i] + 1.e-8 || (f[i] < 0.0)) && ((x[i] < xu[i] - 1.e-8) || f[i] > 0.0))) nloc_isact++;
637   }
638 
639   ierr = PetscMalloc(nloc_isact*sizeof(PetscInt),&idx_act);CHKERRQ(ierr);
640 
641   /* Set active set indices */
642   for(i=0; i < nlocal; i++) {
643     if (!((x[i] > xl[i] + 1.e-8 || (f[i] < 0.0)) && ((x[i] < xu[i] - 1.e-8) || f[i] > 0.0))) idx_act[i1++] = ilow+i;
644   }
645 
646    /* Create active set IS */
647   ierr = ISCreateGeneral(((PetscObject)snes)->comm,nloc_isact,idx_act,PETSC_OWN_POINTER,ISact);CHKERRQ(ierr);
648 
649   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
650   ierr = VecRestoreArrayRead(Xl,&xl);CHKERRQ(ierr);
651   ierr = VecRestoreArrayRead(Xu,&xu);CHKERRQ(ierr);
652   ierr = VecRestoreArrayRead(F,&f);CHKERRQ(ierr);
653   PetscFunctionReturn(0);
654 }
655 
656 #undef __FUNCT__
657 #define __FUNCT__ "SNESVICreateIndexSets_RS"
658 PetscErrorCode SNESVICreateIndexSets_RS(SNES snes,Vec X,Vec F,IS* ISact,IS* ISinact)
659 {
660   PetscErrorCode     ierr;
661 
662   PetscFunctionBegin;
663   ierr = SNESVIGetActiveSetIS(snes,X,F,ISact);CHKERRQ(ierr);
664   ierr = ISComplement(*ISact,X->map->rstart,X->map->rend,ISinact);CHKERRQ(ierr);
665   PetscFunctionReturn(0);
666 }
667 
668 /* Create active and inactive set vectors. The local size of this vector is set and petsc computes the global size */
669 #undef __FUNCT__
670 #define __FUNCT__ "SNESVICreateSubVectors"
671 PetscErrorCode SNESVICreateSubVectors(SNES snes,PetscInt n,Vec* newv)
672 {
673   PetscErrorCode ierr;
674   Vec            v;
675 
676   PetscFunctionBegin;
677   ierr = VecCreate(((PetscObject)snes)->comm,&v);CHKERRQ(ierr);
678   ierr = VecSetSizes(v,n,PETSC_DECIDE);CHKERRQ(ierr);
679   ierr = VecSetFromOptions(v);CHKERRQ(ierr);
680   *newv = v;
681 
682   PetscFunctionReturn(0);
683 }
684 
685 /* Resets the snes PC and KSP when the active set sizes change */
686 #undef __FUNCT__
687 #define __FUNCT__ "SNESVIResetPCandKSP"
688 PetscErrorCode SNESVIResetPCandKSP(SNES snes,Mat Amat,Mat Pmat)
689 {
690   PetscErrorCode         ierr;
691   KSP                    kspnew,snesksp;
692   PC                     pcnew;
693   const MatSolverPackage stype;
694 
695   PetscFunctionBegin;
696   /* The active and inactive set sizes have changed so need to create a new snes->ksp object */
697   ierr = SNESGetKSP(snes,&snesksp);CHKERRQ(ierr);
698   ierr = KSPCreate(((PetscObject)snes)->comm,&kspnew);CHKERRQ(ierr);
699   /* Copy over snes->ksp info */
700   kspnew->pc_side = snesksp->pc_side;
701   kspnew->rtol    = snesksp->rtol;
702   kspnew->abstol    = snesksp->abstol;
703   kspnew->max_it  = snesksp->max_it;
704   ierr = KSPSetType(kspnew,((PetscObject)snesksp)->type_name);CHKERRQ(ierr);
705   ierr = KSPGetPC(kspnew,&pcnew);CHKERRQ(ierr);
706   ierr = PCSetType(kspnew->pc,((PetscObject)snesksp->pc)->type_name);CHKERRQ(ierr);
707   ierr = PCSetOperators(kspnew->pc,Amat,Pmat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
708   ierr = PCFactorGetMatSolverPackage(snesksp->pc,&stype);CHKERRQ(ierr);
709   ierr = PCFactorSetMatSolverPackage(kspnew->pc,stype);CHKERRQ(ierr);
710   ierr = KSPDestroy(snesksp);CHKERRQ(ierr);
711   snes->ksp = kspnew;
712   ierr = PetscLogObjectParent(snes,kspnew);CHKERRQ(ierr);
713   ierr = KSPSetFromOptions(kspnew);CHKERRQ(ierr);
714   PetscFunctionReturn(0);
715 }
716 
717 
718 #undef __FUNCT__
719 #define __FUNCT__ "SNESVIComputeInactiveSetFnorm"
720 PetscErrorCode SNESVIComputeInactiveSetFnorm(SNES snes,Vec F,Vec X,PetscScalar *fnorm)
721 {
722   PetscErrorCode    ierr;
723   SNES_VI           *vi = (SNES_VI*)snes->data;
724   const PetscScalar *x,*xl,*xu,*f;
725   PetscInt          i,n;
726   PetscReal         rnorm;
727 
728   PetscFunctionBegin;
729   ierr = VecGetLocalSize(X,&n);CHKERRQ(ierr);
730   ierr = VecGetArrayRead(vi->xl,&xl);CHKERRQ(ierr);
731   ierr = VecGetArrayRead(vi->xu,&xu);CHKERRQ(ierr);
732   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
733   ierr = VecGetArrayRead(F,&f);CHKERRQ(ierr);
734   rnorm = 0.0;
735   for (i=0; i<n; i++) {
736     if (((x[i] > xl[i] + 1.e-8 || (f[i] < 0.0)) && ((x[i] < xu[i] - 1.e-8) || f[i] > 0.0))) rnorm += f[i]*f[i];
737   }
738   ierr = VecRestoreArrayRead(F,&f);CHKERRQ(ierr);
739   ierr = VecRestoreArrayRead(vi->xl,&xl);CHKERRQ(ierr);
740   ierr = VecRestoreArrayRead(vi->xu,&xu);CHKERRQ(ierr);
741   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
742   ierr = MPI_Allreduce(&rnorm,fnorm,1,MPIU_REAL,MPIU_SUM,((PetscObject)snes)->comm);CHKERRQ(ierr);
743   *fnorm = sqrt(*fnorm);
744   PetscFunctionReturn(0);
745 }
746 
747 /* Variational Inequality solver using reduce space method. No semismooth algorithm is
748    implemented in this algorithm. It basically identifies the active variables and does
749    a linear solve on the inactive variables. */
750 #undef __FUNCT__
751 #define __FUNCT__ "SNESSolveVI_RS"
752 PetscErrorCode SNESSolveVI_RS(SNES snes)
753 {
754   SNES_VI          *vi = (SNES_VI*)snes->data;
755   PetscErrorCode    ierr;
756   PetscInt          maxits,i,lits;
757   PetscBool         lssucceed;
758   MatStructure      flg = DIFFERENT_NONZERO_PATTERN;
759   PetscReal         fnorm,gnorm,xnorm=0,ynorm;
760   Vec                Y,X,F,G,W;
761   KSPConvergedReason kspreason;
762 
763   PetscFunctionBegin;
764   snes->numFailures            = 0;
765   snes->numLinearSolveFailures = 0;
766   snes->reason                 = SNES_CONVERGED_ITERATING;
767 
768   maxits	= snes->max_its;	/* maximum number of iterations */
769   X		= snes->vec_sol;	/* solution vector */
770   F		= snes->vec_func;	/* residual vector */
771   Y		= snes->work[0];	/* work vectors */
772   G		= snes->work[1];
773   W		= snes->work[2];
774 
775   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
776   snes->iter = 0;
777   snes->norm = 0.0;
778   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
779 
780   ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
781   ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
782   if (snes->domainerror) {
783     snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
784     PetscFunctionReturn(0);
785   }
786   ierr = SNESVIComputeInactiveSetFnorm(snes,F,X,&fnorm);CHKERRQ(ierr);
787   ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr);	/* xnorm <- ||x||  */
788   ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
789   if (PetscIsInfOrNanReal(fnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
790 
791   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
792   snes->norm = fnorm;
793   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
794   SNESLogConvHistory(snes,fnorm,0);
795   SNESMonitor(snes,0,fnorm);
796 
797   /* set parameter for default relative tolerance convergence test */
798   snes->ttol = fnorm*snes->rtol;
799   /* test convergence */
800   ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
801   if (snes->reason) PetscFunctionReturn(0);
802 
803   for (i=0; i<maxits; i++) {
804 
805     IS         IS_act,IS_inact; /* _act -> active set _inact -> inactive set */
806     VecScatter scat_act,scat_inact;
807     PetscInt   nis_act,nis_inact;
808     Vec        Y_act,Y_inact,F_inact;
809     Mat        jac_inact_inact,prejac_inact_inact;
810     IS         keptrows;
811     PetscBool  isequal;
812 
813     /* Call general purpose update function */
814     if (snes->ops->update) {
815       ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
816     }
817     ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
818 
819     /* Create active and inactive index sets */
820     ierr = SNESVICreateIndexSets_RS(snes,X,F,&IS_act,&IS_inact);CHKERRQ(ierr);
821 
822     /* Create inactive set submatrix */
823     ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
824     ierr = MatFindNonzeroRows(jac_inact_inact,&keptrows);CHKERRQ(ierr);
825     if (keptrows) {
826       PetscInt       cnt,*nrows,k;
827       const PetscInt *krows,*inact;
828       PetscInt       rstart=jac_inact_inact->rmap->rstart;
829 
830       ierr = MatDestroy(jac_inact_inact);CHKERRQ(ierr);
831       ierr = ISDestroy(IS_act);CHKERRQ(ierr);
832 
833       ierr = ISGetLocalSize(keptrows,&cnt);CHKERRQ(ierr);
834       ierr = ISGetIndices(keptrows,&krows);CHKERRQ(ierr);
835       ierr = ISGetIndices(IS_inact,&inact);CHKERRQ(ierr);
836       ierr = PetscMalloc(cnt*sizeof(PetscInt),&nrows);CHKERRQ(ierr);
837       for (k=0; k<cnt; k++) {
838         nrows[k] = inact[krows[k]-rstart];
839       }
840       ierr = ISRestoreIndices(keptrows,&krows);CHKERRQ(ierr);
841       ierr = ISRestoreIndices(IS_inact,&inact);CHKERRQ(ierr);
842       ierr = ISDestroy(keptrows);CHKERRQ(ierr);
843       ierr = ISDestroy(IS_inact);CHKERRQ(ierr);
844 
845       ierr = ISCreateGeneral(PETSC_COMM_WORLD,cnt,nrows,PETSC_OWN_POINTER,&IS_inact);CHKERRQ(ierr);
846       ierr = ISComplement(IS_inact,F->map->rstart,F->map->rend,&IS_act);CHKERRQ(ierr);
847       ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
848     }
849 
850     /* Get sizes of active and inactive sets */
851     ierr = ISGetLocalSize(IS_act,&nis_act);CHKERRQ(ierr);
852     ierr = ISGetLocalSize(IS_inact,&nis_inact);CHKERRQ(ierr);
853 
854     /* Create active and inactive set vectors */
855     ierr = SNESVICreateSubVectors(snes,nis_inact,&F_inact);CHKERRQ(ierr);
856     ierr = SNESVICreateSubVectors(snes,nis_act,&Y_act);CHKERRQ(ierr);
857     ierr = SNESVICreateSubVectors(snes,nis_inact,&Y_inact);CHKERRQ(ierr);
858 
859     /* Create scatter contexts */
860     ierr = VecScatterCreate(Y,IS_act,Y_act,PETSC_NULL,&scat_act);CHKERRQ(ierr);
861     ierr = VecScatterCreate(Y,IS_inact,Y_inact,PETSC_NULL,&scat_inact);CHKERRQ(ierr);
862 
863     /* Do a vec scatter to active and inactive set vectors */
864     ierr = VecScatterBegin(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
865     ierr = VecScatterEnd(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
866 
867     ierr = VecScatterBegin(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
868     ierr = VecScatterEnd(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
869 
870     ierr = VecScatterBegin(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
871     ierr = VecScatterEnd(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
872 
873     /* Active set direction = 0 */
874     ierr = VecSet(Y_act,0);CHKERRQ(ierr);
875     if (snes->jacobian != snes->jacobian_pre) {
876       ierr = MatGetSubMatrix(snes->jacobian_pre,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&prejac_inact_inact);CHKERRQ(ierr);
877     } else prejac_inact_inact = jac_inact_inact;
878 
879     ierr = ISEqual(vi->IS_inact_prev,IS_inact,&isequal);CHKERRQ(ierr);
880     if (!isequal) {
881       ierr = SNESVIResetPCandKSP(snes,jac_inact_inact,prejac_inact_inact);CHKERRQ(ierr);
882     }
883 
884     /*      ierr = ISView(IS_inact,0);CHKERRQ(ierr); */
885     /*      ierr = ISView(IS_act,0);CHKERRQ(ierr);*/
886     /*      ierr = MatView(snes->jacobian_pre,0); */
887 
888     ierr = KSPSetOperators(snes->ksp,jac_inact_inact,prejac_inact_inact,flg);CHKERRQ(ierr);
889     ierr = KSPSetUp(snes->ksp);CHKERRQ(ierr);
890     {
891       PC        pc;
892       PetscBool flg;
893       ierr = KSPGetPC(snes->ksp,&pc);CHKERRQ(ierr);
894       ierr = PetscTypeCompare((PetscObject)pc,PCFIELDSPLIT,&flg);CHKERRQ(ierr);
895       if (flg) {
896         KSP      *subksps;
897         ierr = PCFieldSplitGetSubKSP(pc,PETSC_NULL,&subksps);CHKERRQ(ierr);
898         ierr = KSPGetPC(subksps[0],&pc);CHKERRQ(ierr);
899         ierr = PetscFree(subksps);CHKERRQ(ierr);
900         ierr = PetscTypeCompare((PetscObject)pc,PCBJACOBI,&flg);CHKERRQ(ierr);
901         if (flg) {
902           PetscInt       n,N = 101*101,j,cnts[3] = {0,0,0};
903           const PetscInt *ii;
904 
905           ierr = ISGetSize(IS_inact,&n);CHKERRQ(ierr);
906           ierr = ISGetIndices(IS_inact,&ii);CHKERRQ(ierr);
907           for (j=0; j<n; j++) {
908             if (ii[j] < N) cnts[0]++;
909             else if (ii[j] < 2*N) cnts[1]++;
910             else if (ii[j] < 3*N) cnts[2]++;
911           }
912           ierr = ISRestoreIndices(IS_inact,&ii);CHKERRQ(ierr);
913 
914           ierr = PCBJacobiSetTotalBlocks(pc,3,cnts);CHKERRQ(ierr);
915         }
916       }
917     }
918 
919     ierr = SNES_KSPSolve(snes,snes->ksp,F_inact,Y_inact);CHKERRQ(ierr);
920     ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
921     if (kspreason < 0) {
922       if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
923         ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
924         snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
925         break;
926       }
927      }
928 
929     ierr = VecScatterBegin(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
930     ierr = VecScatterEnd(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
931     ierr = VecScatterBegin(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
932     ierr = VecScatterEnd(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
933 
934     ierr = VecDestroy(F_inact);CHKERRQ(ierr);
935     ierr = VecDestroy(Y_act);CHKERRQ(ierr);
936     ierr = VecDestroy(Y_inact);CHKERRQ(ierr);
937     ierr = VecScatterDestroy(scat_act);CHKERRQ(ierr);
938     ierr = VecScatterDestroy(scat_inact);CHKERRQ(ierr);
939     ierr = ISDestroy(IS_act);CHKERRQ(ierr);
940     if (!isequal) {
941       ierr = ISDestroy(vi->IS_inact_prev);CHKERRQ(ierr);
942       ierr = ISDuplicate(IS_inact,&vi->IS_inact_prev);CHKERRQ(ierr);
943     }
944     ierr = ISDestroy(IS_inact);CHKERRQ(ierr);
945     ierr = MatDestroy(jac_inact_inact);CHKERRQ(ierr);
946     if (snes->jacobian != snes->jacobian_pre) {
947       ierr = MatDestroy(prejac_inact_inact);CHKERRQ(ierr);
948     }
949     ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
950     snes->linear_its += lits;
951     ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
952     /*
953     if (vi->precheckstep) {
954       PetscBool changed_y = PETSC_FALSE;
955       ierr = (*vi->precheckstep)(snes,X,Y,vi->precheck,&changed_y);CHKERRQ(ierr);
956     }
957 
958     if (PetscLogPrintInfo){
959       ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
960     }
961     */
962     /* Compute a (scaled) negative update in the line search routine:
963          Y <- X - lambda*Y
964        and evaluate G = function(Y) (depends on the line search).
965     */
966     ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
967     ynorm = 1; gnorm = fnorm;
968     ierr = (*vi->LineSearch)(snes,vi->lsP,X,F,G,Y,W,fnorm,xnorm,&ynorm,&gnorm,&lssucceed);CHKERRQ(ierr);
969     ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",fnorm,gnorm,ynorm,(int)lssucceed);CHKERRQ(ierr);
970     if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
971     if (snes->domainerror) {
972       snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
973       PetscFunctionReturn(0);
974     }
975     if (!lssucceed) {
976       if (++snes->numFailures >= snes->maxFailures) {
977 	PetscBool ismin;
978         snes->reason = SNES_DIVERGED_LINE_SEARCH;
979         ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,G,W,gnorm,&ismin);CHKERRQ(ierr);
980         if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
981         break;
982       }
983     }
984     /* Update function and solution vectors */
985     fnorm = gnorm;
986     ierr = VecCopy(G,F);CHKERRQ(ierr);
987     ierr = VecCopy(W,X);CHKERRQ(ierr);
988     /* Monitor convergence */
989     ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
990     snes->iter = i+1;
991     snes->norm = fnorm;
992     ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
993     SNESLogConvHistory(snes,snes->norm,lits);
994     SNESMonitor(snes,snes->iter,snes->norm);
995     /* Test for convergence, xnorm = || X || */
996     if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
997     ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
998     if (snes->reason) break;
999   }
1000   if (i == maxits) {
1001     ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
1002     if(!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
1003   }
1004   PetscFunctionReturn(0);
1005 }
1006 
1007 #undef __FUNCT__
1008 #define __FUNCT__ "SNESVISetRedundancyCheck"
1009 PetscErrorCode SNESVISetRedundancyCheck(SNES snes,PetscErrorCode (*func)(SNES,IS,IS*,void*))
1010 {
1011   SNES_VI         *vi = (SNES_VI*)snes->data;
1012 
1013   PetscFunctionBegin;
1014   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
1015   vi->checkredundancy = func;
1016   PetscFunctionReturn(0);
1017 }
1018 
1019 #if defined(PETSC_HAVE_MATLAB_ENGINE)
1020 #include <engine.h>
1021 #include <mex.h>
1022 typedef struct {char *funcname; mxArray *ctx;} SNESVIMatlabContext;
1023 
1024 #undef __FUNCT__
1025 #define __FUNCT__ "SNESVIRedundancyCheck_Matlab"
1026 PetscErrorCode SNESVIRedundancyCheck_Matlab(SNES snes,IS is_act,IS* is_redact,void* ctx)
1027 {
1028   PetscErrorCode      ierr;
1029   SNESVIMatlabContext *sctx = (SNESVIMatlabContext*)ctx;
1030   int                 nlhs = 2, nrhs = 4;
1031   mxArray             *plhs[2], *prhs[4];
1032   long long int       l1 = 0,ls = 0;
1033 
1034   PetscFunctionBegin;
1035   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
1036   PetscValidHeaderSpecific(is_act,IS_CLASSID,2);
1037   PetscValidPointer(is_redact,3);
1038   PetscCheckSameComm(snes,1,is_act,2);
1039 
1040   /* call Matlab function in ctx with arguments is_act */
1041   ierr = PetscMemcpy(&ls,&snes,sizeof(snes));CHKERRQ(ierr);
1042   ierr = PetscMemcpy(&l1,&is_act,sizeof(is_act));CHKERRQ(ierr);
1043   prhs[0] = mxCreateDoubleScalar((double)ls);
1044   prhs[1] = mxCreateDoubleScalar((double)l1);
1045   prhs[2] = mxCreateString(sctx->funcname);
1046   prhs[3] = sctx->ctx;
1047   ierr    = mexCallMATLAB(nlhs,plhs,nrhs,prhs,"PetscSNESVIRedundancyCheckInternal");CHKERRQ(ierr);
1048   ierr    = mxGetScalar(plhs[0]);CHKERRQ(ierr);
1049   *is_redact = (IS)mxGetPr(plhs[1]);
1050   mxDestroyArray(prhs[0]);
1051   mxDestroyArray(prhs[1]);
1052   mxDestroyArray(prhs[2]);
1053   mxDestroyArray(prhs[3]);
1054   mxDestroyArray(plhs[0]);
1055   PetscFunctionReturn(0);
1056 }
1057 
1058 #undef __FUNCT__
1059 #define __FUNCT__ "SNESVISetRedundancyCheckMatlab"
1060 PetscErrorCode SNESVISetRedundancyCheckMatlab(SNES snes,const char* func,mxArray* ctx)
1061 {
1062   PetscErrorCode      ierr;
1063   SNESVIMatlabContext *sctx;
1064   SNES_VI             *vi = (SNES_VI*)snes->data;
1065 
1066   PetscFunctionBegin;
1067   /* currently sctx is memory bleed */
1068   ierr = PetscMalloc(sizeof(SNESVIMatlabContext),&sctx);CHKERRQ(ierr);
1069   ierr = PetscStrallocpy(func,&sctx->funcname);CHKERRQ(ierr);
1070 
1071   sctx->ctx = mxDuplicateArray(ctx);
1072   vi->checkredundancy = SNESVIRedundancyCheck_Matlab;
1073   PetscFunctionReturn(0);
1074 }
1075 
1076 #endif
1077 
1078 
1079 /* Variational Inequality solver using augmented space method. It does the opposite of the
1080    reduced space method i.e. it identifies the active set variables and instead of discarding
1081    them it augments the original system by introducing additional equality
1082    constraint equations for active set variables. The user can optionally provide an IS for
1083    a subset of 'redundant' active set variables which will treated as free variables.
1084    Specific implementation for Allen-Cahn problem
1085 */
1086 #undef __FUNCT__
1087 #define __FUNCT__ "SNESSolveVI_RS2"
1088 PetscErrorCode SNESSolveVI_RS2(SNES snes)
1089 {
1090   SNES_VI          *vi = (SNES_VI*)snes->data;
1091   PetscErrorCode    ierr;
1092   PetscInt          maxits,i,lits;
1093   PetscBool         lssucceed;
1094   MatStructure      flg = DIFFERENT_NONZERO_PATTERN;
1095   PetscReal         fnorm,gnorm,xnorm=0,ynorm;
1096   Vec                Y,X,F,G,W;
1097   KSPConvergedReason kspreason;
1098 
1099   PetscFunctionBegin;
1100   snes->numFailures            = 0;
1101   snes->numLinearSolveFailures = 0;
1102   snes->reason                 = SNES_CONVERGED_ITERATING;
1103 
1104   maxits	= snes->max_its;	/* maximum number of iterations */
1105   X		= snes->vec_sol;	/* solution vector */
1106   F		= snes->vec_func;	/* residual vector */
1107   Y		= snes->work[0];	/* work vectors */
1108   G		= snes->work[1];
1109   W		= snes->work[2];
1110 
1111   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
1112   snes->iter = 0;
1113   snes->norm = 0.0;
1114   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
1115 
1116   ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
1117   ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
1118   if (snes->domainerror) {
1119     snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
1120     PetscFunctionReturn(0);
1121   }
1122   ierr = SNESVIComputeInactiveSetFnorm(snes,F,X,&fnorm);CHKERRQ(ierr);
1123   ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr);	/* xnorm <- ||x||  */
1124   ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
1125   if (PetscIsInfOrNanReal(fnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1126 
1127   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
1128   snes->norm = fnorm;
1129   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
1130   SNESLogConvHistory(snes,fnorm,0);
1131   SNESMonitor(snes,0,fnorm);
1132 
1133   /* set parameter for default relative tolerance convergence test */
1134   snes->ttol = fnorm*snes->rtol;
1135   /* test convergence */
1136   ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
1137   if (snes->reason) PetscFunctionReturn(0);
1138 
1139   for (i=0; i<maxits; i++) {
1140     IS             IS_act,IS_inact; /* _act -> active set _inact -> inactive set */
1141     IS             IS_redact=PETSC_NULL; /* redundant active set */
1142     Mat            J_aug,Jpre_aug;
1143     Vec            F_aug,Y_aug;
1144     PetscInt       nis_redact,nis_act;
1145     const PetscInt *idx_redact,*idx_act;
1146     PetscInt       k;
1147     PetscInt       *idx_actkept=PETSC_NULL,nkept=0; /* list of kept active set */
1148     PetscScalar    *f,*f2;
1149     PetscBool      isequal;
1150     PetscInt       i1=0,j1=0;
1151 
1152     /* Call general purpose update function */
1153     if (snes->ops->update) {
1154       ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
1155     }
1156     ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
1157 
1158     /* Create active and inactive index sets */
1159     ierr = SNESVICreateIndexSets_RS(snes,X,F,&IS_act,&IS_inact);CHKERRQ(ierr);
1160 
1161     /* Get local active set size */
1162     ierr = ISGetLocalSize(IS_act,&nis_act);CHKERRQ(ierr);
1163     ierr = ISGetIndices(IS_act,&idx_act);CHKERRQ(ierr);
1164     if(nis_act) {
1165       if(vi->checkredundancy) {
1166 	(*vi->checkredundancy)(snes,IS_act,&IS_redact,snes->funP);
1167       }
1168 
1169       if(!IS_redact) {
1170 	/* User called checkredundancy function but didn't create IS_redact because
1171            there were no redundant active set variables */
1172 	/* Copy over all active set indices to the list */
1173 	ierr = PetscMalloc(nis_act*sizeof(PetscInt),&idx_actkept);CHKERRQ(ierr);
1174 	for(k=0;k < nis_act;k++) idx_actkept[k] = idx_act[k];
1175 	nkept = nis_act;
1176       } else {
1177 	ierr = ISGetLocalSize(IS_redact,&nis_redact);CHKERRQ(ierr);
1178 	ierr = PetscMalloc((nis_act-nis_redact)*sizeof(PetscInt),&idx_actkept);CHKERRQ(ierr);
1179 
1180 	/* Create reduced active set list */
1181 	ierr = ISGetIndices(IS_act,&idx_act);CHKERRQ(ierr);
1182 	ierr = ISGetIndices(IS_redact,&idx_redact);CHKERRQ(ierr);
1183 	j1 = 0;
1184 	for(k=0;k<nis_act;k++) {
1185 	  if(j1 < nis_redact && idx_act[k] == idx_redact[j1]) j1++;
1186 	  else idx_actkept[nkept++] = idx_act[k];
1187 	}
1188 	ierr = ISRestoreIndices(IS_act,&idx_act);CHKERRQ(ierr);
1189 	ierr = ISRestoreIndices(IS_redact,&idx_redact);CHKERRQ(ierr);
1190       }
1191 
1192       /* Create augmented F and Y */
1193       ierr = VecCreate(((PetscObject)snes)->comm,&F_aug);CHKERRQ(ierr);
1194       ierr = VecSetSizes(F_aug,F->map->n+nkept,PETSC_DECIDE);CHKERRQ(ierr);
1195       ierr = VecSetFromOptions(F_aug);CHKERRQ(ierr);
1196       ierr = VecDuplicate(F_aug,&Y_aug);CHKERRQ(ierr);
1197 
1198       /* Copy over F to F_aug in the first n locations */
1199       ierr = VecGetArray(F,&f);CHKERRQ(ierr);
1200       ierr = VecGetArray(F_aug,&f2);CHKERRQ(ierr);
1201       ierr = PetscMemcpy(f2,f,F->map->n*sizeof(PetscScalar));CHKERRQ(ierr);
1202       ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
1203       ierr = VecRestoreArray(F_aug,&f2);CHKERRQ(ierr);
1204 
1205       /* Create the augmented jacobian matrix */
1206       ierr = MatCreate(((PetscObject)snes)->comm,&J_aug);CHKERRQ(ierr);
1207       ierr = MatSetSizes(J_aug,X->map->n+nkept,X->map->n+nkept,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1208       ierr = MatSetFromOptions(J_aug);CHKERRQ(ierr);
1209 
1210 
1211       { /* local vars */
1212       /* Preallocate augmented matrix and set values in it...Doing only sequential case first*/
1213       PetscInt          ncols;
1214       const PetscInt    *cols;
1215       const PetscScalar *vals;
1216       PetscScalar        value=1.0;
1217       PetscInt           row,col;
1218       PetscInt           *d_nnz;
1219 
1220       ierr = PetscMalloc((X->map->n+nkept)*sizeof(PetscInt),&d_nnz);CHKERRQ(ierr);
1221       ierr = PetscMemzero(d_nnz,(X->map->n+nkept)*sizeof(PetscInt));CHKERRQ(ierr);
1222       for(row=0;row<snes->jacobian->rmap->n;row++) {
1223         ierr = MatGetRow(snes->jacobian,row,&ncols,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
1224         d_nnz[row] += ncols;
1225         ierr = MatRestoreRow(snes->jacobian,row,&ncols,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
1226       }
1227 
1228       for(k=0;k<nkept;k++) {
1229         d_nnz[idx_actkept[k]] += 1;
1230         d_nnz[snes->jacobian->rmap->n+k] += 1;
1231       }
1232       ierr = MatSeqAIJSetPreallocation(J_aug,PETSC_NULL,d_nnz);CHKERRQ(ierr);
1233 
1234       ierr = PetscFree(d_nnz);CHKERRQ(ierr);
1235 
1236       /* Set the original jacobian matrix in J_aug */
1237       for(row=0;row<snes->jacobian->rmap->n;row++) {
1238 	ierr = MatGetRow(snes->jacobian,row,&ncols,&cols,&vals);CHKERRQ(ierr);
1239 	ierr = MatSetValues(J_aug,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
1240 	ierr = MatRestoreRow(snes->jacobian,row,&ncols,&cols,&vals);CHKERRQ(ierr);
1241       }
1242       /* Add the augmented part */
1243       for(k=0;k<nkept;k++) {
1244 	row = idx_actkept[k];
1245 	col = snes->jacobian->rmap->n+k;
1246 	ierr = MatSetValues(J_aug,1,&row,1,&col,&value,INSERT_VALUES);CHKERRQ(ierr);
1247 	ierr = MatSetValues(J_aug,1,&col,1,&row,&value,INSERT_VALUES);CHKERRQ(ierr);
1248       }
1249       ierr = MatAssemblyBegin(J_aug,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1250       ierr = MatAssemblyEnd(J_aug,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1251       /* Only considering prejac = jac for now */
1252       Jpre_aug = J_aug;
1253       } /* local vars*/
1254     } else {
1255       F_aug = F; J_aug = snes->jacobian; Y_aug = Y; Jpre_aug = snes->jacobian_pre;
1256     }
1257 
1258     ierr = ISEqual(vi->IS_inact_prev,IS_inact,&isequal);CHKERRQ(ierr);
1259     if (!isequal) {
1260       ierr = SNESVIResetPCandKSP(snes,J_aug,Jpre_aug);CHKERRQ(ierr);
1261     }
1262     ierr = KSPSetOperators(snes->ksp,J_aug,Jpre_aug,flg);CHKERRQ(ierr);
1263     ierr = KSPSetUp(snes->ksp);CHKERRQ(ierr);
1264     /*  {
1265       PC        pc;
1266       PetscBool flg;
1267       ierr = KSPGetPC(snes->ksp,&pc);CHKERRQ(ierr);
1268       ierr = PetscTypeCompare((PetscObject)pc,PCFIELDSPLIT,&flg);CHKERRQ(ierr);
1269       if (flg) {
1270         KSP      *subksps;
1271         ierr = PCFieldSplitGetSubKSP(pc,PETSC_NULL,&subksps);CHKERRQ(ierr);
1272         ierr = KSPGetPC(subksps[0],&pc);CHKERRQ(ierr);
1273         ierr = PetscFree(subksps);CHKERRQ(ierr);
1274         ierr = PetscTypeCompare((PetscObject)pc,PCBJACOBI,&flg);CHKERRQ(ierr);
1275         if (flg) {
1276           PetscInt       n,N = 101*101,j,cnts[3] = {0,0,0};
1277           const PetscInt *ii;
1278 
1279           ierr = ISGetSize(IS_inact,&n);CHKERRQ(ierr);
1280           ierr = ISGetIndices(IS_inact,&ii);CHKERRQ(ierr);
1281           for (j=0; j<n; j++) {
1282             if (ii[j] < N) cnts[0]++;
1283             else if (ii[j] < 2*N) cnts[1]++;
1284             else if (ii[j] < 3*N) cnts[2]++;
1285           }
1286           ierr = ISRestoreIndices(IS_inact,&ii);CHKERRQ(ierr);
1287 
1288           ierr = PCBJacobiSetTotalBlocks(pc,3,cnts);CHKERRQ(ierr);
1289         }
1290       }
1291     }
1292     */
1293     ierr = SNES_KSPSolve(snes,snes->ksp,F_aug,Y_aug);CHKERRQ(ierr);
1294     ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
1295     if (kspreason < 0) {
1296       if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
1297         ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
1298         snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
1299         break;
1300       }
1301     }
1302 
1303     if(nis_act) {
1304       PetscScalar *y1,*y2;
1305       ierr = VecGetArray(Y,&y1);CHKERRQ(ierr);
1306       ierr = VecGetArray(Y_aug,&y2);CHKERRQ(ierr);
1307       /* Copy over inactive Y_aug to Y */
1308       j1 = 0;
1309       for(i1=Y->map->rstart;i1 < Y->map->rend;i1++) {
1310 	if(j1 < nkept && idx_actkept[j1] == i1) j1++;
1311 	else y1[i1-Y->map->rstart] = y2[i1-Y->map->rstart];
1312       }
1313       ierr = VecRestoreArray(Y,&y1);CHKERRQ(ierr);
1314       ierr = VecRestoreArray(Y_aug,&y2);CHKERRQ(ierr);
1315 
1316       ierr = VecDestroy(F_aug);CHKERRQ(ierr);
1317       ierr = VecDestroy(Y_aug);CHKERRQ(ierr);
1318       ierr = MatDestroy(J_aug);CHKERRQ(ierr);
1319       ierr = PetscFree(idx_actkept);CHKERRQ(ierr);
1320     }
1321 
1322     if (!isequal) {
1323       ierr = ISDestroy(vi->IS_inact_prev);CHKERRQ(ierr);
1324       ierr = ISDuplicate(IS_inact,&vi->IS_inact_prev);CHKERRQ(ierr);
1325     }
1326     ierr = ISDestroy(IS_inact);CHKERRQ(ierr);
1327 
1328     ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
1329     snes->linear_its += lits;
1330     ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
1331     /*
1332     if (vi->precheckstep) {
1333       PetscBool changed_y = PETSC_FALSE;
1334       ierr = (*vi->precheckstep)(snes,X,Y,vi->precheck,&changed_y);CHKERRQ(ierr);
1335     }
1336 
1337     if (PetscLogPrintInfo){
1338       ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
1339     }
1340     */
1341     /* Compute a (scaled) negative update in the line search routine:
1342          Y <- X - lambda*Y
1343        and evaluate G = function(Y) (depends on the line search).
1344     */
1345     ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
1346     ynorm = 1; gnorm = fnorm;
1347     ierr = (*vi->LineSearch)(snes,vi->lsP,X,F,G,Y,W,fnorm,xnorm,&ynorm,&gnorm,&lssucceed);CHKERRQ(ierr);
1348     ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",fnorm,gnorm,ynorm,(int)lssucceed);CHKERRQ(ierr);
1349     if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
1350     if (snes->domainerror) {
1351       snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
1352       PetscFunctionReturn(0);
1353     }
1354     if (!lssucceed) {
1355       if (++snes->numFailures >= snes->maxFailures) {
1356 	PetscBool ismin;
1357         snes->reason = SNES_DIVERGED_LINE_SEARCH;
1358         ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,G,W,gnorm,&ismin);CHKERRQ(ierr);
1359         if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
1360         break;
1361       }
1362     }
1363     /* Update function and solution vectors */
1364     fnorm = gnorm;
1365     ierr = VecCopy(G,F);CHKERRQ(ierr);
1366     ierr = VecCopy(W,X);CHKERRQ(ierr);
1367     /* Monitor convergence */
1368     ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
1369     snes->iter = i+1;
1370     snes->norm = fnorm;
1371     ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
1372     SNESLogConvHistory(snes,snes->norm,lits);
1373     SNESMonitor(snes,snes->iter,snes->norm);
1374     /* Test for convergence, xnorm = || X || */
1375     if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
1376     ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
1377     if (snes->reason) break;
1378   }
1379   if (i == maxits) {
1380     ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
1381     if(!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
1382   }
1383   PetscFunctionReturn(0);
1384 }
1385 
1386 /* -------------------------------------------------------------------------- */
1387 /*
1388    SNESSetUp_VI - Sets up the internal data structures for the later use
1389    of the SNESVI nonlinear solver.
1390 
1391    Input Parameter:
1392 .  snes - the SNES context
1393 .  x - the solution vector
1394 
1395    Application Interface Routine: SNESSetUp()
1396 
1397    Notes:
1398    For basic use of the SNES solvers, the user need not explicitly call
1399    SNESSetUp(), since these actions will automatically occur during
1400    the call to SNESSolve().
1401  */
1402 #undef __FUNCT__
1403 #define __FUNCT__ "SNESSetUp_VI"
1404 PetscErrorCode SNESSetUp_VI(SNES snes)
1405 {
1406   PetscErrorCode ierr;
1407   SNES_VI        *vi = (SNES_VI*) snes->data;
1408   PetscInt       i_start[3],i_end[3];
1409 
1410   PetscFunctionBegin;
1411   if (!snes->vec_sol_update) {
1412     ierr = VecDuplicate(snes->vec_sol,&snes->vec_sol_update);CHKERRQ(ierr);
1413     ierr = PetscLogObjectParent(snes,snes->vec_sol_update);CHKERRQ(ierr);
1414   }
1415   if (!snes->work) {
1416     snes->nwork = 3;
1417     ierr = VecDuplicateVecs(snes->vec_sol,snes->nwork,&snes->work);CHKERRQ(ierr);
1418     ierr = PetscLogObjectParents(snes,snes->nwork,snes->work);CHKERRQ(ierr);
1419   }
1420 
1421   /* If the lower and upper bound on variables are not set, set it to
1422      -Inf and Inf */
1423   if (!vi->xl && !vi->xu) {
1424     vi->usersetxbounds = PETSC_FALSE;
1425     ierr = VecDuplicate(snes->vec_sol, &vi->xl); CHKERRQ(ierr);
1426     ierr = VecSet(vi->xl,PETSC_VI_NINF);CHKERRQ(ierr);
1427     ierr = VecDuplicate(snes->vec_sol, &vi->xu); CHKERRQ(ierr);
1428     ierr = VecSet(vi->xu,PETSC_VI_INF);CHKERRQ(ierr);
1429   } else {
1430     /* Check if lower bound, upper bound and solution vector distribution across the processors is identical */
1431     ierr = VecGetOwnershipRange(snes->vec_sol,i_start,i_end);CHKERRQ(ierr);
1432     ierr = VecGetOwnershipRange(vi->xl,i_start+1,i_end+1);CHKERRQ(ierr);
1433     ierr = VecGetOwnershipRange(vi->xu,i_start+2,i_end+2);CHKERRQ(ierr);
1434     if ((i_start[0] != i_start[1]) || (i_start[0] != i_start[2]) || (i_end[0] != i_end[1]) || (i_end[0] != i_end[2]))
1435       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Distribution of lower bound, upper bound and the solution vector should be identical across all the processors.");
1436   }
1437   if (snes->ops->solve != SNESSolveVI_SS) {
1438     /* Set up previous active index set for the first snes solve
1439        vi->IS_inact_prev = 0,1,2,....N */
1440     PetscInt *indices;
1441     PetscInt  i,n,rstart,rend;
1442 
1443     ierr = VecGetOwnershipRange(snes->vec_sol,&rstart,&rend);CHKERRQ(ierr);
1444     ierr = VecGetLocalSize(snes->vec_sol,&n);CHKERRQ(ierr);
1445     ierr = PetscMalloc(n*sizeof(PetscInt),&indices);CHKERRQ(ierr);
1446     for(i=0;i < n; i++) indices[i] = rstart + i;
1447     ierr = ISCreateGeneral(((PetscObject)snes)->comm,n,indices,PETSC_OWN_POINTER,&vi->IS_inact_prev);
1448   }
1449 
1450   if (snes->ops->solve == SNESSolveVI_SS) {
1451     ierr = VecDuplicate(snes->vec_sol, &vi->dpsi);CHKERRQ(ierr);
1452     ierr = VecDuplicate(snes->vec_sol, &vi->phi); CHKERRQ(ierr);
1453     ierr = VecDuplicate(snes->vec_sol, &vi->Da); CHKERRQ(ierr);
1454     ierr = VecDuplicate(snes->vec_sol, &vi->Db); CHKERRQ(ierr);
1455     ierr = VecDuplicate(snes->vec_sol, &vi->z);CHKERRQ(ierr);
1456     ierr = VecDuplicate(snes->vec_sol, &vi->t); CHKERRQ(ierr);
1457   }
1458   PetscFunctionReturn(0);
1459 }
1460 /* -------------------------------------------------------------------------- */
1461 /*
1462    SNESDestroy_VI - Destroys the private SNES_VI context that was created
1463    with SNESCreate_VI().
1464 
1465    Input Parameter:
1466 .  snes - the SNES context
1467 
1468    Application Interface Routine: SNESDestroy()
1469  */
1470 #undef __FUNCT__
1471 #define __FUNCT__ "SNESDestroy_VI"
1472 PetscErrorCode SNESDestroy_VI(SNES snes)
1473 {
1474   SNES_VI        *vi = (SNES_VI*) snes->data;
1475   PetscErrorCode ierr;
1476 
1477   PetscFunctionBegin;
1478   if (snes->vec_sol_update) {
1479     ierr = VecDestroy(snes->vec_sol_update);CHKERRQ(ierr);
1480     snes->vec_sol_update = PETSC_NULL;
1481   }
1482   if (snes->work) {
1483     ierr = VecDestroyVecs(snes->nwork,&snes->work);CHKERRQ(ierr);
1484   }
1485   if (snes->ops->solve != SNESSolveVI_SS) {
1486     ierr = ISDestroy(vi->IS_inact_prev);
1487   }
1488 
1489   if (snes->ops->solve == SNESSolveVI_SS) {
1490     /* clear vectors */
1491     ierr = VecDestroy(vi->dpsi);CHKERRQ(ierr);
1492     ierr = VecDestroy(vi->phi); CHKERRQ(ierr);
1493     ierr = VecDestroy(vi->Da); CHKERRQ(ierr);
1494     ierr = VecDestroy(vi->Db); CHKERRQ(ierr);
1495     ierr = VecDestroy(vi->z); CHKERRQ(ierr);
1496     ierr = VecDestroy(vi->t); CHKERRQ(ierr);
1497   }
1498 
1499   if (!vi->usersetxbounds) {
1500     ierr = VecDestroy(vi->xl); CHKERRQ(ierr);
1501     ierr = VecDestroy(vi->xu); CHKERRQ(ierr);
1502   }
1503 
1504   if (vi->lsmonitor) {
1505     ierr = PetscViewerASCIIMonitorDestroy(vi->lsmonitor);CHKERRQ(ierr);
1506   }
1507   ierr = PetscFree(snes->data);CHKERRQ(ierr);
1508 
1509   /* clear composed functions */
1510   ierr = PetscObjectComposeFunctionDynamic((PetscObject)snes,"SNESLineSearchSet_C","",PETSC_NULL);CHKERRQ(ierr);
1511   ierr = PetscObjectComposeFunctionDynamic((PetscObject)snes,"SNESLineSearchSetMonitor_C","",PETSC_NULL);CHKERRQ(ierr);
1512   PetscFunctionReturn(0);
1513 }
1514 
1515 /* -------------------------------------------------------------------------- */
1516 #undef __FUNCT__
1517 #define __FUNCT__ "SNESLineSearchNo_VI"
1518 
1519 /*
1520   This routine does not actually do a line search but it takes a full newton
1521   step while ensuring that the new iterates remain within the constraints.
1522 
1523 */
1524 PetscErrorCode SNESLineSearchNo_VI(SNES snes,void *lsctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal xnorm,PetscReal *ynorm,PetscReal *gnorm,PetscBool *flag)
1525 {
1526   PetscErrorCode ierr;
1527   SNES_VI        *vi = (SNES_VI*)snes->data;
1528   PetscBool      changed_w = PETSC_FALSE,changed_y = PETSC_FALSE;
1529 
1530   PetscFunctionBegin;
1531   *flag = PETSC_TRUE;
1532   ierr = PetscLogEventBegin(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1533   ierr = VecNorm(y,NORM_2,ynorm);CHKERRQ(ierr);         /* ynorm = || y || */
1534   ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);            /* w <- x - y   */
1535   ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1536   if (vi->postcheckstep) {
1537    ierr = (*vi->postcheckstep)(snes,x,y,w,vi->postcheck,&changed_y,&changed_w);CHKERRQ(ierr);
1538   }
1539   if (changed_y) {
1540     ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);            /* w <- x - y   */
1541     ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1542   }
1543   ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1544   ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1545   if (!snes->domainerror) {
1546     if (snes->ops->solve != SNESSolveVI_SS) {
1547        ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1548     } else {
1549       ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);  /* gnorm = || g || */
1550     }
1551     if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1552   }
1553   if (vi->lsmonitor) {
1554     ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: Using full step: fnorm %G gnorm %G\n",fnorm,*gnorm);CHKERRQ(ierr);
1555   }
1556   ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1557   PetscFunctionReturn(0);
1558 }
1559 
1560 /* -------------------------------------------------------------------------- */
1561 #undef __FUNCT__
1562 #define __FUNCT__ "SNESLineSearchNoNorms_VI"
1563 
1564 /*
1565   This routine is a copy of SNESLineSearchNoNorms in snes/impls/ls/ls.c
1566 */
1567 PetscErrorCode SNESLineSearchNoNorms_VI(SNES snes,void *lsctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal xnorm,PetscReal *ynorm,PetscReal *gnorm,PetscBool *flag)
1568 {
1569   PetscErrorCode ierr;
1570   SNES_VI        *vi = (SNES_VI*)snes->data;
1571   PetscBool     changed_w = PETSC_FALSE,changed_y = PETSC_FALSE;
1572 
1573   PetscFunctionBegin;
1574   *flag = PETSC_TRUE;
1575   ierr = PetscLogEventBegin(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1576   ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);            /* w <- x - y      */
1577   ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1578   if (vi->postcheckstep) {
1579    ierr = (*vi->postcheckstep)(snes,x,y,w,vi->postcheck,&changed_y,&changed_w);CHKERRQ(ierr);
1580   }
1581   if (changed_y) {
1582     ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);            /* w <- x - y   */
1583     ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1584   }
1585 
1586   /* don't evaluate function the last time through */
1587   if (snes->iter < snes->max_its-1) {
1588     ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1589   }
1590   ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1591   PetscFunctionReturn(0);
1592 }
1593 
1594 /* -------------------------------------------------------------------------- */
1595 #undef __FUNCT__
1596 #define __FUNCT__ "SNESLineSearchCubic_VI"
1597 /*
1598   This routine implements a cubic line search while doing a projection on the variable bounds
1599 */
1600 PetscErrorCode SNESLineSearchCubic_VI(SNES snes,void *lsctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal xnorm,PetscReal *ynorm,PetscReal *gnorm,PetscBool *flag)
1601 {
1602   PetscReal      initslope,lambdaprev,gnormprev,a,b,d,t1,t2,rellength;
1603   PetscReal      minlambda,lambda,lambdatemp;
1604 #if defined(PETSC_USE_COMPLEX)
1605   PetscScalar    cinitslope;
1606 #endif
1607   PetscErrorCode ierr;
1608   PetscInt       count;
1609   SNES_VI        *vi = (SNES_VI*)snes->data;
1610   PetscBool      changed_w = PETSC_FALSE,changed_y = PETSC_FALSE;
1611   MPI_Comm       comm;
1612 
1613   PetscFunctionBegin;
1614   ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr);
1615   ierr = PetscLogEventBegin(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1616   *flag   = PETSC_TRUE;
1617 
1618   ierr = VecNorm(y,NORM_2,ynorm);CHKERRQ(ierr);
1619   if (*ynorm == 0.0) {
1620     if (vi->lsmonitor) {
1621       ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: Initial direction and size is 0\n");CHKERRQ(ierr);
1622     }
1623     *gnorm = fnorm;
1624     ierr   = VecCopy(x,w);CHKERRQ(ierr);
1625     ierr   = VecCopy(f,g);CHKERRQ(ierr);
1626     *flag  = PETSC_FALSE;
1627     goto theend1;
1628   }
1629   if (*ynorm > vi->maxstep) {	/* Step too big, so scale back */
1630     if (vi->lsmonitor) {
1631       ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: Scaling step by %G old ynorm %G\n",vi->maxstep/(*ynorm),*ynorm);CHKERRQ(ierr);
1632     }
1633     ierr = VecScale(y,vi->maxstep/(*ynorm));CHKERRQ(ierr);
1634     *ynorm = vi->maxstep;
1635   }
1636   ierr      = VecMaxPointwiseDivide(y,x,&rellength);CHKERRQ(ierr);
1637   minlambda = vi->minlambda/rellength;
1638   ierr = MatMult(snes->jacobian,y,w);CHKERRQ(ierr);
1639 #if defined(PETSC_USE_COMPLEX)
1640   ierr = VecDot(f,w,&cinitslope);CHKERRQ(ierr);
1641   initslope = PetscRealPart(cinitslope);
1642 #else
1643   ierr = VecDot(f,w,&initslope);CHKERRQ(ierr);
1644 #endif
1645   if (initslope > 0.0)  initslope = -initslope;
1646   if (initslope == 0.0) initslope = -1.0;
1647 
1648   ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);
1649   ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1650   if (snes->nfuncs >= snes->max_funcs) {
1651     ierr  = PetscInfo(snes,"Exceeded maximum function evaluations, while checking full step length!\n");CHKERRQ(ierr);
1652     *flag = PETSC_FALSE;
1653     snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
1654     goto theend1;
1655   }
1656   ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1657   if (snes->ops->solve != SNESSolveVI_SS) {
1658     ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1659   } else {
1660     ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1661   }
1662   if (snes->domainerror) {
1663     ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1664     PetscFunctionReturn(0);
1665   }
1666   if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1667   ierr = PetscInfo2(snes,"Initial fnorm %G gnorm %G\n",fnorm,*gnorm);CHKERRQ(ierr);
1668   if (.5*(*gnorm)*(*gnorm) <= .5*fnorm*fnorm + vi->alpha*initslope) { /* Sufficient reduction */
1669     if (vi->lsmonitor) {
1670       ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: Using full step: fnorm %G gnorm %G\n",fnorm,*gnorm);CHKERRQ(ierr);
1671     }
1672     goto theend1;
1673   }
1674 
1675   /* Fit points with quadratic */
1676   lambda     = 1.0;
1677   lambdatemp = -initslope/((*gnorm)*(*gnorm) - fnorm*fnorm - 2.0*initslope);
1678   lambdaprev = lambda;
1679   gnormprev  = *gnorm;
1680   if (lambdatemp > .5*lambda)  lambdatemp = .5*lambda;
1681   if (lambdatemp <= .1*lambda) lambda = .1*lambda;
1682   else                         lambda = lambdatemp;
1683 
1684   ierr  = VecWAXPY(w,-lambda,y,x);CHKERRQ(ierr);
1685   ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1686   if (snes->nfuncs >= snes->max_funcs) {
1687     ierr  = PetscInfo1(snes,"Exceeded maximum function evaluations, while attempting quadratic backtracking! %D \n",snes->nfuncs);CHKERRQ(ierr);
1688     *flag = PETSC_FALSE;
1689     snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
1690     goto theend1;
1691   }
1692   ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1693   if (snes->ops->solve != SNESSolveVI_SS) {
1694     ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1695   } else {
1696     ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1697   }
1698   if (snes->domainerror) {
1699     ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1700     PetscFunctionReturn(0);
1701   }
1702   if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1703   if (vi->lsmonitor) {
1704     ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: gnorm after quadratic fit %G\n",*gnorm);CHKERRQ(ierr);
1705   }
1706   if (.5*(*gnorm)*(*gnorm) < .5*fnorm*fnorm + lambda*vi->alpha*initslope) { /* sufficient reduction */
1707     if (vi->lsmonitor) {
1708       ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: Quadratically determined step, lambda=%18.16e\n",lambda);CHKERRQ(ierr);
1709     }
1710     goto theend1;
1711   }
1712 
1713   /* Fit points with cubic */
1714   count = 1;
1715   while (PETSC_TRUE) {
1716     if (lambda <= minlambda) {
1717       if (vi->lsmonitor) {
1718 	ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: unable to find good step length! After %D tries \n",count);CHKERRQ(ierr);
1719 	ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, minlambda=%18.16e, lambda=%18.16e, initial slope=%18.16e\n",fnorm,*gnorm,*ynorm,minlambda,lambda,initslope);CHKERRQ(ierr);
1720       }
1721       *flag = PETSC_FALSE;
1722       break;
1723     }
1724     t1 = .5*((*gnorm)*(*gnorm) - fnorm*fnorm) - lambda*initslope;
1725     t2 = .5*(gnormprev*gnormprev  - fnorm*fnorm) - lambdaprev*initslope;
1726     a  = (t1/(lambda*lambda) - t2/(lambdaprev*lambdaprev))/(lambda-lambdaprev);
1727     b  = (-lambdaprev*t1/(lambda*lambda) + lambda*t2/(lambdaprev*lambdaprev))/(lambda-lambdaprev);
1728     d  = b*b - 3*a*initslope;
1729     if (d < 0.0) d = 0.0;
1730     if (a == 0.0) {
1731       lambdatemp = -initslope/(2.0*b);
1732     } else {
1733       lambdatemp = (-b + sqrt(d))/(3.0*a);
1734     }
1735     lambdaprev = lambda;
1736     gnormprev  = *gnorm;
1737     if (lambdatemp > .5*lambda)  lambdatemp = .5*lambda;
1738     if (lambdatemp <= .1*lambda) lambda     = .1*lambda;
1739     else                         lambda     = lambdatemp;
1740     ierr = VecWAXPY(w,-lambda,y,x);CHKERRQ(ierr);
1741     ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1742     if (snes->nfuncs >= snes->max_funcs) {
1743       ierr = PetscInfo1(snes,"Exceeded maximum function evaluations, while looking for good step length! %D \n",count);CHKERRQ(ierr);
1744       ierr = PetscInfo5(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lambda=%18.16e, initial slope=%18.16e\n",fnorm,*gnorm,*ynorm,lambda,initslope);CHKERRQ(ierr);
1745       *flag = PETSC_FALSE;
1746       snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
1747       break;
1748     }
1749     ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1750     if (snes->ops->solve != SNESSolveVI_SS) {
1751       ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1752     } else {
1753       ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1754     }
1755     if (snes->domainerror) {
1756       ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1757       PetscFunctionReturn(0);
1758     }
1759     if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1760     if (.5*(*gnorm)*(*gnorm) < .5*fnorm*fnorm + lambda*vi->alpha*initslope) { /* is reduction enough? */
1761       if (vi->lsmonitor) {
1762 	ierr = PetscPrintf(comm,"    Line search: Cubically determined step, current gnorm %G lambda=%18.16e\n",*gnorm,lambda);CHKERRQ(ierr);
1763       }
1764       break;
1765     } else {
1766       if (vi->lsmonitor) {
1767         ierr = PetscPrintf(comm,"    Line search: Cubic step no good, shrinking lambda, current gnorm %G lambda=%18.16e\n",*gnorm,lambda);CHKERRQ(ierr);
1768       }
1769     }
1770     count++;
1771   }
1772   theend1:
1773   /* Optional user-defined check for line search step validity */
1774   if (vi->postcheckstep && *flag) {
1775     ierr = (*vi->postcheckstep)(snes,x,y,w,vi->postcheck,&changed_y,&changed_w);CHKERRQ(ierr);
1776     if (changed_y) {
1777       ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);
1778       ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1779     }
1780     if (changed_y || changed_w) { /* recompute the function if the step has changed */
1781       ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1782       if (snes->ops->solve != SNESSolveVI_SS) {
1783         ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1784       } else {
1785         ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1786       }
1787       if (snes->domainerror) {
1788         ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1789         PetscFunctionReturn(0);
1790       }
1791       if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1792       ierr = VecNormBegin(y,NORM_2,ynorm);CHKERRQ(ierr);
1793       ierr = VecNormEnd(y,NORM_2,ynorm);CHKERRQ(ierr);
1794     }
1795   }
1796   ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1797   PetscFunctionReturn(0);
1798 }
1799 
1800 #undef __FUNCT__
1801 #define __FUNCT__ "SNESLineSearchQuadratic_VI"
1802 /*
1803   This routine does a quadratic line search while keeping the iterates within the variable bounds
1804 */
1805 PetscErrorCode SNESLineSearchQuadratic_VI(SNES snes,void *lsctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal xnorm,PetscReal *ynorm,PetscReal *gnorm,PetscBool *flag)
1806 {
1807   /*
1808      Note that for line search purposes we work with with the related
1809      minimization problem:
1810         min  z(x):  R^n -> R,
1811      where z(x) = .5 * fnorm*fnorm,and fnorm = || f ||_2.
1812    */
1813   PetscReal      initslope,minlambda,lambda,lambdatemp,rellength;
1814 #if defined(PETSC_USE_COMPLEX)
1815   PetscScalar    cinitslope;
1816 #endif
1817   PetscErrorCode ierr;
1818   PetscInt       count;
1819   SNES_VI        *vi = (SNES_VI*)snes->data;
1820   PetscBool     changed_w = PETSC_FALSE,changed_y = PETSC_FALSE;
1821 
1822   PetscFunctionBegin;
1823   ierr    = PetscLogEventBegin(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1824   *flag   = PETSC_TRUE;
1825 
1826   ierr = VecNorm(y,NORM_2,ynorm);CHKERRQ(ierr);
1827   if (*ynorm == 0.0) {
1828     if (vi->lsmonitor) {
1829       ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"Line search: Direction and size is 0\n");CHKERRQ(ierr);
1830     }
1831     *gnorm = fnorm;
1832     ierr   = VecCopy(x,w);CHKERRQ(ierr);
1833     ierr   = VecCopy(f,g);CHKERRQ(ierr);
1834     *flag  = PETSC_FALSE;
1835     goto theend2;
1836   }
1837   if (*ynorm > vi->maxstep) {	/* Step too big, so scale back */
1838     ierr   = VecScale(y,vi->maxstep/(*ynorm));CHKERRQ(ierr);
1839     *ynorm = vi->maxstep;
1840   }
1841   ierr      = VecMaxPointwiseDivide(y,x,&rellength);CHKERRQ(ierr);
1842   minlambda = vi->minlambda/rellength;
1843   ierr = MatMult(snes->jacobian,y,w);CHKERRQ(ierr);
1844 #if defined(PETSC_USE_COMPLEX)
1845   ierr      = VecDot(f,w,&cinitslope);CHKERRQ(ierr);
1846   initslope = PetscRealPart(cinitslope);
1847 #else
1848   ierr = VecDot(f,w,&initslope);CHKERRQ(ierr);
1849 #endif
1850   if (initslope > 0.0)  initslope = -initslope;
1851   if (initslope == 0.0) initslope = -1.0;
1852   ierr = PetscInfo1(snes,"Initslope %G \n",initslope);CHKERRQ(ierr);
1853 
1854   ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);
1855   ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1856   if (snes->nfuncs >= snes->max_funcs) {
1857     ierr  = PetscInfo(snes,"Exceeded maximum function evaluations, while checking full step length!\n");CHKERRQ(ierr);
1858     *flag = PETSC_FALSE;
1859     snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
1860     goto theend2;
1861   }
1862   ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1863   if (snes->ops->solve != SNESSolveVI_SS) {
1864     ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1865   } else {
1866     ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1867   }
1868   if (snes->domainerror) {
1869     ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1870     PetscFunctionReturn(0);
1871   }
1872   if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1873   if (.5*(*gnorm)*(*gnorm) <= .5*fnorm*fnorm + vi->alpha*initslope) { /* Sufficient reduction */
1874     if (vi->lsmonitor) {
1875       ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line search: Using full step: fnorm %G gnorm %G\n",fnorm,*gnorm);CHKERRQ(ierr);
1876     }
1877     goto theend2;
1878   }
1879 
1880   /* Fit points with quadratic */
1881   lambda = 1.0;
1882   count = 1;
1883   while (PETSC_TRUE) {
1884     if (lambda <= minlambda) { /* bad luck; use full step */
1885       if (vi->lsmonitor) {
1886         ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"Line search: Unable to find good step length! %D \n",count);CHKERRQ(ierr);
1887         ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"Line search: fnorm=%G, gnorm=%G, ynorm=%G, lambda=%G, initial slope=%G\n",fnorm,*gnorm,*ynorm,lambda,initslope);CHKERRQ(ierr);
1888       }
1889       ierr = VecCopy(x,w);CHKERRQ(ierr);
1890       *flag = PETSC_FALSE;
1891       break;
1892     }
1893     lambdatemp = -initslope/((*gnorm)*(*gnorm) - fnorm*fnorm - 2.0*initslope);
1894     if (lambdatemp > .5*lambda)  lambdatemp = .5*lambda;
1895     if (lambdatemp <= .1*lambda) lambda     = .1*lambda;
1896     else                         lambda     = lambdatemp;
1897 
1898     ierr = VecWAXPY(w,-lambda,y,x);CHKERRQ(ierr);
1899     ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1900     if (snes->nfuncs >= snes->max_funcs) {
1901       ierr  = PetscInfo1(snes,"Exceeded maximum function evaluations, while looking for good step length! %D \n",count);CHKERRQ(ierr);
1902       ierr  = PetscInfo5(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lambda=%18.16e, initial slope=%18.16e\n",fnorm,*gnorm,*ynorm,lambda,initslope);CHKERRQ(ierr);
1903       *flag = PETSC_FALSE;
1904       snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
1905       break;
1906     }
1907     ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
1908     if (snes->domainerror) {
1909       ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1910       PetscFunctionReturn(0);
1911     }
1912     if (snes->ops->solve != SNESSolveVI_SS) {
1913       ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1914     } else {
1915       ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1916     }
1917     if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1918     if (.5*(*gnorm)*(*gnorm) < .5*fnorm*fnorm + lambda*vi->alpha*initslope) { /* sufficient reduction */
1919       if (vi->lsmonitor) {
1920         ierr = PetscViewerASCIIMonitorPrintf(vi->lsmonitor,"    Line Search: Quadratically determined step, lambda=%G\n",lambda);CHKERRQ(ierr);
1921       }
1922       break;
1923     }
1924     count++;
1925   }
1926   theend2:
1927   /* Optional user-defined check for line search step validity */
1928   if (vi->postcheckstep) {
1929     ierr = (*vi->postcheckstep)(snes,x,y,w,vi->postcheck,&changed_y,&changed_w);CHKERRQ(ierr);
1930     if (changed_y) {
1931       ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr);
1932       ierr = SNESVIProjectOntoBounds(snes,w);CHKERRQ(ierr);
1933     }
1934     if (changed_y || changed_w) { /* recompute the function if the step has changed */
1935       ierr = SNESComputeFunction(snes,w,g);
1936       if (snes->domainerror) {
1937         ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1938         PetscFunctionReturn(0);
1939       }
1940       if (snes->ops->solve != SNESSolveVI_SS) {
1941         ierr = SNESVIComputeInactiveSetFnorm(snes,g,w,gnorm);CHKERRQ(ierr);
1942       } else {
1943         ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr);
1944       }
1945 
1946       ierr = VecNormBegin(y,NORM_2,ynorm);CHKERRQ(ierr);
1947       ierr = VecNormEnd(y,NORM_2,ynorm);CHKERRQ(ierr);
1948       if (PetscIsInfOrNanReal(*gnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
1949     }
1950   }
1951   ierr = PetscLogEventEnd(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
1952   PetscFunctionReturn(0);
1953 }
1954 
1955 typedef PetscErrorCode (*FCN2)(SNES,void*,Vec,Vec,Vec,Vec,Vec,PetscReal,PetscReal,PetscReal*,PetscReal*,PetscBool*); /* force argument to next function to not be extern C*/
1956 /* -------------------------------------------------------------------------- */
1957 EXTERN_C_BEGIN
1958 #undef __FUNCT__
1959 #define __FUNCT__ "SNESLineSearchSet_VI"
1960 PetscErrorCode  SNESLineSearchSet_VI(SNES snes,FCN2 func,void *lsctx)
1961 {
1962   PetscFunctionBegin;
1963   ((SNES_VI *)(snes->data))->LineSearch = func;
1964   ((SNES_VI *)(snes->data))->lsP        = lsctx;
1965   PetscFunctionReturn(0);
1966 }
1967 EXTERN_C_END
1968 
1969 /* -------------------------------------------------------------------------- */
1970 EXTERN_C_BEGIN
1971 #undef __FUNCT__
1972 #define __FUNCT__ "SNESLineSearchSetMonitor_VI"
1973 PetscErrorCode  SNESLineSearchSetMonitor_VI(SNES snes,PetscBool flg)
1974 {
1975   SNES_VI        *vi = (SNES_VI*)snes->data;
1976   PetscErrorCode ierr;
1977 
1978   PetscFunctionBegin;
1979   if (flg && !vi->lsmonitor) {
1980     ierr = PetscViewerASCIIMonitorCreate(((PetscObject)snes)->comm,"stdout",((PetscObject)snes)->tablevel,&vi->lsmonitor);CHKERRQ(ierr);
1981   } else if (!flg && vi->lsmonitor) {
1982     ierr = PetscViewerASCIIMonitorDestroy(vi->lsmonitor);CHKERRQ(ierr);
1983   }
1984   PetscFunctionReturn(0);
1985 }
1986 EXTERN_C_END
1987 
1988 /*
1989    SNESView_VI - Prints info from the SNESVI data structure.
1990 
1991    Input Parameters:
1992 .  SNES - the SNES context
1993 .  viewer - visualization context
1994 
1995    Application Interface Routine: SNESView()
1996 */
1997 #undef __FUNCT__
1998 #define __FUNCT__ "SNESView_VI"
1999 static PetscErrorCode SNESView_VI(SNES snes,PetscViewer viewer)
2000 {
2001   SNES_VI        *vi = (SNES_VI *)snes->data;
2002   const char     *cstr,*tstr;
2003   PetscErrorCode ierr;
2004   PetscBool     iascii;
2005 
2006   PetscFunctionBegin;
2007   ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
2008   if (iascii) {
2009     if (vi->LineSearch == SNESLineSearchNo_VI)             cstr = "SNESLineSearchNo";
2010     else if (vi->LineSearch == SNESLineSearchQuadratic_VI) cstr = "SNESLineSearchQuadratic";
2011     else if (vi->LineSearch == SNESLineSearchCubic_VI)     cstr = "SNESLineSearchCubic";
2012     else                                                             cstr = "unknown";
2013     if (snes->ops->solve == SNESSolveVI_SS)      tstr = "Semismooth";
2014     else if (snes->ops->solve == SNESSolveVI_RS) tstr = "Reduced Space";
2015     else if (snes->ops->solve == SNESSolveVI_RS2) tstr = "Augmented Space";
2016     else                                         tstr = "unknown";
2017     ierr = PetscViewerASCIIPrintf(viewer,"  VI algorithm: %s\n",tstr);CHKERRQ(ierr);
2018     ierr = PetscViewerASCIIPrintf(viewer,"  line search variant: %s\n",cstr);CHKERRQ(ierr);
2019     ierr = PetscViewerASCIIPrintf(viewer,"  alpha=%G, maxstep=%G, minlambda=%G\n",vi->alpha,vi->maxstep,vi->minlambda);CHKERRQ(ierr);
2020   } else {
2021     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported for SNES EQ VI",((PetscObject)viewer)->type_name);
2022   }
2023   PetscFunctionReturn(0);
2024 }
2025 
2026 #undef __FUNCT__
2027 #define __FUNCT__ "SNESVISetVariableBounds"
2028 /*@
2029    SNESVISetVariableBounds - Sets the lower and upper bounds for the solution vector. xl <= x <= xu.
2030 
2031    Input Parameters:
2032 .  snes - the SNES context.
2033 .  xl   - lower bound.
2034 .  xu   - upper bound.
2035 
2036    Notes:
2037    If this routine is not called then the lower and upper bounds are set to
2038    PETSC_VI_INF and PETSC_VI_NINF respectively during SNESSetUp().
2039 
2040 @*/
2041 PetscErrorCode SNESVISetVariableBounds(SNES snes, Vec xl, Vec xu)
2042 {
2043   SNES_VI  *vi = (SNES_VI*)snes->data;
2044 
2045   PetscFunctionBegin;
2046   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
2047   PetscValidHeaderSpecific(xl,VEC_CLASSID,2);
2048   PetscValidHeaderSpecific(xu,VEC_CLASSID,3);
2049   if (!snes->vec_func) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call SNESSetFunction() first");
2050   if (xl->map->N != snes->vec_func->map->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Incompatible vector lengths lower bound = %D solution vector = %D",xl->map->N,snes->vec_func->map->N);
2051   if (xu->map->N != snes->vec_func->map->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Incompatible vector lengths: upper bound = %D solution vector = %D",xu->map->N,snes->vec_func->map->N);
2052 
2053   vi->usersetxbounds = PETSC_TRUE;
2054   vi->xl = xl;
2055   vi->xu = xu;
2056   PetscFunctionReturn(0);
2057 }
2058 
2059 /* -------------------------------------------------------------------------- */
2060 /*
2061    SNESSetFromOptions_VI - Sets various parameters for the SNESVI method.
2062 
2063    Input Parameter:
2064 .  snes - the SNES context
2065 
2066    Application Interface Routine: SNESSetFromOptions()
2067 */
2068 #undef __FUNCT__
2069 #define __FUNCT__ "SNESSetFromOptions_VI"
2070 static PetscErrorCode SNESSetFromOptions_VI(SNES snes)
2071 {
2072   SNES_VI        *vi = (SNES_VI *)snes->data;
2073   const char     *lses[] = {"basic","basicnonorms","quadratic","cubic"};
2074   const char     *vies[] = {"ss","rs","rs2"};
2075   PetscErrorCode ierr;
2076   PetscInt       indx;
2077   PetscBool      flg,set,flg2;
2078 
2079   PetscFunctionBegin;
2080   ierr = PetscOptionsHead("SNES semismooth method options");CHKERRQ(ierr);
2081   ierr = PetscOptionsBool("-snes_vi_monitor","Monitor all non-active variables","None",PETSC_FALSE,&flg,0);CHKERRQ(ierr);
2082   if (flg) {
2083     ierr = SNESMonitorSet(snes,SNESMonitorVI,0,0);CHKERRQ(ierr);
2084   }
2085   ierr = PetscOptionsReal("-snes_ls_alpha","Function norm must decrease by","None",vi->alpha,&vi->alpha,0);CHKERRQ(ierr);
2086   ierr = PetscOptionsReal("-snes_ls_maxstep","Step must be less than","None",vi->maxstep,&vi->maxstep,0);CHKERRQ(ierr);
2087   ierr = PetscOptionsReal("-snes_ls_minlambda","Minimum lambda allowed","None",vi->minlambda,&vi->minlambda,0);CHKERRQ(ierr);
2088   ierr = PetscOptionsReal("-snes_vi_const_tol","constraint tolerance","None",vi->const_tol,&vi->const_tol,0);CHKERRQ(ierr);
2089   ierr = PetscOptionsBool("-snes_ls_monitor","Print progress of line searches","SNESLineSearchSetMonitor",vi->lsmonitor ? PETSC_TRUE : PETSC_FALSE,&flg,&set);CHKERRQ(ierr);
2090   if (set) {ierr = SNESLineSearchSetMonitor(snes,flg);CHKERRQ(ierr);}
2091   ierr = PetscOptionsEList("-snes_vi_type","Semismooth algorithm used","",vies,3,"ss",&indx,&flg2);CHKERRQ(ierr);
2092   if (flg2) {
2093     switch (indx) {
2094     case 0:
2095       snes->ops->solve = SNESSolveVI_SS;
2096       break;
2097     case 1:
2098       snes->ops->solve = SNESSolveVI_RS;
2099       break;
2100     case 2:
2101       snes->ops->solve = SNESSolveVI_RS2;
2102     }
2103   }
2104   ierr = PetscOptionsEList("-snes_ls","Line search used","SNESLineSearchSet",lses,4,"basic",&indx,&flg);CHKERRQ(ierr);
2105   if (flg) {
2106     switch (indx) {
2107     case 0:
2108       ierr = SNESLineSearchSet(snes,SNESLineSearchNo_VI,PETSC_NULL);CHKERRQ(ierr);
2109       break;
2110     case 1:
2111       ierr = SNESLineSearchSet(snes,SNESLineSearchNoNorms_VI,PETSC_NULL);CHKERRQ(ierr);
2112       break;
2113     case 2:
2114       ierr = SNESLineSearchSet(snes,SNESLineSearchQuadratic_VI,PETSC_NULL);CHKERRQ(ierr);
2115       break;
2116     case 3:
2117       ierr = SNESLineSearchSet(snes,SNESLineSearchCubic_VI,PETSC_NULL);CHKERRQ(ierr);
2118       break;
2119     }
2120   }
2121   ierr = PetscOptionsTail();CHKERRQ(ierr);
2122   PetscFunctionReturn(0);
2123 }
2124 /* -------------------------------------------------------------------------- */
2125 /*MC
2126       SNESVI - Semismooth newton method based nonlinear solver that uses a line search
2127 
2128    Options Database:
2129 +   -snes_ls [cubic,quadratic,basic,basicnonorms] - Selects line search
2130 .   -snes_ls_alpha <alpha> - Sets alpha
2131 .   -snes_ls_maxstep <maxstep> - Sets the maximum stepsize the line search will use (if the 2-norm(y) > maxstep then scale y to be y = (maxstep/2-norm(y)) *y)
2132 .   -snes_ls_minlambda <minlambda>  - Sets the minimum lambda the line search will use  minlambda / max_i ( y[i]/x[i] )
2133 -   -snes_ls_monitor - print information about progress of line searches
2134 
2135 
2136    Level: beginner
2137 
2138 .seealso:  SNESCreate(), SNES, SNESSetType(), SNESTR, SNESLineSearchSet(),
2139            SNESLineSearchSetPostCheck(), SNESLineSearchNo(), SNESLineSearchCubic(), SNESLineSearchQuadratic(),
2140            SNESLineSearchSet(), SNESLineSearchNoNorms(), SNESLineSearchSetPreCheck(), SNESLineSearchSetParams(), SNESLineSearchGetParams()
2141 
2142 M*/
2143 EXTERN_C_BEGIN
2144 #undef __FUNCT__
2145 #define __FUNCT__ "SNESCreate_VI"
2146 PetscErrorCode  SNESCreate_VI(SNES snes)
2147 {
2148   PetscErrorCode ierr;
2149   SNES_VI      *vi;
2150 
2151   PetscFunctionBegin;
2152   snes->ops->setup	     = SNESSetUp_VI;
2153   snes->ops->solve	     = SNESSolveVI_SS;
2154   snes->ops->destroy	     = SNESDestroy_VI;
2155   snes->ops->setfromoptions  = SNESSetFromOptions_VI;
2156   snes->ops->view            = SNESView_VI;
2157   snes->ops->converged       = SNESDefaultConverged_VI;
2158 
2159   ierr                   = PetscNewLog(snes,SNES_VI,&vi);CHKERRQ(ierr);
2160   snes->data    	 = (void*)vi;
2161   vi->alpha		 = 1.e-4;
2162   vi->maxstep		 = 1.e8;
2163   vi->minlambda         = 1.e-12;
2164   vi->LineSearch        = SNESLineSearchNo_VI;
2165   vi->lsP               = PETSC_NULL;
2166   vi->postcheckstep     = PETSC_NULL;
2167   vi->postcheck         = PETSC_NULL;
2168   vi->precheckstep      = PETSC_NULL;
2169   vi->precheck          = PETSC_NULL;
2170   vi->const_tol         =  2.2204460492503131e-16;
2171   vi->checkredundancy   = PETSC_NULL;
2172 
2173   ierr = PetscObjectComposeFunctionDynamic((PetscObject)snes,"SNESLineSearchSetMonitor_C","SNESLineSearchSetMonitor_VI",SNESLineSearchSetMonitor_VI);CHKERRQ(ierr);
2174   ierr = PetscObjectComposeFunctionDynamic((PetscObject)snes,"SNESLineSearchSet_C","SNESLineSearchSet_VI",SNESLineSearchSet_VI);CHKERRQ(ierr);
2175 
2176   PetscFunctionReturn(0);
2177 }
2178 EXTERN_C_END
2179