Actual source code: qcg.c

  1: /*$Id: qcg.c,v 1.86 2001/08/07 03:03:55 balay Exp curfman $*/
  2: /*
  3:    Code to run conjugate gradient method subject to a constraint
  4:    on the solution norm. This is used in Trust Region methods.
  5: */

 7:  #include src/sles/ksp/kspimpl.h
 8:  #include src/sles/ksp/impls/qcg/qcg.h

 10: static int QuadraticRoots_Private(Vec,Vec,PetscReal*,PetscReal*,PetscReal*);

 12: /*@
 13:     KSPQCGSetTrustRegionRadius - Sets the radius of the trust region.

 15:     Collective on KSP

 17:     Input Parameters:
 18: +   ksp   - the iterative context
 19: -   delta - the trust region radius (Infinity is the default)

 21:     Options Database Key:
 22: .   -ksp_qcg_trustregionradius <delta>

 24:     Level: advanced

 26: .keywords: KSP, QCG, set, trust region radius
 27: @*/
 28: int KSPQCGSetTrustRegionRadius(KSP ksp,PetscReal delta)
 29: {
 30:   int ierr,(*f)(KSP,PetscReal);

 34:   if (delta < 0.0) SETERRQ(1,"Tolerance must be non-negative");
 35:   PetscObjectQueryFunction((PetscObject)ksp,"KSPQCGSetTrustRegionRadius_C",(void (**)(void))&f);
 36:   if (f) {
 37:     (*f)(ksp,delta);
 38:   }

 40:   return(0);
 41: }

 43: /*@
 44:     KSPQCGGetTrialStepNorm - Gets the norm of a trial step vector.  The WCG step may be
 45:     constrained, so this is not necessarily the length of the ultimate step taken in QCG.

 47:     Collective on KSP

 49:     Input Parameter:
 50: .   ksp - the iterative context

 52:     Output Parameter:
 53: .   tsnorm - the norm

 55:     Level: advanced
 56: @*/
 57: int KSPQCGGetTrialStepNorm(KSP ksp,PetscReal *tsnorm)
 58: {
 59:   int ierr,(*f)(KSP,PetscReal*);

 63:   PetscObjectQueryFunction((PetscObject)ksp,"KSPQCGGetTrialStepNorm_C",(void (**)(void))&f);
 64:   if (f) {
 65:     (*f)(ksp,tsnorm);
 66:   }
 67:   return(0);
 68: }

 70: /*@
 71:     KSPQCGGetQuadratic - Gets the value of the quadratic function, evaluated at the new iterate:

 73:        q(s) = g^T * s + 0.5 * s^T * H * s

 75:     which satisfies the Euclidian Norm trust region constraint

 77:        || D * s || <= delta,

 79:     where

 81:      delta is the trust region radius, 
 82:      g is the gradient vector, and
 83:      H is Hessian matrix,
 84:      D is a scaling matrix.

 86:     Collective on KSP

 88:     Input Parameter:
 89: .   ksp - the iterative context

 91:     Output Parameter:
 92: .   quadratic - the quadratic function evaluated at the new iterate

 94:     Level: advanced
 95: @*/
 96: int KSPQCGGetQuadratic(KSP ksp,PetscReal *quadratic)
 97: {
 98:   int ierr,(*f)(KSP,PetscReal*);

102:   PetscObjectQueryFunction((PetscObject)ksp,"KSPQCGGetQuadratic_C",(void (**)(void))&f);
103:   if (f) {
104:     (*f)(ksp,quadratic);
105:   }
106:   return(0);
107: }

