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: #undef __FUNCT__  
 14: /*@
 15:     KSPQCGSetTrustRegionRadius - Sets the radius of the trust region.

 17:     Collective on KSP

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

 23:     Options Database Key:
 24: .   -ksp_qcg_trustregionradius <delta>

 26:     Level: advanced

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

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

 42:   return(0);
 43: }

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

 51:     Collective on KSP

 53:     Input Parameter:
 54: .   ksp - the iterative context

 56:     Output Parameter:
 57: .   tsnorm - the norm

 59:     Level: advanced
 60: @*/
 61: int KSPQCGGetTrialStepNorm(KSP ksp,PetscReal *tsnorm)
 62: {
 63:   int ierr,(*f)(KSP,PetscReal*);

 67:   PetscObjectQueryFunction((PetscObject)ksp,"KSPQCGGetTrialStepNorm_C",(void (**)(void))&f);
 68:   if (f) {
 69:     (*f)(ksp,tsnorm);
 70:   }
 71:   return(0);
 72: }

 74: #undef __FUNCT__
 76: /*@
 77:     KSPQCGGetQuadratic - Gets the value of the quadratic function, evaluated at the new iterate:

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

 81:     which satisfies the Euclidian Norm trust region constraint

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

 85:     where

 87:      delta is the trust region radius, 
 88:      g is the gradient vector, and
 89:      H is Hessian matrix,
 90:      D is a scaling matrix.

 92:     Collective on KSP

 94:     Input Parameter:
 95: .   ksp - the iterative context

 97:     Output Parameter:
 98: .   quadratic - the quadratic function evaluated at the new iterate

100:     Level: advanced
101: @*/
102: int KSPQCGGetQuadratic(KSP ksp,PetscReal *quadratic)
103: {
104:   int ierr,(*f)(KSP,PetscReal*);

108:   PetscObjectQueryFunction((PetscObject)ksp,"KSPQCGGetQuadratic_C",(void (**)(void))&f);
109:   if (f) {
110:     (*f)(ksp,quadratic);
111:   }
112:   return(0);
113: }

