Actual source code: qcg.c

  1: /*$Id: qcg.c,v 1.78 2001/03/23 23:23:45 balay Exp $*/
  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:   KSPSolve_QCG - Use preconditioned conjugate gradient to compute 
 14:   an approximate minimizer of the quadratic function 

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

 18:    subject to the Euclidean norm trust region constraint

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

 22:    where 

 24:      delta is the trust region radius, 
 25:      g is the gradient vector, and
 26:      H is Hessian matrix,
 27:      D is a scaling matrix.

 29:    KSPConvergedReason may be 
 30: $  KSP_CONVERGED_QCG_NEG_CURVE if convergence is reached along a negative curvature direction,
 31: $  KSP_CONVERGED_QCG_CONSTRAINED if convergence is reached along a constrained step,
 32: $  other KSP converged/diverged reasons

 34:   This method is intended for use in conjunction with the SNES trust region method
 35:   for unconstrained minimization, SNESUMTR.

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

 44:  We should perhaps rewrite using PCApplyBAorAB().
 45:  */
 46: int KSPSolve_QCG(KSP ksp,int *its)
 47: {
 48: /* 
 49:    Correpondence with documentation above:  
 50:       B = g = gradient,
 51:       X = s = step
 52:    Note:  This is not coded correctly for complex arithmetic!
 53:  */

 55:   KSP_QCG      *pcgP = (KSP_QCG*)ksp->data;
 56:   MatStructure pflag;
 57:   Mat          Amat,Pmat;
 58:   Vec          W,WA,WA2,R,P,ASP,BS,X,B;
 59:   Scalar       zero = 0.0,negone = -1.0,scal,nstep,btx,xtax,beta,rntrn,step;
 60:   PetscReal    ptasp,q1,q2,wtasp,bstp,rtr,xnorm,step1,step2,rnrm,p5 = 0.5;
 61:   PetscReal    dzero = 0.0,bsnrm;
 62:   int          i,maxit,ierr;
 63:   PC           pc = ksp->B;
 64:   PCSide       side;
 65: #if defined(PETSC_USE_COMPLEX)
 66:   Scalar       cstep1,cstep2,ctasp,cbstp,crtr,cwtasp,cptasp;
 67: #endif
 68:   PetscTruth   diagonalscale;

 71:   ierr    = PCDiagonalScale(ksp->B,&diagonalscale);
 72:   if (diagonalscale) SETERRQ1(1,"Krylov method %s does not support diagonal scaling",ksp->type_name);
 73:   if (ksp->transpose_solve) {
 74:     SETERRQ(1,"Currently does not support transpose solve");
 75:   }

 77:   ksp->its = 0;
 78:   maxit    = ksp->max_it;
 79:   WA       = ksp->work[0];
 80:   R        = ksp->work[1];
 81:   P        = ksp->work[2];
 82:   ASP      = ksp->work[3];
 83:   BS       = ksp->work[4];
 84:   W        = ksp->work[5];
 85:   WA2      = ksp->work[6];
 86:   X        = ksp->vec_sol;
 87:   B        = ksp->vec_rhs;

 89:   *its = 0;
 90:   if (pcgP->delta <= dzero) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Input error: delta <= 0");
 91:   KSPGetPreconditionerSide(ksp,&side);
 92:   if (side != PC_SYMMETRIC) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Requires symmetric preconditioner!");

 94:   /* Initialize variables */
 95:   VecSet(&zero,W);        /* W = 0 */
 96:   VecSet(&zero,X);        /* X = 0 */
 97:   PCGetOperators(pc,&Amat,&Pmat,&pflag);

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

102:   VecNorm(BS,NORM_2,&bsnrm);
103:   PetscObjectTakeAccess(ksp);
104:   ksp->its    = 0;
105:   ksp->rnorm  = bsnrm;
106:   PetscObjectGrantAccess(ksp);
107:   KSPLogResidualHistory(ksp,bsnrm);
108:   KSPMonitor(ksp,0,bsnrm);
109:   (*ksp->converged)(ksp,0,bsnrm,&ksp->reason,ksp->cnvP);
110:   if (ksp->reason) {*its =  0; return(0);}

112:   /* Compute the initial scaled direction and scaled residual */
113:   VecCopy(BS,R);
114:   VecScale(&negone,R);
115:   VecCopy(R,P);
116: #if defined(PETSC_USE_COMPLEX)
117:   VecDot(R,R,&crtr); rtr = PetscRealPart(crtr);
118: #else
119:   VecDot(R,R,&rtr);
120: #endif

122:   for (i=0; i<=maxit; i++) {
123:     PetscObjectTakeAccess(ksp);
124:     ksp->its++;
125:     PetscObjectGrantAccess(ksp);

127:     /* Compute:  asp = D^{-T}*A*D^{-1}*p  */
128:     PCApplySymmetricRight(pc,P,WA);
129:     MatMult(Amat,WA,WA2);
130:     PCApplySymmetricLeft(pc,WA2,ASP);

132:     /* Check for negative curvature */
133: #if defined(PETSC_USE_COMPLEX)
134:     ierr  = VecDot(P,ASP,&cptasp);
135:     ptasp = PetscRealPart(cptasp);
136: #else
137:     VecDot(P,ASP,&ptasp);        /* ptasp = p^T asp */
138: #endif
139:     if (ptasp <= dzero) {

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

144:        if (!i) {
145:          VecCopy(P,X);
146:          VecNorm(X,NORM_2,&xnorm);
147:          scal = pcgP->delta / xnorm;
148:          VecScale(&scal,X);
149:        } else {
150:          /* Compute roots of quadratic */
151:          QuadraticRoots_Private(W,P,&pcgP->delta,&step1,&step2);
152: #if defined(PETSC_USE_COMPLEX)
153:          VecDot(W,ASP,&cwtasp); wtasp = PetscRealPart(cwtasp);
154:          VecDot(BS,P,&cbstp);   bstp  = PetscRealPart(cbstp);
155: #else
156:          VecDot(W,ASP,&wtasp);
157:          VecDot(BS,P,&bstp);
158: #endif
159:          VecCopy(W,X);
160:          q1 = step1*(bstp + wtasp + p5*step1*ptasp);
161:          q2 = step2*(bstp + wtasp + p5*step2*ptasp);
162: #if defined(PETSC_USE_COMPLEX)
163:          if (q1 <= q2) {
164:            cstep1 = step1; VecAXPY(&cstep1,P,X);
165:          } else {
166:            cstep2 = step2; VecAXPY(&cstep2,P,X);
167:          }
168: #else
169:          if (q1 <= q2) {VecAXPY(&step1,P,X);}
170:          else          {VecAXPY(&step2,P,X);}
171: #endif
172:        }
173:        pcgP->ltsnrm = pcgP->delta;                       /* convergence in direction of */
174:        ksp->reason  = KSP_CONVERGED_QCG_NEG_CURVE;  /* negative curvature */
175:        if (!i) {
176:          PetscLogInfo(ksp,"KSPSolve_QCG: negative curvature: delta=%gn",pcgP->delta);
177:        } else {
178:          PetscLogInfo(ksp,"KSPSolve_QCG: negative curvature: step1=%g, step2=%g, delta=%gn",step1,step2,pcgP->delta);
179:        }
180: 
181:     } else {
182: 
183:        /* Compute step along p */

185:        step = rtr/ptasp;
186:        VecCopy(W,X);           /*  x = w  */
187:        VecAXPY(&step,P,X);   /*  x <- step*p + x  */
188:        VecNorm(X,NORM_2,&pcgP->ltsnrm);

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

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

197:          if (!i) {
198:            scal = pcgP->delta / pcgP->ltsnrm;
199:            VecScale(&scal,X);
200:          } else {
201:            /* Compute roots of quadratic */
202:            QuadraticRoots_Private(W,P,&pcgP->delta,&step1,&step2);
203:            VecCopy(W,X);
204: #if defined(PETSC_USE_COMPLEX)
205:            cstep1 = step1; VecAXPY(&cstep1,P,X);
206: #else
207:            VecAXPY(&step1,P,X);  /*  x <- step1*p + x  */
208: #endif
209:          }
210:          pcgP->ltsnrm = pcgP->delta;
211:          ksp->reason  = KSP_CONVERGED_QCG_CONSTRAINED;        /* convergence along constrained step */
212:          if (!i) {
213:            PetscLogInfo(ksp,"KSPSolve_QCG: constrained step: delta=%gn",pcgP->delta);
214:          } else {
215:            PetscLogInfo(ksp,"KSPSolve_QCG: constrained step: step1=%g, step2=%g, delta=%gn",step1,step2,pcgP->delta);
216:          }

218:        } else {

220:          /* Evaluate the current step */

222:          VecCopy(X,W);        /* update interior iterate */
223:          nstep = -step;
224:          VecAXPY(&nstep,ASP,R); /* r <- -step*asp + r */
225:          VecNorm(R,NORM_2,&rnrm);

227:          PetscObjectTakeAccess(ksp);
228:          ksp->rnorm                                    = rnrm;
229:          PetscObjectGrantAccess(ksp);
230:          KSPLogResidualHistory(ksp,rnrm);
231:          KSPMonitor(ksp,i+1,rnrm);
232:          (*ksp->converged)(ksp,i+1,rnrm,&ksp->reason,ksp->cnvP);
233:          if (ksp->reason) {                 /* convergence for */
234: #if defined(PETSC_USE_COMPLEX)               
235:            PetscLogInfo(ksp,"KSPSolve_QCG: truncated step: step=%g, rnrm=%g, delta=%gn",PetscRealPart(step),rnrm,pcgP->delta);
236: #else
237:            PetscLogInfo(ksp,"KSPSolve_QCG: truncated step: step=%g, rnrm=%g, delta=%gn",step,rnrm,pcgP->delta);
238: #endif
239:          }
240:       }
241:     }
242:     if (ksp->reason) break;        /* Convergence has been attained */
243:     else {                /* Compute a new AS-orthogonal direction */
244:       VecDot(R,R,&rntrn);
245:       beta = rntrn/rtr;
246:       VecAYPX(&beta,R,P);        /*  p <- r + beta*p  */
247: #if defined(PETSC_USE_COMPLEX)
248:       rtr = PetscRealPart(rntrn);
249: #else
250:       rtr = rntrn;
251: #endif
252:     }
253:   }
254:   if (!ksp->reason) {
255:     ksp->reason = KSP_DIVERGED_ITS;
256:     i--;
257:   }