109: /* 
110:   KSPSolve_QCG - Use preconditioned conjugate gradient to compute 
111:   an approximate minimizer of the quadratic function 

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

115:    subject to the Euclidean norm trust region constraint

117:             || D * s || <= delta,

119:    where 

121:      delta is the trust region radius, 
122:      g is the gradient vector, and
123:      H is Hessian matrix,
124:      D is a scaling matrix.

126:    KSPConvergedReason may be 
127: $  KSP_CONVERGED_QCG_NEG_CURVE if convergence is reached along a negative curvature direction,
128: $  KSP_CONVERGED_QCG_CONSTRAINED if convergence is reached along a constrained step,
129: $  other KSP converged/diverged reasons

131:   This method is intended for use in conjunction with the TAO trust region method
132:   for unconstrained minimization (see www.mcs.anl.gov/tao).

134:   Notes:
135:   Currently we allow symmetric preconditioning with the following scaling matrices:
136:       PCNONE:   D = Identity matrix
137:       PCJACOBI: D = diag [d_1, d_2, ...., d_n], where d_i = sqrt(H[i,i])
138:       PCICC:    D = L^T, implemented with forward and backward solves.
139:                 Here L is an incomplete Cholesky factor of H.

141:  We should perhaps rewrite using PCApplyBAorAB().
142:  */
143: int KSPSolve_QCG(KSP ksp,int *its)
144: {
145: /* 
146:    Correpondence with documentation above:  
147:       B = g = gradient,
148:       X = s = step
149:    Note:  This is not coded correctly for complex arithmetic!
150:  */

152:   KSP_QCG      *pcgP = (KSP_QCG*)ksp->data;
153:   MatStructure pflag;
154:   Mat          Amat,Pmat;
155:   Vec          W,WA,WA2,R,P,ASP,BS,X,B;
156:   PetscScalar  zero = 0.0,negone = -1.0,scal,nstep,btx,xtax,beta,rntrn,step;
157:   PetscReal    ptasp,q1,q2,wtasp,bstp,rtr,xnorm,step1,step2,rnrm,p5 = 0.5;
158:   PetscReal    dzero = 0.0,bsnrm;
159:   int          i,maxit,ierr;
160:   PC           pc = ksp->B;
161:   PCSide       side;
162: #if defined(PETSC_USE_COMPLEX)
163:   PetscScalar  cstep1,cstep2,cbstp,crtr,cwtasp,cptasp;
164: #endif
165:   PetscTruth   diagonalscale;

168:   ierr    = PCDiagonalScale(ksp->B,&diagonalscale);
169:   if (diagonalscale) SETERRQ1(1,"Krylov method %s does not support diagonal scaling",ksp->type_name);
170:   if (ksp->transpose_solve) {
171:     SETERRQ(1,"Currently does not support transpose solve");
172:   }

174:   ksp->its = 0;
175:   maxit    = ksp->max_it;
176:   WA       = ksp->work[0];
177:   R        = ksp->work[1];
178:   P        = ksp->work[2];
179:   ASP      = ksp->work[3];
180:   BS       = ksp->work[4];
181:   W        = ksp->work[5];
182:   WA2      = ksp->work[6];
183:   X        = ksp->vec_sol;
184:   B        = ksp->vec_rhs;

186:   *its = 0;
187:   if (pcgP->delta <= dzero) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Input error: delta <= 0");
188:   KSPGetPreconditionerSide(ksp,&side);
189:   if (side != PC_SYMMETRIC) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Requires symmetric preconditioner!");

191:   /* Initialize variables */
192:   VecSet(&zero,W);        /* W = 0 */
193:   VecSet(&zero,X);        /* X = 0 */
194:   PCGetOperators(pc,&Amat,&Pmat,&pflag);

196:   /* Compute:  BS = D^{-1} B */
197:   PCApplySymmetricLeft(pc,B,BS);

199:   VecNorm(BS,NORM_2,&bsnrm);
200:   PetscObjectTakeAccess(ksp);
201:   ksp->its    = 0;
202:   ksp->rnorm  = bsnrm;
203:   PetscObjectGrantAccess(ksp);
204:   KSPLogResidualHistory(ksp,bsnrm);
205:   KSPMonitor(ksp,0,bsnrm);
206:   (*ksp->converged)(ksp,0,bsnrm,&ksp->reason,ksp->cnvP);
207:   if (ksp->reason) {*its =  0; return(0);}

209:   /* Compute the initial scaled direction and scaled residual */
210:   VecCopy(BS,R);
211:   VecScale(&negone,R);
212:   VecCopy(R,P);
213: #if defined(PETSC_USE_COMPLEX)
214:   VecDot(R,R,&crtr); rtr = PetscRealPart(crtr);
215: #else
216:   VecDot(R,R,&rtr);
217: #endif

219:   for (i=0; i<=maxit; i++) {
220:     PetscObjectTakeAccess(ksp);
221:     ksp->its++;
222:     PetscObjectGrantAccess(ksp);

224:     /* Compute:  asp = D^{-T}*A*D^{-1}*p  */
225:     PCApplySymmetricRight(pc,P,WA);
226:     MatMult(Amat,WA,WA2);
227:     PCApplySymmetricLeft(pc,WA2,ASP);

229:     /* Check for negative curvature */
230: #if defined(PETSC_USE_COMPLEX)
231:     ierr  = VecDot(P,ASP,&cptasp);
232:     ptasp = PetscRealPart(cptasp);
233: #else
234:     VecDot(P,ASP,&ptasp);        /* ptasp = p^T asp */
235: #endif
236:     if (ptasp <= dzero) {

238:       /* Scaled negative curvature direction:  Compute a step so that
239:          ||w + step*p|| = delta and QS(w + step*p) is least */

241:        if (!i) {
242:          VecCopy(P,X);
243:          VecNorm(X,NORM_2,&xnorm);
244:          scal = pcgP->delta / xnorm;
245:          VecScale(&scal,X);
246:        } else {
247:          /* Compute roots of quadratic */
248:          QuadraticRoots_Private(W,P,&pcgP->delta,&step1,&step2);
249: #if defined(PETSC_USE_COMPLEX)
250:          VecDot(W,ASP,&cwtasp); wtasp = PetscRealPart(cwtasp);
251:          VecDot(BS,P,&cbstp);   bstp  = PetscRealPart(cbstp);
252: #else
253:          VecDot(W,ASP,&wtasp);
254:          VecDot(BS,P,&bstp);
255: #endif
256:          VecCopy(W,X);
257:          q1 = step1*(bstp + wtasp + p5*step1*ptasp);
258:          q2 = step2*(bstp + wtasp + p5*step2*ptasp);
259: #if defined(PETSC_USE_COMPLEX)
260:          if (q1 <= q2) {
261:            cstep1 = step1; VecAXPY(&cstep1,P,X);
262:          } else {
263:            cstep2 = step2; VecAXPY(&cstep2,P,X);
264:          }
265: #else
266:          if (q1 <= q2) {VecAXPY(&step1,P,X);}
267:          else          {VecAXPY(&step2,P,X);}
268: #endif
269:        }
270:        pcgP->ltsnrm = pcgP->delta;                       /* convergence in direction of */
271:        ksp->reason  = KSP_CONVERGED_QCG_NEG_CURVE;  /* negative curvature */
272:        if (!i) {
273:          PetscLogInfo(ksp,"KSPSolve_QCG: negative curvature: delta=%gn",pcgP->delta);
274:        } else {
275:          PetscLogInfo(ksp,"KSPSolve_QCG: negative curvature: step1=%g, step2=%g, delta=%gn",step1,step2,pcgP->delta);
276:        }
277: 
278:     } else {
279: 
280:        /* Compute step along p */

282:        step = rtr/ptasp;
283:        VecCopy(W,X);           /*  x = w  */
284:        VecAXPY(&step,P,X);   /*  x <- step*p + x  */
285:        VecNorm(X,NORM_2,&pcgP->ltsnrm);

287:        if (pcgP->ltsnrm > pcgP->delta) {

289:          /* Since the trial iterate is outside the trust region, 
290:              evaluate a constrained step along p so that 
291:                       ||w + step*p|| = delta 
292:             The positive step is always better in this case. */

294:          if (!i) {
295:            scal = pcgP->delta / pcgP->ltsnrm;
296:            VecScale(&scal,X);
297:          } else {
298:            /* Compute roots of quadratic */
299:            QuadraticRoots_Private(W,P,&pcgP->delta,&step1,&step2);
300:            VecCopy(W,X);
301: #if defined(PETSC_USE_COMPLEX)
302:            cstep1 = step1; VecAXPY(&cstep1,P,X);
303: #else
304:            VecAXPY(&step1,P,X);  /*  x <- step1*p + x  */
305: #endif
306:          }
307:          pcgP->ltsnrm = pcgP->delta;
308:          ksp->reason  = KSP_CONVERGED_QCG_CONSTRAINED;        /* convergence along constrained step */
309:          if (!i) {
310:            PetscLogInfo(ksp,"KSPSolve_QCG: constrained step: delta=%gn",pcgP->delta);
311:          } else {
312:            PetscLogInfo(ksp,"KSPSolve_QCG: constrained step: step1=%g, step2=%g, delta=%gn",step1,step2,pcgP->delta);
313:          }

315:        } else {

317:          /* Evaluate the current step */

319:          VecCopy(X,W);        /* update interior iterate */
320:          nstep = -step;
321:          VecAXPY(&nstep,ASP,R); /* r <- -step*asp + r */
322:          VecNorm(R,NORM_2,&rnrm);

324:          PetscObjectTakeAccess(ksp);
325:          ksp->rnorm                                    = rnrm;
326:          PetscObjectGrantAccess(ksp);
327:          KSPLogResidualHistory(ksp,rnrm);
328:          KSPMonitor(ksp,i+1,rnrm);
329:          (*ksp->converged)(ksp,i+1,rnrm,&ksp->reason,ksp->cnvP);
330:          if (ksp->reason) {                 /* convergence for */
331: #if defined(PETSC_USE_COMPLEX)               
332:            PetscLogInfo(ksp,"KSPSolve_QCG: truncated step: step=%g, rnrm=%g, delta=%gn",PetscRealPart(step),rnrm,pcgP->delta);
333: #else
334:            PetscLogInfo(ksp,"KSPSolve_QCG: truncated step: step=%g, rnrm=%g, delta=%gn",step,rnrm,pcgP->delta);
335: #endif
336:          }
337:       }
338:     }
339:     if (ksp->reason) break;        /* Convergence has been attained */
340:     else {                /* Compute a new AS-orthogonal direction */
341:       VecDot(R,R,&rntrn);
342:       beta = rntrn/rtr;
343:       VecAYPX(&beta,R,P);        /*  p <- r + beta*p  */
344: #if defined(PETSC_USE_COMPLEX)
345:       rtr = PetscRealPart(rntrn);
346: #else
347:       rtr = rntrn;
348: #endif
349:     }
350:   }
351:   if (!ksp->reason) {
352:     ksp->reason = KSP_DIVERGED_ITS;
353:     i--;
354:   }

356:   /* Unscale x */
357:   VecCopy(X,WA2);
358:   PCApplySymmetricRight(pc,WA2,X);

360:   MatMult(Amat,X,WA);
361:   VecDot(B,X,&btx);
362:   VecDot(X,WA,&xtax);
363: #if defined(PETSC_USE_COMPLEX)
364:   pcgP->quadratic = PetscRealPart(btx) + p5* PetscRealPart(xtax);
365: #else
366:   pcgP->quadratic = btx + p5*xtax;              /* Compute q(x) */
367: #endif
368:   *its = i+1;
369:   return(0);
370: }

