Actual source code: gltr.c

  1: #define PETSCKSP_DLL

  3: #include <math.h>
 4:  #include include/private/kspimpl.h
 5:  #include include/petscblaslapack.h
 6:  #include src/ksp/ksp/impls/cg/gltr/gltr.h

 10: /*@
 11:     KSPGLTRSetRadius - Sets the radius of the trust region.

 13:     Collective on KSP

 15:     Input Parameters:
 16: +   ksp    - the iterative context
 17: -   radius - the trust region radius (Infinity is the default)

 19:     Options Database Key:
 20: .   -ksp_gltr_radius <r>

 22:     Level: advanced

 24: .keywords: KSP, GLTR, set, trust region radius
 25: @*/
 26: PetscErrorCode  KSPGLTRSetRadius(KSP ksp, PetscReal radius)
 27: {
 28:   PetscErrorCode ierr, (*f)(KSP, PetscReal);

 32:   if (radius < 0.0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Tolerance must be positive");
 33:   PetscObjectQueryFunction((PetscObject)ksp, "KSPGLTRSetRadius_C", (void (**)(void))&f);
 34:   if (f) {
 35:     (*f)(ksp, radius);
 36:   }
 37:   return(0);
 38: }

 42: /*@
 43:     KSPGLTRGetNormD - Get norm of the direction.

 45:     Collective on KSP

 47:     Input Parameters:
 48: +   ksp    - the iterative context
 49: -   norm_d - the norm of the direction

 51:     Level: advanced

 53: .keywords: KSP, GLTR, get, norm direction
 54: @*/
 55: PetscErrorCode  KSPGLTRGetNormD(KSP ksp,PetscReal *norm_d)
 56: {
 57:   PetscErrorCode ierr, (*f)(KSP, PetscReal *);

 61:   PetscObjectQueryFunction((PetscObject)ksp, "KSPGLTRGetNormD_C", (void (**)(void))&f);
 62:   if (f) {
 63:     (*f)(ksp, norm_d);
 64:   }
 65:   return(0);
 66: }

 70: /*@
 71:     KSPGLTRGetObjFcn - Get objective function value.

 73:     Collective on KSP

 75:     Input Parameters:
 76: +   ksp   - the iterative context
 77: -   o_fcn - the objective function value

 79:     Level: advanced

 81: .keywords: KSP, GLTR, get, objective function
 82: @*/
 83: PetscErrorCode  KSPGLTRGetObjFcn(KSP ksp,PetscReal *o_fcn)
 84: {
 85:   PetscErrorCode ierr, (*f)(KSP, PetscReal *);

 89:   PetscObjectQueryFunction((PetscObject)ksp, "KSPGLTRGetObjFcn_C", (void (**)(void))&f);
 90:   if (f) {
 91:     (*f)(ksp, o_fcn);
 92:   }
 93:   return(0);
 94: }

 98: /*@
 99:     KSPGLTRGetMinEig - Get minimum eigenvalue.

101:     Collective on KSP

103:     Input Parameters:
104: +   ksp   - the iterative context
105: -   e_min - the minimum eigenvalue

107:     Level: advanced

109: .keywords: KSP, GLTR, get, minimum eigenvalue
110: @*/
111: PetscErrorCode  KSPGLTRGetMinEig(KSP ksp,PetscReal *e_min)
112: {
113:   PetscErrorCode ierr, (*f)(KSP, PetscReal *);

117:   PetscObjectQueryFunction((PetscObject)ksp, "KSPGLTRGetMinEig_C", (void (**)(void))&f);
118:   if (f) {
119:     (*f)(ksp, e_min);
120:   }
121:   return(0);
122: }

126: /*@
127:     KSPGLTRGetLambda - Get multiplier on trust-region constraint.

129:     Collective on KSP

131:     Input Parameters:
132: +   ksp    - the iterative context
133: -   lambda - the multiplier

135:     Level: advanced

137: .keywords: KSP, GLTR, get, multiplier
138: @*/
139: PetscErrorCode  KSPGLTRGetLambda(KSP ksp,PetscReal *lambda)
140: {
141:   PetscErrorCode ierr, (*f)(KSP, PetscReal *);

145:   PetscObjectQueryFunction((PetscObject)ksp, "KSPGLTRGetLambda_C", (void (**)(void))&f);
146:   if (f) {
147:     (*f)(ksp, lambda);
148:   }
149:   return(0);
150: }

154: /*
155:   KSPSolve_GLTR - Use preconditioned conjugate gradient to compute
156:   an approximate minimizer of the quadratic function

158:             q(s) = g^T * s + .5 * s^T * H * s

160:    subject to the trust region constraint

162:             || s ||_M <= delta,

164:    where

166:      delta is the trust region radius,
167:      g is the gradient vector, and
168:      H is the Hessian matrix,
169:      M is the positive definite preconditioner matrix.

171:    KSPConvergedReason may be
172: $  KSP_CONVERGED_CG_NEG_CURVE if convergence is reached along a negative curvature direction,
173: $  KSP_CONVERGED_CG_CONSTRAINED if convergence is reached along a constrained step,
174: $  other KSP converged/diverged reasons


177:   Notes:
178:   The preconditioner supplied should be symmetric and positive definite.
179: */

181: PetscErrorCode KSPSolve_GLTR(KSP ksp)
182: {
183: #ifdef PETSC_USE_COMPLEX
184:   SETERRQ(PETSC_ERR_SUP, "GLTR is not available for complex systems");
185: #else
186:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;
187:   PetscReal *t_soln, *t_diag, *t_offd, *e_valu, *e_vect, *e_rwrk;
188:   PetscBLASInt  *e_iblk, *e_splt, *e_iwrk;

191:   MatStructure  pflag;
192:   Mat Qmat, Mmat;
193:   Vec r, z, p, d;
194:   PC  pc;
195:   PetscReal norm_r, norm_d, norm_dp1, norm_p, dMp;
196:   PetscReal alpha, beta, kappa, rz, rzm1;
197:   PetscReal rr, r2, piv, step;
198:   PetscReal vl, vu;
199:   PetscReal coef1, coef2, coef3, root1, root2, obj1, obj2;
200:   PetscReal norm_t, norm_w, pert;
201:   PetscInt  i, j, max_cg_its, max_lanczos_its, max_newton_its, sigma;
202:   PetscBLASInt t_size = 0, il, iu, e_valus, info;
203:   PetscBLASInt nrhs, nldb;

205: #if !defined(PETSC_MISSING_LAPACK_STEBZ)
206:   PetscBLASInt e_splts;
207: #endif

209:   KSPConvergedReason reason;
210:   PetscTruth diagonalscale;


214:   /***************************************************************************/
215:   /* Check the arguments and parameters.                                     */
216:   /***************************************************************************/

218:   PCDiagonalScale(ksp->pc, &diagonalscale);
219:   if (diagonalscale) {
220:     SETERRQ1(PETSC_ERR_SUP, "Krylov method %s does not support diagonal scaling", ksp->type_name);
221:   }

223:   if (cg->radius < 0.0) {
224:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Input error: radius < 0");
225:   }

227:   /***************************************************************************/
228:   /* Get the workspace vectors and initialize variables                      */
229:   /***************************************************************************/

231:   r2 = cg->radius * cg->radius;
232:   r  = ksp->work[0];
233:   z  = ksp->work[1];
234:   p  = ksp->work[2];
235:   d  = ksp->vec_sol;
236:   pc = ksp->pc;

238:   PCGetOperators(pc, &Qmat, &Mmat, &pflag);

240:   max_cg_its      = cg->max_cg_its;
241:   max_lanczos_its = cg->max_lanczos_its;
242:   max_newton_its  = cg->max_newton_its;
243:   ksp->its = 0;

245:   /***************************************************************************/
246:   /* Initialize objective function value and minimum eigenvalue.             */
247:   /***************************************************************************/

249:   cg->e_min = 0.0;
250:   cg->o_fcn = 0.0;
251:   cg->lambda = 0.0;

253:   /***************************************************************************/
254:   /* The first phase of GLTR performs a standard conjugate gradient method,  */
255:   /* but stores the values required for the Lanczos matrix.  We switch to    */
256:   /* the Lanczos when the conjugate gradient method breaks down.             */
257:   /***************************************************************************/

259:   VecSet(d, 0.0);                         /* d = 0             */
260:   VecCopy(ksp->vec_rhs, r);         /* r = -grad         */
261:   KSP_PCApply(ksp, r, z);                 /* z = inv(M) r      */
262:   cg->norm_d = 0.0;

264:   /***************************************************************************/
265:   /* Check the preconditioners for numerical problems and for positive       */
266:   /* definiteness.  The check for not-a-number and infinite values need be   */
267:   /* performed only once.                                                    */
268:   /***************************************************************************/

270:   VecDot(r, z, &rz);                 /* rz = r^T inv(M) r */
271:   if ((rz != rz) || (rz && (rz / rz != rz / rz))) {
272:     /*************************************************************************/
273:     /* The preconditioner produced not-a-number or an infinite value.  This  */
274:     /* can appear either due to r having numerical problems or M having      */
275:     /* numerical problems.  Differentiate between the two and then use the   */
276:     /* gradient direction.                                                   */
277:     /*************************************************************************/

279:     ksp->reason = KSP_DIVERGED_NAN;
280:     VecDot(r, r, &rr);                 /* rr = r^T r        */
281:     if ((rr != rr) || (rr && (rr / rr != rr / rr))) {
282:       /***********************************************************************/
283:       /* The right-hand side contains not-a-number or an infinite value.     */
284:       /* The gradient step does not work; return a zero value for the step.  */
285:       /***********************************************************************/

287:       PetscInfo1(ksp, "KSPSolve_GLTR: bad right-hand side: rr=%g\n", rr);
288:     }
289:     else {
290:       /***********************************************************************/
291:       /* The preconditioner contains not-a-number or an infinite value.      */
292:       /***********************************************************************/

294:       PetscInfo1(ksp, "KSPSolve_GLTR: bad preconditioner: rz=%g\n", rz);

296:       if (cg->radius) {
297:         alpha = sqrt(r2 / rr);
298:         VecAXPY(d, alpha, r);         /* d = d + alpha r   */
299:         cg->norm_d = cg->radius;
300: 
301:         /*********************************************************************/
302:         /* Compute objective function.                                       */
303:         /*********************************************************************/

305:         KSP_MatMult(ksp, Qmat, d, z); CHKERRQ(ierr)
306:         VecAYPX(z, -0.5, ksp->vec_rhs);
307:         VecDot(d, z, &cg->o_fcn);
308:         cg->o_fcn = -cg->o_fcn;
309:       }
310:     }
311:     return(0);
312:   }

314:   if (rz < 0.0) {
315:     /*************************************************************************/
316:     /* The preconditioner is indefinite.  Because this is the first          */
317:     /* and we do not have a direction yet, we use the gradient step.  Note   */
318:     /* that we cannot use the preconditioned norm when computing the step    */
319:     /* because the matrix is indefinite.                                     */
320:     /*************************************************************************/

322:     ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
323:     PetscInfo1(ksp, "KSPSolve_GLTR: indefinite preconditioner: rz=%g\n", rz);

325:     if (cg->radius) {
326:       VecDot(r, r, &rr);                 /* rr = r^T r        */
327:       alpha = sqrt(r2 / rr);
328:       VecAXPY(d, alpha, r);         /* d = d + alpha r   */
329:       cg->norm_d = cg->radius;

331:       /***********************************************************************/
332:       /* Compute objective function.                                         */
333:       /***********************************************************************/

335:       KSP_MatMult(ksp, Qmat, d, z); CHKERRQ(ierr)
336:       VecAYPX(z, -0.5, ksp->vec_rhs);
337:       VecDot(d, z, &cg->o_fcn);
338:       cg->o_fcn = -cg->o_fcn;
339:     }
340:     return(0);
341:   }

343:   /***************************************************************************/
344:   /* As far as we know, the preconditioner is positive semidefinite.  Compute*/
345:   /* the residual and check for convergence.  Note that there is no choice   */
346:   /* in the residual that can be used; we must always use the natural        */
347:   /* residual because this is the only one that can be used by the           */
348:   /* preconditioned Lanzcos method.                                          */
349:   /***************************************************************************/

351:   norm_r = sqrt(rz);                                        /* norm_r = |r|_M    */
352:   cg->norm_r[0] = norm_r;

354:   KSPLogResidualHistory(ksp, norm_r);
355:   KSPMonitor(ksp, 0, norm_r);
356:   ksp->rnorm = norm_r;

358:   (*ksp->converged)(ksp, 0, norm_r, &ksp->reason, ksp->cnvP);
359:   if (ksp->reason) {
360:     return(0);
361:   }

363:   /***************************************************************************/
364:   /* We have not converged.  Compute the first direction and check the       */
365:   /* matrix for numerical problems.                                          */
366:   /***************************************************************************/

368:   VecCopy(z, p);                         /* p = z             */
369:   KSP_MatMult(ksp, Qmat, p, z);         /* z = Q * p         */
370:   VecDot(p, z, &kappa);                 /* kappa = p^T Q p   */
371:   if ((kappa != kappa) || (kappa && (kappa / kappa != kappa / kappa))) {
372:     /*************************************************************************/
373:     /* The matrix produced not-a-number or an infinite value.  In this case, */
374:     /* we must stop and use the gradient direction.  This condition need     */
375:     /* only be checked once.                                                 */
376:     /*************************************************************************/

378:     ksp->reason = KSP_DIVERGED_NAN;
379:     PetscInfo1(ksp, "KSPSolve_GLTR: bad matrix: kappa=%g\n", kappa);

381:     if (cg->radius) {
382:       VecDot(r, r, &rr);                 /* rr = r^T r        */
383:       alpha = sqrt(r2 / rr);
384:       VecAXPY(d, alpha, r);         /* d = d + alpha r   */
385:       cg->norm_d = cg->radius;

387:       /***********************************************************************/
388:       /* Compute objective function.                                         */
389:       /***********************************************************************/

391:       KSP_MatMult(ksp, Qmat, d, z); CHKERRQ(ierr)
392:       VecAYPX(z, -0.5, ksp->vec_rhs);
393:       VecDot(d, z, &cg->o_fcn);
394:       cg->o_fcn = -cg->o_fcn;
395:     }
396:     return(0);
397:   }

399:   /***************************************************************************/
400:   /* Check for breakdown of the conjugate gradient method; this occurs when  */
401:   /* kappa is zero.                                                          */
402:   /***************************************************************************/

404:   if (fabs(kappa) <= 0.0) {
405:     /*************************************************************************/
406:     /* The curvature is zero.  In this case, we must stop and use the        */
407:     /* since there the Lanczos matrix is not available.                      */
408:     /*************************************************************************/
409:     ksp->reason = KSP_DIVERGED_BREAKDOWN;
410:     PetscInfo1(ksp, "KSPSolve_GLTR: breakdown: kappa=%g\n", kappa);

412:     if (cg->radius) {
413:       VecDot(r, r, &rr);                 /* rr = r^T r        */
414:       alpha = sqrt(r2 / rr);
415:       VecAXPY(d, alpha, r);         /* d = d + alpha r   */
416:       cg->norm_d = cg->radius;

418:       /***********************************************************************/
419:       /* Compute objective function.                                         */
420:       /***********************************************************************/

422:       KSP_MatMult(ksp, Qmat, d, z); CHKERRQ(ierr)
423:       VecAYPX(z, -0.5, ksp->vec_rhs);
424:       VecDot(d, z, &cg->o_fcn);
425:       cg->o_fcn = -cg->o_fcn;
426:     }
427:     return(0);
428:   }

430:   /***************************************************************************/
431:   /* Initialize variables for calculating the norm of the direction and for  */
432:   /* the Lanczos tridiagonal matrix.  Note that we track the diagonal value  */
433:   /* of the Cholesky factorization of the Lanczos matrix in order to         */
434:   /* determine when negative curvature is encountered.                       */
435:   /***************************************************************************/

437:   dMp = 0.0;
438:   norm_p = rz;
439:   norm_d = 0.0;

441:   cg->diag[t_size] = kappa / rz;
442:   cg->offd[t_size] = 0.0;
443:   ++t_size;

445:   piv = 1.0;

447:   /***************************************************************************/
448:   /* Begin the first part of the GLTR algorithm which runs the conjugate     */
449:   /* gradient method until either the problem is solved, we encounter the    */
450:   /* boundary of the trust region, or the conjugate gradient method breaks   */
451:   /* down.                                                                   */
452:   /***************************************************************************/

454:   for (i = 0; i <= max_cg_its; ++i) {
455:     /*************************************************************************/
456:     /* Know that kappa is nonzero, because we have not broken down, so we    */
457:     /* can compute the steplength.                                           */
458:     /*************************************************************************/

460:     alpha = rz / kappa;
461:     cg->alpha[ksp->its] = alpha;

463:     /*************************************************************************/
464:     /* Compute the diagonal value of the Cholesky factorization of the       */
465:     /* Lanczos matrix and check to see if the Lanczos matrix is indefinite.  */
466:     /* This indicates a direction of negative curvature.                     */
467:     /*************************************************************************/

469:     piv = cg->diag[ksp->its] - cg->offd[ksp->its]*cg->offd[ksp->its] / piv;
470:     if (piv <= 0.0) {
471:       /***********************************************************************/
472:       /* In this case, the matrix is indefinite and we have encountered      */
473:       /* a direction of negative curvature.  Follow the direction to the     */
474:       /* boundary of the trust region.                                       */
475:       /***********************************************************************/

477:       ksp->reason = KSP_CONVERGED_CG_NEG_CURVE;
478:       PetscInfo1(ksp, "KSPSolve_GLTR: negative curvature: kappa=%g\n", kappa);

480:       if (cg->radius) {
481:         step = (sqrt(dMp*dMp+norm_p*(r2-norm_d))-dMp)/norm_p;
482:         VecAXPY(d, step, p);         /* d = d + step p    */
483:         cg->norm_d = cg->radius;

485:         /*********************************************************************/
486:         /* Update objective function.                                        */
487:         /*********************************************************************/

489:         cg->o_fcn += step * (0.5 * step * kappa - rz);
490:       }
491:       break;
492:     }

494:     /*************************************************************************/
495:     /* Compute the steplength and check for intersection with the trust      */
496:     /* region.                                                               */
497:     /*************************************************************************/

499:     norm_dp1 = norm_d + alpha*(2.0*dMp + alpha*norm_p);
500:     if (cg->radius && norm_dp1 >= r2) {
501:       /***********************************************************************/
502:       /* In this case, the matrix is positive definite as far as we know.    */
503:       /* However, the direction does beyond the trust region.  Follow the    */
504:       /* direction to the boundary of the trust region.                      */
505:       /***********************************************************************/

507:       ksp->reason = KSP_CONVERGED_CG_CONSTRAINED;
508:       PetscInfo1(ksp, "KSPSolve_GLTR: constrained step: radius=%g\n", cg->radius);

510:       step = (sqrt(dMp*dMp+norm_p*(r2-norm_d))-dMp)/norm_p;
511:       VecAXPY(d, step, p);         /* d = d + step p    */
512:       cg->norm_d = cg->radius;

514:       /***********************************************************************/
515:       /* Update objective function.                                          */
516:       /***********************************************************************/

518:       cg->o_fcn += step * (0.5 * step * kappa - rz);
519:       break;
520:     }

522:     /*************************************************************************/
523:     /* Now we can update the direction, residual, and objective value.       */
524:     /*************************************************************************/

526:     VecAXPY(d, alpha, p);                 /* d = d + alpha p   */
527:     VecAXPY(r, -alpha, z);                        /* r = r - alpha Q p */
528:     KSP_PCApply(ksp, r, z);

530:     norm_d = norm_dp1;
531:     cg->norm_d = sqrt(norm_d);

533:     cg->o_fcn -= 0.5 * alpha * rz;

535:     /*************************************************************************/
536:     /* Check that the preconditioner appears positive definite.              */
537:     /*************************************************************************/

539:     rzm1 = rz;
540:     VecDot(r, z, &rz);                 /* rz = r^T z        */
541:     if (rz < 0.0) {
542:       /***********************************************************************/
543:       /* The preconditioner is indefinite.                                   */
544:       /***********************************************************************/

546:       ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
547:       PetscInfo1(ksp, "KSPSolve_GLTR: cg indefinite preconditioner: rz=%g\n", rz);
548:       break;
549:     }

551:     /*************************************************************************/
552:     /* As far as we know, the preconditioner is positive definite.  Compute  */
553:     /* the residual and check for convergence.  Note that there is no choice */
554:     /* in the residual that can be used; we must always use the natural      */
555:     /* residual because this is the only one that can be used by the         */
556:     /* preconditioned Lanzcos method.                                        */
557:     /*************************************************************************/

559:     norm_r = sqrt(rz);                                        /* norm_r = |r|_M   */
560:     cg->norm_r[ksp->its+1] = norm_r;

562:     KSPLogResidualHistory(ksp, norm_r);
563:     KSPMonitor(ksp, 0, norm_r);
564:     ksp->rnorm = norm_r;
565: 
566:     (*ksp->converged)(ksp, i+1, norm_r, &ksp->reason, ksp->cnvP);
567:     if (ksp->reason) {
568:       PetscInfo2(ksp,"KSPSolve_GLTR: cg truncated step: rnorm=%g, radius=%g\n",norm_r,cg->radius);
569:       break;
570:     }

572:     /*************************************************************************/
573:     /* We have not converged yet, update p and the norms.                    */
574:     /*************************************************************************/

576:     beta = rz / rzm1;
577:     cg->beta[ksp->its] = beta;
578:     VecAYPX(p, beta, z);           /* p = z + beta p    */

580:     dMp = beta*(dMp + alpha*norm_p);
581:     norm_p = beta*(rzm1 + beta*norm_p);

583:     /*************************************************************************/
584:     /* Compute the new direction                                             */
585:     /*************************************************************************/

587:     KSP_MatMult(ksp, Qmat, p, z);         /* z = Q * p         */
588:     VecDot(p, z, &kappa);                 /* kappa = p^T Q p   */

590:     /*************************************************************************/
591:     /* Update the iteration and the Lanczos tridiagonal matrix.              */
592:     /*************************************************************************/

594:     ++ksp->its;

596:     cg->offd[t_size] = sqrt(beta) / fabs(alpha);
597:     cg->diag[t_size] = kappa / rz + beta / alpha;
598:     ++t_size;

600:     /*************************************************************************/
601:     /* Check for breakdown of the conjugate gradient method; this occurs     */
602:     /* when kappa is zero.                                                   */
603:     /*************************************************************************/

605:     if (fabs(kappa) <= 0.0) {
606:       /***********************************************************************/
607:       /* The method breaks down; move along the direction as if the matrix   */
608:       /* were indefinite.                                                    */
609:       /***********************************************************************/

611:       ksp->reason = KSP_CONVERGED_CG_NEG_CURVE;
612:       PetscInfo1(ksp, "KSPSolve_GLTR: cg breakdown: kappa=%g\n", kappa);

614:       if (cg->radius) {
615:         step = (sqrt(dMp*dMp+norm_p*(r2-norm_d))-dMp)/norm_p;
616:         VecAXPY(d, step, p);         /* d = d + step p    */
617:         cg->norm_d = cg->radius;
618:       }
619:       break;
620:     }
621:   }

623:   if (!ksp->reason) {
624:     ksp->reason = KSP_DIVERGED_ITS;
625:   }

627:   /***************************************************************************/
628:   /* Check to see if we need to continue with the Lanczos method.            */
629:   /***************************************************************************/

631:   if (!cg->radius) {
632:     /*************************************************************************/
633:     /* There is no radius.  Therefore, we cannot move along the boundary.    */
634:     /*************************************************************************/

636:     return(0);
637:   }

639:   if ((KSP_CONVERGED_CG_CONSTRAINED != ksp->reason) &&
640:       (KSP_CONVERGED_CG_NEG_CURVE != ksp->reason)) {
641:     /*************************************************************************/
642:     /* The method either converged to an interior point or the iteration     */
643:     /* limit was reached.                                                    */
644:     /*************************************************************************/

646:     return(0);
647:   }
648:   reason = ksp->reason;

650:   /***************************************************************************/
651:   /* Switch to contructing the Lanczos basis by way of the conjugate         */
652:   /* directions.                                                             */
653:   /***************************************************************************/
654:   for (i = 0; i < max_lanczos_its; ++i) {
655:     /*************************************************************************/
656:     /* Check for breakdown of the conjugate gradient method; this occurs     */
657:     /* when kappa is zero.                                                   */
658:     /*************************************************************************/

660:     if (fabs(kappa) <= 0.0) {
661:       PetscInfo1(ksp, "KSPSolve_GLTR: lanczos breakdown: kappa=%g\n", kappa);
662:       break;
663:     }

665:     /*************************************************************************/
666:     /* Update the direction and residual.                                    */
667:     /*************************************************************************/
668: 
669:     alpha = rz / kappa;
670:     cg->alpha[ksp->its] = alpha;

672:     VecAXPY(r, -alpha, z);                        /* r = r - alpha Q p */
673:     KSP_PCApply(ksp, r, z);

675:     /*************************************************************************/
676:     /* Check that the preconditioner appears positive definite.              */
677:     /*************************************************************************/

679:     rzm1 = rz;
680:     VecDot(r, z, &rz);                 /* rz = r^T z        */
681:     if (rz < 0.0) {
682:       /***********************************************************************/
683:       /* The preconditioner is indefinite.                                   */
684:       /***********************************************************************/

686:       ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
687:       PetscInfo1(ksp, "KSPSolve_GLTR: lanczos indefinite preconditioner: rz=%g\n", rz);
688:       break;
689:     }

691:     /*************************************************************************/
692:     /* As far as we know, the preconditioner is positive definite.  Compute  */
693:     /* the residual and check for convergence.  Note that there is no choice */
694:     /* in the residual that can be used; we must always use the natural      */
695:     /* residual because this is the only one that can be used by the         */
696:     /* preconditioned Lanzcos method.                                        */
697:     /*************************************************************************/

699:     norm_r = sqrt(rz);                                        /* norm_r = |r|_M   */
700:     cg->norm_r[ksp->its+1] = norm_r;

702:     KSPLogResidualHistory(ksp, norm_r);
703:     KSPMonitor(ksp, 0, norm_r);
704:     ksp->rnorm = norm_r;
705: 
706:     (*ksp->converged)(ksp, i+1, norm_r, &ksp->reason, ksp->cnvP);
707:     if (ksp->reason) {
708:       PetscInfo2(ksp,"KSPSolve_GLTR: lanczos truncated step: rnorm=%g, radius=%g\n",norm_r,cg->radius);
709:       break;
710:     }

712:     /*************************************************************************/
713:     /* Update p and the norms.                                               */
714:     /*************************************************************************/

716:     beta = rz / rzm1;
717:     cg->beta[ksp->its] = beta;
718:     VecAYPX(p, beta, z);           /* p = z + beta p    */

720:     /*************************************************************************/
721:     /* Compute the new direction                                             */
722:     /*************************************************************************/

724:     KSP_MatMult(ksp, Qmat, p, z);         /* z = Q * p         */
725:     VecDot(p, z, &kappa);                 /* kappa = p^T Q p   */

727:     /*************************************************************************/
728:     /* Update the iteration and the Lanczos tridiagonal matrix.              */
729:     /*************************************************************************/

731:     ++ksp->its;

733:     cg->offd[t_size] = sqrt(beta) / fabs(alpha);
734:     cg->diag[t_size] = kappa / rz + beta / alpha;
735:     ++t_size;

737:     norm_r = sqrt(rz);                                        /* norm_r = |r|_M   */
738:   }

740:   /***************************************************************************/
741:   /* We have the Lanczos basis, solve the tridiagonal trust-region problem   */
742:   /* to obtain the Lanczos direction.  We know that the solution lies on     */
743:   /* the boundary of the trust region.  We start by checking that the        */
744:   /* workspace allocated is large enough.                                    */
745:   /***************************************************************************/

747:   if (t_size > cg->alloced) {
748:     if (cg->alloced) {
749:       PetscFree(cg->rwork);
750:       PetscFree(cg->iwork);
751:       cg->alloced += cg->init_alloc;
752:     }
753:     else {
754:       cg->alloced = cg->init_alloc;
755:     }

757:     while (t_size > cg->alloced) {
758:       cg->alloced += cg->init_alloc;
759:     }
760: 
761:     cg->alloced = PetscMin(cg->alloced, t_size);
762:     PetscMalloc(10*sizeof(PetscReal)*cg->alloced, &cg->rwork);
763:     PetscMalloc(5*sizeof(PetscInt)*cg->alloced, &cg->iwork);
764:   }

766:   /***************************************************************************/
767:   /* Set up the required vectors.                                            */
768:   /***************************************************************************/

770:   t_soln = cg->rwork + 0*t_size;                        /* Solution          */
771:   t_diag = cg->rwork + 1*t_size;                        /* Diagonal of T     */
772:   t_offd = cg->rwork + 2*t_size;                        /* Off-diagonal of T */
773:   e_valu = cg->rwork + 3*t_size;                        /* Eigenvalues of T  */
774:   e_vect = cg->rwork + 4*t_size;                        /* Eigenvector of T  */
775:   e_rwrk = cg->rwork + 5*t_size;                        /* Eigen workspace   */
776: 
777:   e_iblk = cg->iwork + 0*t_size;                        /* Eigen blocks      */
778:   e_splt = cg->iwork + 1*t_size;                        /* Eigen splits      */
779:   e_iwrk = cg->iwork + 2*t_size;                        /* Eigen workspace   */

781:   /***************************************************************************/
782:   /* Compute the minimum eigenvalue of T.                                    */
783:   /***************************************************************************/

785:   vl = 0.0;
786:   vu = 0.0;
787:   il = 1;
788:   iu = 1;

790: #if defined(PETSC_MISSING_LAPACK_STEBZ)
791:   SETERRQ(PETSC_ERR_SUP,"STEBZ - Lapack routine is unavailable.");
792: #else
793:   LAPACKstebz_("I", "E", &t_size, &vl, &vu, &il, &iu, &cg->eigen_tol,
794:                cg->diag, cg->offd + 1, &e_valus, &e_splts, e_valu,
795:                e_iblk, e_splt, e_rwrk, e_iwrk, &info);
796: #endif

798:   if ((0 != info) || (1 != e_valus)) {
799:     /*************************************************************************/
800:     /* Calculation of the minimum eigenvalue failed.  Return the             */
801:     /* Steihaug-Toint direction.                                             */
802:     /*************************************************************************/

804:     PetscInfo(ksp, "KSPSolve_GLTR: failed to compute eigenvalue.\n");
805:     ksp->reason = reason;
806:     return(0);
807:   }

809:   cg->e_min = e_valu[0];

811:   /***************************************************************************/
812:   /* Compute the initial value of lambda to make (T + lamba I) positive      */
813:   /* definite.                                                               */
814:   /***************************************************************************/

816:   pert = cg->init_pert;
817:   if (e_valu[0] <= 0.0) {
818:     cg->lambda = pert - e_valu[0];
819:   }

821:   while(1) {
822:     for (i = 0; i < t_size; ++i) {
823:       t_diag[i] = cg->diag[i] + cg->lambda;
824:       t_offd[i] = cg->offd[i];
825:     }

827: #if defined(PETSC_MISSING_LAPACK_PTTRF)
828:   SETERRQ(PETSC_ERR_SUP,"PTTRF - Lapack routine is unavailable.");
829: #else
830:     LAPACKpttrf_(&t_size, t_diag, t_offd + 1, &info);
831: #endif
832:     if (0 == info) {
833:       break;
834:     }

836:     pert += pert;
837:     cg->lambda = cg->lambda * (1.0 + pert) + pert;
838:   }

840:   /***************************************************************************/
841:   /* Compute the initial step and its norm.                                  */
842:   /***************************************************************************/

844:   nrhs = 1;
845:   nldb = t_size;

847:   t_soln[0] = -cg->norm_r[0];
848:   for (i = 1; i < t_size; ++i) {
849:     t_soln[i] = 0.0;
850:   }

852: #if defined(PETSC_MISSING_LAPACK_PTTRS)
853:   SETERRQ(PETSC_ERR_SUP,"PTTRS - Lapack routine is unavailable.");
854: #else
855:   LAPACKpttrs_(&t_size, &nrhs, t_diag, t_offd + 1, t_soln, &nldb, &info);
856: #endif
857:   if (0 != info) {
858:     /*************************************************************************/
859:     /* Calculation of the initial step failed; return the Steihaug-Toint     */
860:     /* direction.                                                            */
861:     /*************************************************************************/

863:     PetscInfo(ksp, "KSPSolve_GLTR: failed to compute step.\n");
864:     ksp->reason = reason;
865:     return(0);
866:   }

868:   norm_t = 0;
869:   for (i = 0; i < t_size; ++i) {
870:     norm_t += t_soln[i] * t_soln[i];
871:   }
872:   norm_t = sqrt(norm_t);

874:   /***************************************************************************/
875:   /* Determine the case we are in.                                           */
876:   /***************************************************************************/

878:   if (norm_t <= cg->radius) {
879:     /*************************************************************************/
880:     /* The step is within the trust region; check if we are in the hard case */
881:     /* and need to move to the boundary by following a direction of negative */
882:     /* curvature.                                                            */
883:     /*************************************************************************/
884: 
885:     if ((e_valu[0] <= 0.0) && (norm_t < cg->radius)) {
886:       /***********************************************************************/
887:       /* This is the hard case; compute the eigenvector associated with the  */
888:       /* minimum eigenvalue and move along this direction to the boundary.   */
889:       /***********************************************************************/
890: #if defined(PETSC_MISSING_LAPACK_STEIN)
891:   SETERRQ(PETSC_ERR_SUP,"STEIN - Lapack routine is unavailable.");
892: #else
893:       LAPACKstein_(&t_size, cg->diag, cg->offd + 1, &e_valus, e_valu,
894:                    e_iblk, e_splt, e_vect, &nldb,
895:                    e_rwrk, e_iwrk, e_iwrk + t_size, &info);
896: #endif
897:       if (0 != info) {
898:         /*********************************************************************/
899:         /* Calculation of the minimum eigenvalue failed.  Return the         */
900:         /* Steihaug-Toint direction.                                         */
901:         /*********************************************************************/
902: 
903:         PetscInfo(ksp, "KSPSolve_GLTR: failed to compute eigenvector.\n");
904:         ksp->reason = reason;
905:         return(0);
906:       }
907: 
908:       coef1 = 0.0;
909:       coef2 = 0.0;
910:       coef3 = -cg->radius * cg->radius;
911:       for (i = 0; i < t_size; ++i) {
912:         coef1 += e_vect[i] * e_vect[i];
913:         coef2 += e_vect[i] * t_soln[i];
914:         coef3 += t_soln[i] * t_soln[i];
915:       }
916: 
917:       coef3 = sqrt(coef2 * coef2 - coef1 * coef3);
918:       root1 = (-coef2 + coef3) / coef1;
919:       root2 = (-coef2 - coef3) / coef1;

921:       /***********************************************************************/
922:       /* Compute objective value for (t_soln + root1 * e_vect)               */
923:       /***********************************************************************/

925:       for (i = 0; i < t_size; ++i) {
926:         e_rwrk[i] = t_soln[i] + root1 * e_vect[i];
927:       }
928: 
929:       obj1 = e_rwrk[0]*(0.5*(cg->diag[0]*e_rwrk[0]+
930:                              cg->offd[1]*e_rwrk[1])+cg->norm_r[0]);
931:       for (i = 1; i < t_size - 1; ++i) {
932:         obj1 += 0.5*e_rwrk[i]*(cg->offd[i]*e_rwrk[i-1]+
933:                                cg->diag[i]*e_rwrk[i]+
934:                                cg->offd[i+1]*e_rwrk[i+1]);
935:       }
936:       obj1 += 0.5*e_rwrk[i]*(cg->offd[i]*e_rwrk[i-1]+
937:                              cg->diag[i]*e_rwrk[i]);

939:       /***********************************************************************/
940:       /* Compute objective value for (t_soln + root2 * e_vect)               */
941:       /***********************************************************************/

943:       for (i = 0; i < t_size; ++i) {
944:         e_rwrk[i] = t_soln[i] + root2 * e_vect[i];
945:       }
946: 
947:       obj2 = e_rwrk[0]*(0.5*(cg->diag[0]*e_rwrk[0]+
948:                              cg->offd[1]*e_rwrk[1])+cg->norm_r[0]);
949:       for (i = 1; i < t_size - 1; ++i) {
950:         obj2 += 0.5*e_rwrk[i]*(cg->offd[i]*e_rwrk[i-1]+
951:                                cg->diag[i]*e_rwrk[i]+
952:                                cg->offd[i+1]*e_rwrk[i+1]);
953:       }
954:       obj2 += 0.5*e_rwrk[i]*(cg->offd[i]*e_rwrk[i-1]+
955:                              cg->diag[i]*e_rwrk[i]);
956: 
957:       /***********************************************************************/
958:       /* Choose the point with the best objective function value.            */
959:       /***********************************************************************/

961:       if (obj1 <= obj2) {
962:         for (i = 0; i < t_size; ++i) {
963:           t_soln[i] += root1 * e_vect[i];
964:         }
965:       }
966:       else {
967:         for (i = 0; i < t_size; ++i) {
968:           t_soln[i] += root2 * e_vect[i];
969:         }
970:       }
971:     }
972:     else {
973:       /***********************************************************************/
974:       /* The matrix is positive definite or there was no room to move; the   */
975:       /* solution is already contained in t_soln.                            */
976:       /***********************************************************************/
977:     }
978:   }
979:   else {
980:     /*************************************************************************/
981:     /* The step is outside the trust-region.  Compute the correct value for  */
982:     /* lambda by performing Newton's method.                                 */
983:     /*************************************************************************/

985:     for (i = 0; i < max_newton_its; ++i) {
986:       /***********************************************************************/
987:       /* Check for convergence.                                              */
988:       /***********************************************************************/

990:       if (fabs(norm_t - cg->radius) <= cg->newton_tol * cg->radius) {
991:         break;
992:       }

994:       /***********************************************************************/
995:       /* Compute the update.                                                 */
996:       /***********************************************************************/

998:       PetscMemcpy(e_rwrk, t_soln, sizeof(PetscReal)*t_size);
999: #if defined(PETSC_MISSING_LAPACK_PTTRS)
1000:   SETERRQ(PETSC_ERR_SUP,"PTTRS - Lapack routine is unavailable.");
1001: #else      
1002:       LAPACKpttrs_(&t_size, &nrhs, t_diag, t_offd + 1, e_rwrk, &nldb, &info);
1003: #endif
1004:       if (0 != info) {
1005:         /*********************************************************************/
1006:         /* Calculation of the step failed; return the Steihaug-Toint         */
1007:         /* direction.                                                        */
1008:         /*********************************************************************/

1010:         PetscInfo(ksp, "KSPSolve_GLTR: failed to compute step.\n");
1011:         ksp->reason = reason;
1012:         return(0);
1013:       }

1015:       /***********************************************************************/
1016:       /* Modify lambda.                                                      */
1017:       /***********************************************************************/

1019:       norm_w = 0;
1020:       for (j = 0; j < t_size; ++j) {
1021:         norm_w += t_soln[j] * e_rwrk[j];
1022:       }
1023: 
1024:       cg->lambda += (norm_t - cg->radius)/cg->radius * (norm_t * norm_t) / norm_w;

1026:       /***********************************************************************/
1027:       /* Factor T + lambda I                                                 */
1028:       /***********************************************************************/
1029: 
1030:       for (j = 0; j < t_size; ++j) {
1031:         t_diag[j] = cg->diag[j] + cg->lambda;
1032:         t_offd[j] = cg->offd[j];
1033:       }

1035: #if defined(PETSC_MISSING_LAPACK_PTTRF)
1036:   SETERRQ(PETSC_ERR_SUP,"PTTRF - Lapack routine is unavailable.");
1037: #else
1038:       LAPACKpttrf_(&t_size, t_diag, t_offd + 1, &info);
1039: #endif
1040:       if (0 != info) {
1041:         /*********************************************************************/
1042:         /* Calculation of factorization failed; return the Steihaug-Toint    */
1043:         /* direction.                                                        */
1044:         /*********************************************************************/

1046:         PetscInfo(ksp, "KSPSolve_GLTR: factorization failed.\n");
1047:         ksp->reason = reason;
1048:         return(0);
1049:       }

1051:       /***********************************************************************/
1052:       /* Compute the new step and its norm.                                  */
1053:       /***********************************************************************/

1055:       t_soln[0] = -cg->norm_r[0];
1056:       for (j = 1; j < t_size; ++j) {
1057:         t_soln[j] = 0.0;
1058:       }

1060: #if defined(PETSC_MISSING_LAPACK_PTTRS)
1061:   SETERRQ(PETSC_ERR_SUP,"PTTRS - Lapack routine is unavailable.");
1062: #else
1063:       LAPACKpttrs_(&t_size, &nrhs, t_diag, t_offd + 1, t_soln, &nldb, &info);
1064: #endif
1065:       if (0 != info) {
1066:         /*********************************************************************/
1067:         /* Calculation of the step failed; return the Steihaug-Toint         */
1068:         /* direction.                                                        */
1069:         /*********************************************************************/
1070: 
1071:         PetscInfo(ksp, "KSPSolve_GLTR: failed to compute step.\n");
1072:         ksp->reason = reason;
1073:         return(0);
1074:       }

1076:       norm_t = 0;
1077:       for (j = 0; j < t_size; ++j) {
1078:         norm_t += t_soln[j] * t_soln[j];
1079:       }
1080:       norm_t = sqrt(norm_t);
1081:     }

1083:     /*************************************************************************/
1084:     /* Check for convergence.                                                */
1085:     /*************************************************************************/

1087:     if (fabs(norm_t - cg->radius) > cg->newton_tol * cg->radius) {
1088:       /***********************************************************************/
1089:       /* Newton method failed to converge in iteration limit.                */
1090:       /***********************************************************************/

1092:       PetscInfo(ksp, "KSPSolve_GLTR: failed to converge.\n");
1093:       ksp->reason = reason;
1094:       return(0);
1095:     }
1096:   }

1098:   /***************************************************************************/
1099:   /* Recover the norm of the direction and objective function value.         */
1100:   /***************************************************************************/

1102:   cg->norm_d = norm_t;

1104:   cg->o_fcn = t_soln[0]*(0.5*(cg->diag[0]*t_soln[0]+
1105:                               cg->offd[1]*t_soln[1])+cg->norm_r[0]);
1106:   for (i = 1; i < t_size - 1; ++i) {
1107:     cg->o_fcn += 0.5*t_soln[i]*(cg->offd[i]*t_soln[i-1]+
1108:                                  cg->diag[i]*t_soln[i]+
1109:                                 cg->offd[i+1]*t_soln[i+1]);
1110:   }
1111:   cg->o_fcn += 0.5*t_soln[i]*(cg->offd[i]*t_soln[i-1]+
1112:                               cg->diag[i]*t_soln[i]);

1114:   /***************************************************************************/
1115:   /* Recover the direction.                                                  */
1116:   /***************************************************************************/

1118:   sigma = -1;

1120:   /***************************************************************************/
1121:   /* Start conjugate gradient method from the beginning                      */
1122:   /***************************************************************************/

1124:   VecCopy(ksp->vec_rhs, r);         /* r = -grad         */
1125:   KSP_PCApply(ksp, r, z);                 /* z = inv(M) r      */

1127:   /***************************************************************************/
1128:   /* Accumulate Q * s                                                        */
1129:   /***************************************************************************/

1131:   VecCopy(z, d);
1132:   VecScale(d, sigma * t_soln[0] / cg->norm_r[0]);
1133: 
1134:   /***************************************************************************/
1135:   /* Compute the first direction.                                            */
1136:   /***************************************************************************/

1138:   VecCopy(z, p);                         /* p = z             */
1139:   KSP_MatMult(ksp, Qmat, p, z);         /* z = Q * p         */

1141:   for (i = 0; i < ksp->its - 1; ++i) {
1142:     /*************************************************************************/
1143:     /* Update the residual and direction.                                    */
1144:     /*************************************************************************/

1146:     alpha = cg->alpha[i];
1147:     if (alpha >= 0.0) {
1148:       sigma = -sigma;
1149:     }

1151:     VecAXPY(r, -alpha, z);                        /* r = r - alpha Q p */
1152:     KSP_PCApply(ksp, r, z);

1154:     /*************************************************************************/
1155:     /* Accumulate Q * s                                                      */
1156:     /*************************************************************************/

1158:     VecAXPY(d, sigma * t_soln[i+1] / cg->norm_r[i+1], z);

1160:     /*************************************************************************/
1161:     /* Update p.                                                             */
1162:     /*************************************************************************/

1164:     beta = cg->beta[i];
1165:     VecAYPX(p, beta, z);           /* p = z + beta p    */
1166:     KSP_MatMult(ksp, Qmat, p, z);         /* z = Q * p         */
1167:   }

1169:   if (i < ksp->its) {
1170:     /*************************************************************************/
1171:     /* Update the residual and direction.                                    */
1172:     /*************************************************************************/

1174:     alpha = cg->alpha[i];
1175:     if (alpha >= 0.0) {
1176:       sigma = -sigma;
1177:     }

1179:     VecAXPY(r, -alpha, z);                        /* r = r - alpha Q p */
1180:     KSP_PCApply(ksp, r, z);

1182:     /*************************************************************************/
1183:     /* Accumulate Q * s                                                      */
1184:     /*************************************************************************/

1186:     VecAXPY(d, sigma * t_soln[i+1] / cg->norm_r[i+1], z);
1187:   }

1189:   /***************************************************************************/
1190:   /* Set the termination reason.                                             */
1191:   /***************************************************************************/

1193:   ksp->reason = reason;
1194:   return(0);
1195: #endif
1196: }

1200: PetscErrorCode KSPSetUp_GLTR(KSP ksp)
1201: {
1202:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;
1203:   PetscInt size;

1207:   /* This implementation of CG only handles left preconditioning
1208:    * so generate an error otherwise.
1209:    */
1210:   if (ksp->pc_side == PC_RIGHT) {
1211:     SETERRQ(PETSC_ERR_SUP, "No right preconditioning for KSPGLTR");
1212:   }
1213:   else if (ksp->pc_side == PC_SYMMETRIC) {
1214:     SETERRQ(PETSC_ERR_SUP, "No symmetric preconditioning for KSPGLTR");
1215:   }

1217:   /* get work vectors needed by CG */
1218:   KSPDefaultGetWork(ksp, 3);

1220:   /* allocate workspace for Lanczos matrix */
1221:   cg->max_its = cg->max_cg_its + cg->max_lanczos_its + 1;
1222:   size = 5*cg->max_its*sizeof(PetscReal);

1224:   PetscMalloc(size, &cg->diag);
1225:   PetscMemzero(cg->diag, size);
1226:   PetscLogObjectMemory(ksp, size);
1227:   cg->offd   = cg->diag  + cg->max_its;
1228:   cg->alpha  = cg->offd  + cg->max_its;
1229:   cg->beta   = cg->alpha + cg->max_its;
1230:   cg->norm_r = cg->beta  + cg->max_its;
1231:   return(0);
1232: }

1236: PetscErrorCode KSPDestroy_GLTR(KSP ksp)
1237: {
1238:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1242:   PetscFree(cg->diag);
1243:   if (cg->alloced) {
1244:     PetscFree(cg->rwork);
1245:     PetscFree(cg->iwork);
1246:   }

1248:   KSPDefaultDestroy(ksp);
1249:   /* clear composed functions */
1250:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPGLTRSetRadius_C","",PETSC_NULL);
1251:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPGLTRGetNormD_C","",PETSC_NULL);
1252:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPGLTRGetObjFcn_C","",PETSC_NULL);
1253:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPGLTRGetMinEig_C","",PETSC_NULL);
1254:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPGLTRGetLambda_C","",PETSC_NULL);
1255:   return(0);
1256: }

1261: PetscErrorCode  KSPGLTRSetRadius_GLTR(KSP ksp,PetscReal radius)
1262: {
1263:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1266:   cg->radius = radius;
1267:   return(0);
1268: }

1272: PetscErrorCode  KSPGLTRGetNormD_GLTR(KSP ksp,PetscReal *norm_d)
1273: {
1274:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1277:   *norm_d = cg->norm_d;
1278:   return(0);
1279: }

1283: PetscErrorCode  KSPGLTRGetObjFcn_GLTR(KSP ksp,PetscReal *o_fcn)
1284: {
1285:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1288:   *o_fcn = cg->o_fcn;
1289:   return(0);
1290: }

1294: PetscErrorCode  KSPGLTRGetMinEig_GLTR(KSP ksp,PetscReal *e_min)
1295: {
1296:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1299:   *e_min = cg->e_min;
1300:   return(0);
1301: }

1305: PetscErrorCode  KSPGLTRGetLambda_GLTR(KSP ksp,PetscReal *lambda)
1306: {
1307:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1310:   *lambda = cg->lambda;
1311:   return(0);
1312: }

1317: PetscErrorCode KSPSetFromOptions_GLTR(KSP ksp)
1318: {
1320:   KSP_GLTR *cg = (KSP_GLTR *)ksp->data;

1323:   PetscOptionsHead("KSP GLTR options");

1325:   PetscOptionsReal("-ksp_gltr_radius", "Trust Region Radius", "KSPGLTRSetRadius", cg->radius, &cg->radius, PETSC_NULL);

1327:   PetscOptionsReal("-ksp_gltr_init_pert", "Initial perturbation", "", cg->init_pert, &cg->init_pert, PETSC_NULL);
1328:   PetscOptionsReal("-ksp_gltr_eigen_tol", "Eigenvalue tolerance", "", cg->eigen_tol, &cg->eigen_tol, PETSC_NULL);
1329:   PetscOptionsReal("-ksp_gltr_newton_tol", "Newton tolerance", "", cg->newton_tol, &cg->newton_tol, PETSC_NULL);

1331:   PetscOptionsInt("-ksp_gltr_max_cg_its", "Maximum Conjugate Gradient Iters", "", cg->max_cg_its, &cg->max_cg_its, PETSC_NULL);
1332:   PetscOptionsInt("-ksp_gltr_max_lanczos_its", "Maximum Lanczos Iters", "", cg->max_lanczos_its, &cg->max_lanczos_its, PETSC_NULL);
1333:   PetscOptionsInt("-ksp_gltr_max_newton_its", "Maximum Newton Iters", "", cg->max_newton_its, &cg->max_newton_its, PETSC_NULL);
1334:   PetscOptionsTail();
1335:   return(0);
1336: }

1338: /*MC
1339:      KSPGLTR -   Code to run conjugate gradient method subject to a constraint
1340:          on the solution norm. This is used in Trust Region methods for
1341:          nonlinear equations, SNESTR

1343:    Options Database Keys:
1344: .      -ksp_gltr_radius <r> - Trust Region Radius

1346:    Notes: This is rarely used directly

1348:    Level: developer

1350: .seealso:  KSPCreate(), KSPSetType(), KSPType (for list of available types), KSP, KSPGLTRSetRadius(), KSPGLTRGetNormD(), KSPGLTRGetObjFcn(), KSPGLTRGetMinEig(), KSPGLTRGetLambda()
1351: M*/

1356: PetscErrorCode  KSPCreate_GLTR(KSP ksp)
1357: {
1359:   KSP_GLTR *cg;


1363:   PetscNew(KSP_GLTR, &cg);
1364:   PetscLogObjectMemory(ksp, sizeof(KSP_GLTR));

1366:   cg->radius = PETSC_MAX;

1368:   cg->init_pert = 1.0e-8;
1369:   cg->eigen_tol = 1.0e-10;
1370:   cg->newton_tol = 1.0e-6;

1372:   cg->alloced = 0;
1373:   cg->init_alloc = 1024;

1375:   cg->max_cg_its = 10000;
1376:   cg->max_lanczos_its = 20;
1377:   cg->max_newton_its  = 10;

1379:   cg->max_its = cg->max_cg_its + cg->max_lanczos_its + 1;

1381:   ksp->data = (void *) cg;
1382:   ksp->pc_side = PC_LEFT;

1384:   /* Sets the functions that are associated with this data structure
1385:    * (in C++ this is the same as defining virtual functions)
1386:    */
1387:   ksp->ops->setup          = KSPSetUp_GLTR;
1388:   ksp->ops->solve          = KSPSolve_GLTR;
1389:   ksp->ops->destroy        = KSPDestroy_GLTR;
1390:   ksp->ops->setfromoptions = KSPSetFromOptions_GLTR;
1391:   ksp->ops->buildsolution  = KSPDefaultBuildSolution;
1392:   ksp->ops->buildresidual  = KSPDefaultBuildResidual;
1393:   ksp->ops->view           = 0;

1395:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,
1396:                                     "KSPGLTRSetRadius_C",
1397:                                     "KSPGLTRSetRadius_GLTR",
1398:                                      KSPGLTRSetRadius_GLTR);
1399:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,
1400:                                     "KSPGLTRGetNormD_C",
1401:                                     "KSPGLTRGetNormD_GLTR",
1402:                                      KSPGLTRGetNormD_GLTR);
1403:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,
1404:                                     "KSPGLTRGetObjFcn_C",
1405:                                     "KSPGLTRGetObjFcn_GLTR",
1406:                                      KSPGLTRGetObjFcn_GLTR);
1407:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,
1408:                                     "KSPGLTRGetMinEig_C",
1409:                                     "KSPGLTRGetMinEig_GLTR",
1410:                                      KSPGLTRGetMinEig_GLTR);
1411:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,
1412:                                     "KSPGLTRGetLambda_C",
1413:                                     "KSPGLTRGetLambda_GLTR",
1414:                                      KSPGLTRGetLambda_GLTR);
1415:   return(0);
1416: }