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: }