259:   /* Unscale x */
260:   VecCopy(X,WA2);
261:   PCApplySymmetricRight(pc,WA2,X);

263:   MatMult(Amat,X,WA);
264:   VecDot(B,X,&btx);
265:   VecDot(X,WA,&xtax);
266: #if defined(PETSC_USE_COMPLEX)
267:   pcgP->quadratic = PetscRealPart(btx) + p5* PetscRealPart(xtax);
268: #else
269:   pcgP->quadratic = btx + p5*xtax;              /* Compute q(x) */
270: #endif
271:   *its = i+1;
272:   return(0);
273: }

275: int KSPSetUp_QCG(KSP ksp)
276: {

280:   /* Check user parameters and functions */
281:   if (ksp->pc_side == PC_RIGHT) {
282:     SETERRQ(2,"no right preconditioning for QCG");
283:   } else if (ksp->pc_side == PC_LEFT) {
284:     SETERRQ(2,"no left preconditioning for QCG");
285:   }

287:   /* Get work vectors from user code */
288:   KSPDefaultGetWork(ksp,7);
289:   return(0);
290: }

292: int KSPDestroy_QCG(KSP ksp)
293: {
294:   KSP_QCG *cgP = (KSP_QCG*)ksp->data;
295:   int     ierr;

298:   KSPDefaultFreeWork(ksp);
299: 
300:   /* Free the context variable */
301:   PetscFree(cgP);
302:   return(0);
303: }