115: #undef __FUNCT__  
117: /* 
118:   KSPSolve_QCG - Use preconditioned conjugate gradient to compute 
119:   an approximate minimizer of the quadratic function 

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

123:    subject to the Euclidean norm trust region constraint

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

127:    where 

129:      delta is the trust region radius, 
130:      g is the gradient vector, and
131:      H is Hessian matrix,
132:      D is a scaling matrix.

134:    KSPConvergedReason may be 
135: $  KSP_CONVERGED_QCG_NEG_CURVE if convergence is reached along a negative curvature direction,
136: $  KSP_CONVERGED_QCG_CONSTRAINED if convergence is reached along a constrained step,
137: $  other KSP converged/diverged reasons

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

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

149:  We should perhaps rewrite using PCApplyBAorAB().
150:  */
151: int KSPSolve_QCG(KSP ksp,int *its)
152: {
153: /* 
154:    Correpondence with documentation above:  
155:       B = g = gradient,
156:       X = s = step
157:    Note:  This is not coded correctly for complex arithmetic!
158:  */

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

176:   ierr    = PCDiagonalScale(ksp->B,&diagonalscale);
177:   if (diagonalscale) SETERRQ1(1,"Krylov method %s does not support diagonal scaling",ksp->type_name);
178:   if (ksp->transpose_solve) {
179:     SETERRQ(1,"Currently does not support transpose solve");
180:   }

182:   ksp->its = 0;
183:   maxit    = ksp->max_it;
184:   WA       = ksp->work[0];
185:   R        = ksp->work[1];
186:   P        = ksp->work[2];
187:   ASP      = ksp->work[3];
188:   BS       = ksp->work[4];
189:   W        = ksp->work[5];
190:   WA2      = ksp->work[6];
191:   X        = ksp->vec_sol;
192:   B        = ksp->vec_rhs;

194:   *its = 0;
195:   if (pcgP->delta <= dzero) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Input error: delta <= 0");
196:   KSPGetPreconditionerSide(ksp,&side);
197:   if (side != PC_SYMMETRIC) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Requires symmetric preconditioner!");

199:   /* Initialize variables */
200:   VecSet(&zero,W);        /* W = 0 */
201:   VecSet(&zero,X);        /* X = 0 */
202:   PCGetOperators(pc,&Amat,&Pmat,&pflag);

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

207:   VecNorm(BS,NORM_2,&bsnrm);
208:   PetscObjectTakeAccess(ksp);
209:   ksp->its    = 0;
210:   ksp->rnorm  = bsnrm;
211:   PetscObjectGrantAccess(ksp);
212:   KSPLogResidualHistory(ksp,bsnrm);
213:   KSPMonitor(ksp,0,bsnrm);
214:   (*ksp->converged)(ksp,0,bsnrm,&ksp->reason,ksp->cnvP);
215:   if (ksp->reason) {*its =  0; return(0);}

217:   /* Compute the initial scaled direction and scaled residual */
218:   VecCopy(BS,R);
219:   VecScale(&negone,R);
220:   VecCopy(R,P);
221: #if defined(PETSC_USE_COMPLEX)
222:   VecDot(R,R,&crtr); rtr = PetscRealPart(crtr);
223: #else
224:   VecDot(R,R,&rtr);
225: #endif

227:   for (i=0; i<=maxit; i++) {
228:     PetscObjectTakeAccess(ksp);
229:     ksp->its++;
230:     PetscObjectGrantAccess(ksp);

232:     /* Compute:  asp = D^{-T}*A*D^{-1}*p  */
233:     PCApplySymmetricRight(pc,P,WA);
234:     MatMult(Amat,WA,WA2);
235:     PCApplySymmetricLeft(pc,WA2,ASP);

237:     /* Check for negative curvature */
238: #if defined(PETSC_USE_COMPLEX)
239:     ierr  = VecDot(P,ASP,&cptasp);
240:     ptasp = PetscRealPart(cptasp);
241: #else
242:     VecDot(P,ASP,&ptasp);        /* ptasp = p^T asp */
243: #endif
244:     if (ptasp <= dzero) {

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

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

290:        step = rtr/ptasp;
291:        VecCopy(W,X);           /*  x = w  */
292:        VecAXPY(&step,P,X);   /*  x <- step*p + x  */
293:        VecNorm(X,NORM_2,&pcgP->ltsnrm);

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

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

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

323:        } else {

325:          /* Evaluate the current step */

327:          VecCopy(X,W);        /* update interior iterate */
328:          nstep = -step;
329:          VecAXPY(&nstep,ASP,R); /* r <- -step*asp + r */
330:          VecNorm(R,NORM_2,&rnrm);

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

363:   /* Unscale x */
364:   VecCopy(X,WA2);
365:   PCApplySymmetricRight(pc,WA2,X);

367:   MatMult(Amat,X,WA);
368:   VecDot(B,X,&btx);
369:   VecDot(X,WA,&xtax);
370: #if defined(PETSC_USE_COMPLEX)
371:   pcgP->quadratic = PetscRealPart(btx) + p5* PetscRealPart(xtax);
372: #else
373:   pcgP->quadratic = btx + p5*xtax;              /* Compute q(x) */
374: #endif
375:   *its = ksp->its;
376:   return(0);
377: }

379: #undef __FUNCT__  
381: int KSPSetUp_QCG(KSP ksp)
382: {

386:   /* Check user parameters and functions */
387:   if (ksp->pc_side == PC_RIGHT) {
388:     SETERRQ(2,"no right preconditioning for QCG");
389:   } else if (ksp->pc_side == PC_LEFT) {
390:     SETERRQ(2,"no left preconditioning for QCG");
391:   }

393:   /* Get work vectors from user code */
394:   KSPDefaultGetWork(ksp,7);
395:   return(0);
396: }

398: #undef __FUNCT__  
400: int KSPDestroy_QCG(KSP ksp)
401: {
402:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;
403:   int     ierr;

406:   KSPDefaultFreeWork(ksp);
407: 
408:   /* Free the context variable */
409:   PetscFree(cgP);
410:   return(0);
411: }

413: EXTERN_C_BEGIN
414: #undef __FUNCT__
416: int KSPQCGSetTrustRegionRadius_QCG(KSP ksp,PetscReal delta)
417: {
418:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;

421:   cgP->delta = delta;
422:   return(0);
423: }
424: EXTERN_C_END

426: EXTERN_C_BEGIN
427: #undef __FUNCT__
429: int KSPQCGGetTrialStepNorm_QCG(KSP ksp,PetscReal *ltsnrm)
430: {
431:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;

434:   *ltsnrm = cgP->ltsnrm;
435:   return(0);
436: }
437: EXTERN_C_END

439: EXTERN_C_BEGIN
440: #undef __FUNCT__
442: int KSPQCGGetQuadratic_QCG(KSP ksp,PetscReal *quadratic)
443: {
444:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;

447:   *quadratic = cgP->quadratic;
448:   return(0);
449: }
450: EXTERN_C_END

452: #undef __FUNCT__  
454: int KSPSetFromOptions_QCG(KSP ksp)
455: {
456:   int        ierr;
457:   PetscReal  delta;
458:   KSP_QCG    *cgP = (KSP_QCG*)ksp->data;
459:   PetscTruth flg;

462:   PetscOptionsHead("KSP QCG Options");
463:   PetscOptionsReal("-ksp_qcg_trustregionradius","Trust Region Radius","KSPQCGSetTrustRegionRadius",cgP->delta,&delta,&flg);
464:   if (flg) { KSPQCGSetTrustRegionRadius(ksp,delta); }
465:   PetscOptionsTail();
466:   return(0);
467: }

469: EXTERN_C_BEGIN
470: #undef __FUNCT__  
472: int KSPCreate_QCG(KSP ksp)
473: {
474:   int     ierr;
475:   KSP_QCG *cgP;

478:   PetscMalloc(sizeof(KSP_QCG),&cgP);
479:   PetscMemzero(cgP,sizeof(KSP_QCG));
480:   PetscLogObjectMemory(ksp,sizeof(KSP_QCG));
481:   ksp->data                      = (void*)cgP;
482:   ksp->pc_side                   = PC_SYMMETRIC;
483:   ksp->ops->setup                = KSPSetUp_QCG;
484:   ksp->ops->setfromoptions       = KSPSetFromOptions_QCG;
485:   ksp->ops->solve                = KSPSolve_QCG;
486:   ksp->ops->destroy              = KSPDestroy_QCG;
487:   ksp->ops->buildsolution        = KSPDefaultBuildSolution;
488:   ksp->ops->buildresidual        = KSPDefaultBuildResidual;
489:   ksp->ops->setfromoptions       = 0;
490:   ksp->ops->view                 = 0;

492:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPQCGGetQuadratic_C",
493:                                     "KSPQCGGetQuadratic_QCG",
494:                                      KSPQCGGetQuadratic_QCG);
495:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPQCGGetTrialStepNorm_C",
496:                                     "KSPQCGGetTrialStepNorm_QCG",
497:                                      KSPQCGGetTrialStepNorm_QCG);
498:   PetscObjectComposeFunctionDynamic((PetscObject)ksp,"KSPQCGSetTrustRegionRadius_C",
499:                                     "KSPQCGSetTrustRegionRadius_QCG",
500:                                      KSPQCGSetTrustRegionRadius_QCG);
501:   cgP->delta = PETSC_MAX; /* default trust region radius is infinite */
502:   return(0);
503: }
504: EXTERN_C_END