372: int KSPSetUp_QCG(KSP ksp)
373: {

377:   /* Check user parameters and functions */
378:   if (ksp->pc_side == PC_RIGHT) {
379:     SETERRQ(2,"no right preconditioning for QCG");
380:   } else if (ksp->pc_side == PC_LEFT) {
381:     SETERRQ(2,"no left preconditioning for QCG");
382:   }

384:   /* Get work vectors from user code */
385:   KSPDefaultGetWork(ksp,7);
386:   return(0);
387: }

389: int KSPDestroy_QCG(KSP ksp)
390: {
391:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;
392:   int     ierr;

395:   KSPDefaultFreeWork(ksp);
396: 
397:   /* Free the context variable */
398:   PetscFree(cgP);
399:   return(0);
400: }

402: EXTERN_C_BEGIN
403: int KSPQCGSetTrustRegionRadius_QCG(KSP ksp,PetscReal delta)
404: {
405:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;

408:   cgP->delta = delta;
409:   return(0);
410: }
411: EXTERN_C_END

413: EXTERN_C_BEGIN
414: int KSPQCGGetTrialStepNorm_QCG(KSP ksp,PetscReal *ltsnrm)
415: {
416:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;

419:   *ltsnrm = cgP->ltsnrm;
420:   return(0);
421: }
422: EXTERN_C_END