305: EXTERN_C_BEGIN
306: int KSPCreate_QCG(KSP ksp)
307: {
308:   int     ierr;
309:   KSP_QCG *cgP;

312:   PetscMalloc(sizeof(KSP_QCG),&cgP);
313:   PetscMemzero(cgP,sizeof(KSP_QCG));
314:   PetscLogObjectMemory(ksp,sizeof(KSP_QCG));
315:   ksp->data                      = (void*)cgP;
316:   ksp->pc_side                   = PC_SYMMETRIC;
317:   ksp->calc_res                  = PETSC_TRUE;
318:   ksp->ops->setup                = KSPSetUp_QCG;
319:   ksp->ops->solve                = KSPSolve_QCG;
320:   ksp->ops->destroy              = KSPDestroy_QCG;
321:   ksp->ops->buildsolution        = KSPDefaultBuildSolution;
322:   ksp->ops->buildresidual        = KSPDefaultBuildResidual;
323:   ksp->ops->setfromoptions       = 0;
324:   ksp->ops->view                 = 0;
325:   return(0);
326: }
327: EXTERN_C_END

329: /* ---------------------------------------------------------- */
330: /* 
331:   QuadraticRoots_Private - Computes the roots of the quadratic,
332:          ||s + step*p|| - delta = 0 
333:    such that step1 >= 0 >= step2.
334:    where
335:       delta:
336:         On entry delta must contain scalar delta.
337:         On exit delta is unchanged.
338:       step1:
339:         On entry step1 need not be specified.
340:         On exit step1 contains the non-negative root.
341:       step2:
342:         On entry step2 need not be specified.
343:         On exit step2 contains the non-positive root.
344:    C code is translated from the Fortran version of the MINPACK-2 Project,
345:    Argonne National Laboratory, Brett M. Averick and Richard G. Carter.
346: */
347: static int QuadraticRoots_Private(Vec s,Vec p,PetscReal *delta,PetscReal *step1,PetscReal *step2)
348: {
349:   PetscReal zero = 0.0,dsq,ptp,pts,rad,sts;
350:   int       ierr;
351: #if defined(PETSC_USE_COMPLEX)
352:   Scalar    cptp,cpts,csts;
353: #endif

356: #if defined(PETSC_USE_COMPLEX)
357:   VecDot(p,s,&cpts); pts = PetscRealPart(cpts);
358:   VecDot(p,p,&cptp); ptp = PetscRealPart(cptp);
359:   VecDot(s,s,&csts); sts = PetscRealPart(csts);
360: #else
361:   VecDot(p,s,&pts);
362:   VecDot(p,p,&ptp);
363:   VecDot(s,s,&sts);
364: #endif
365:   dsq  = (*delta)*(*delta);
366:   rad  = sqrt((pts*pts) - ptp*(sts - dsq));
367:   if (pts > zero) {
368:     *step2 = -(pts + rad)/ptp;
369:     *step1 = (sts - dsq)/(ptp * *step2);
370:   } else {
371:     *step1 = -(pts - rad)/ptp;
372:     *step2 = (sts - dsq)/(ptp * *step1);
373:   }
374:   return(0);
375: }