506: /* ---------------------------------------------------------- */
507: #undef __FUNCT__  
509: /* 
510:   QuadraticRoots_Private - Computes the roots of the quadratic,
511:          ||s + step*p|| - delta = 0 
512:    such that step1 >= 0 >= step2.
513:    where
514:       delta:
515:         On entry delta must contain scalar delta.
516:         On exit delta is unchanged.
517:       step1:
518:         On entry step1 need not be specified.
519:         On exit step1 contains the non-negative root.
520:       step2:
521:         On entry step2 need not be specified.
522:         On exit step2 contains the non-positive root.
523:    C code is translated from the Fortran version of the MINPACK-2 Project,
524:    Argonne National Laboratory, Brett M. Averick and Richard G. Carter.
525: */
526: static int QuadraticRoots_Private(Vec s,Vec p,PetscReal *delta,PetscReal *step1,PetscReal *step2)
527: {
528:   PetscReal zero = 0.0,dsq,ptp,pts,rad,sts;
529:   int       ierr;
530: #if defined(PETSC_USE_COMPLEX)
531:   PetscScalar    cptp,cpts,csts;
532: #endif

535: #if defined(PETSC_USE_COMPLEX)
536:   VecDot(p,s,&cpts); pts = PetscRealPart(cpts);
537:   VecDot(p,p,&cptp); ptp = PetscRealPart(cptp);
538:   VecDot(s,s,&csts); sts = PetscRealPart(csts);
539: #else
540:   VecDot(p,s,&pts);
541:   VecDot(p,p,&ptp);
542:   VecDot(s,s,&sts);
543: #endif
544:   dsq  = (*delta)*(*delta);
545:   rad  = sqrt((pts*pts) - ptp*(sts - dsq));
546:   if (pts > zero) {
547:     *step2 = -(pts + rad)/ptp;
548:     *step1 = (sts - dsq)/(ptp * *step2);
549:   } else {
550:     *step1 = -(pts - rad)/ptp;
551:     *step2 = (sts - dsq)/(ptp * *step1);
552:   }
553:   return(0);
554: }