424: EXTERN_C_BEGIN
425: int KSPQCGGetQuadratic_QCG(KSP ksp,PetscReal *quadratic)
426: {
427:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;

430:   *quadratic = cgP->quadratic;
431:   return(0);
432: }
433: EXTERN_C_END

435: int KSPSetFromOptions_QCG(KSP ksp)
436: {
437:   int        ierr;
438:   PetscReal  delta;
439:   KSP_QCG    *cgP = (KSP_QCG*)ksp->data;
440:   PetscTruth flg;

443:   PetscOptionsHead("KSP QCG Options");
444:   PetscOptionsReal("-ksp_qcg_trustregionradius","Trust Region Radius","KSPQCGSetTrustRegionRadius",cgP->delta,&delta,&flg);
445:   if (flg) { KSPQCGSetTrustRegionRadius(ksp,delta); }
446:   PetscOptionsTail();
447:   return(0);
448: }

450: EXTERN_C_BEGIN
451: int KSPCreate_QCG(KSP ksp)
452: {
453:   int     ierr;
454:   KSP_QCG *cgP;

457:   PetscMalloc(sizeof(KSP_QCG),&cgP);
458:   PetscMemzero(cgP,sizeof(KSP_QCG));
459:   PetscLogObjectMemory(ksp,sizeof(KSP_QCG));
460:   ksp->data                      = (void*)cgP;
461:   ksp->pc_side                   = PC_SYMMETRIC;
462:   ksp->ops->setup                = KSPSetUp_QCG;
463:   ksp->ops->setfromoptions       = KSPSetFromOptions_QCG;
464:   ksp->ops->solve                = KSPSolve_QCG;
465:   ksp->ops->destroy              = KSPDestroy_QCG;
466:   ksp->ops->buildsolution        = KSPDefaultBuildSolution;
467:   ksp->ops->buildresidual        = KSPDefaultBuildResidual;
468:   ksp->ops->setfromoptions       = 0;
469:   ksp->ops->view                 = 0;

471:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPQCGGetQuadratic_C",
472:                                     "KSPQCGGetQuadratic_QCG",
473:                                      KSPQCGGetQuadratic_QCG);
474:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPQCGGetTrialStepNorm_C",
475:                                     "KSPQCGGetTrialStepNorm_QCG",
476:                                      KSPQCGGetTrialStepNorm_QCG);
477:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPQCGSetTrustRegionRadius_C",
478:                                     "KSPQCGSetTrustRegionRadius_QCG",
479:                                      KSPQCGSetTrustRegionRadius_QCG);
480:   cgP->delta = PETSC_MAX; /* default trust region radius is infinite */
481:   return(0);
482: }
483: EXTERN_C_END

485: /* ---------------------------------------------------------- */
486: /* 
487:   QuadraticRoots_Private - Computes the roots of the quadratic,
488:          ||s + step*p|| - delta = 0 
489:    such that step1 >= 0 >= step2.
490:    where
491:       delta:
492:         On entry delta must contain scalar delta.
493:         On exit delta is unchanged.
494:       step1:
495:         On entry step1 need not be specified.
496:         On exit step1 contains the non-negative root.
497:       step2:
498:         On entry step2 need not be specified.
499:         On exit step2 contains the non-positive root.
500:    C code is translated from the Fortran version of the MINPACK-2 Project,
501:    Argonne National Laboratory, Brett M. Averick and Richard G. Carter.
502: */
503: static int QuadraticRoots_Private(Vec s,Vec p,PetscReal *delta,PetscReal *step1,PetscReal *step2)
504: {
505:   PetscReal zero = 0.0,dsq,ptp,pts,rad,sts;
506:   int       ierr;
507: #if defined(PETSC_USE_COMPLEX)
508:   PetscScalar    cptp,cpts,csts;
509: #endif

512: #if defined(PETSC_USE_COMPLEX)
513:   VecDot(p,s,&cpts); pts = PetscRealPart(cpts);
514:   VecDot(p,p,&cptp); ptp = PetscRealPart(cptp);
515:   VecDot(s,s,&csts); sts = PetscRealPart(csts);
516: #else
517:   VecDot(p,s,&pts);
518:   VecDot(p,p,&ptp);
519:   VecDot(s,s,&sts);
520: #endif
521:   dsq  = (*delta)*(*delta);
522:   rad  = sqrt((pts*pts) - ptp*(sts - dsq));
523:   if (pts > zero) {
524:     *step2 = -(pts + rad)/ptp;
525:     *step1 = (sts - dsq)/(ptp * *step2);
526:   } else {
527:     *step1 = -(pts - rad)/ptp;
528:     *step2 = (sts - dsq)/(ptp * *step1);
529:   }
530:   return(0);
531: }