Actual source code: pounders.c

  1: #include <../src/tao/leastsquares/impls/pounders/pounders.h>

  3: static PetscErrorCode pounders_h(Tao subtao, Vec v, Mat H, Mat Hpre, void *ctx)
  4: {
  5:   return 0;
  6: }

  8: static PetscErrorCode  pounders_fg(Tao subtao, Vec x, PetscReal *f, Vec g, void *ctx)
  9: {
 10:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)ctx;
 11:   PetscReal      d1,d2;

 13:   /* g = A*x  (add b later)*/
 14:   MatMult(mfqP->subH,x,g);

 16:   /* f = 1/2 * x'*(Ax) + b'*x  */
 17:   VecDot(x,g,&d1);
 18:   VecDot(mfqP->subb,x,&d2);
 19:   *f = 0.5 *d1 + d2;

 21:   /* now  g = g + b */
 22:   VecAXPY(g, 1.0, mfqP->subb);
 23:   return 0;
 24: }

 26: static PetscErrorCode pounders_feval(Tao tao, Vec x, Vec F, PetscReal *fsum)
 27: {
 28:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;
 29:   PetscInt       i,row,col;
 30:   PetscReal      fr,fc;

 32:   TaoComputeResidual(tao,x,F);
 33:   if (tao->res_weights_v) {
 34:     VecPointwiseMult(mfqP->workfvec,tao->res_weights_v,F);
 35:     VecDot(mfqP->workfvec,mfqP->workfvec,fsum);
 36:   } else if (tao->res_weights_w) {
 37:     *fsum=0;
 38:     for (i=0;i<tao->res_weights_n;i++) {
 39:       row=tao->res_weights_rows[i];
 40:       col=tao->res_weights_cols[i];
 41:       VecGetValues(F,1,&row,&fr);
 42:       VecGetValues(F,1,&col,&fc);
 43:       *fsum += tao->res_weights_w[i]*fc*fr;
 44:     }
 45:   } else {
 46:     VecDot(F,F,fsum);
 47:   }
 48:   PetscInfo(tao,"Least-squares residual norm: %20.19e\n",(double)*fsum);
 50:   return 0;
 51: }

 53: static PetscErrorCode gqtwrap(Tao tao,PetscReal *gnorm, PetscReal *qmin)
 54: {
 55: #if defined(PETSC_USE_REAL_SINGLE)
 56:   PetscReal      atol=1.0e-5;
 57: #else
 58:   PetscReal      atol=1.0e-10;
 59: #endif
 60:   PetscInt       info,its;
 61:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;

 63:   if (!mfqP->usegqt) {
 64:     PetscReal maxval;
 65:     PetscInt  i,j;

 67:     VecSetValues(mfqP->subb,mfqP->n,mfqP->indices,mfqP->Gres,INSERT_VALUES);
 68:     VecAssemblyBegin(mfqP->subb);
 69:     VecAssemblyEnd(mfqP->subb);

 71:     VecSet(mfqP->subx,0.0);

 73:     VecSet(mfqP->subndel,-1.0);
 74:     VecSet(mfqP->subpdel,+1.0);

 76:     /* Complete the lower triangle of the Hessian matrix */
 77:     for (i=0;i<mfqP->n;i++) {
 78:       for (j=i+1;j<mfqP->n;j++) {
 79:         mfqP->Hres[j+mfqP->n*i] = mfqP->Hres[mfqP->n*j+i];
 80:       }
 81:     }
 82:     MatSetValues(mfqP->subH,mfqP->n,mfqP->indices,mfqP->n,mfqP->indices,mfqP->Hres,INSERT_VALUES);
 83:     MatAssemblyBegin(mfqP->subH,MAT_FINAL_ASSEMBLY);
 84:     MatAssemblyEnd(mfqP->subH,MAT_FINAL_ASSEMBLY);

 86:     TaoResetStatistics(mfqP->subtao);
 87:     /* TaoSetTolerances(mfqP->subtao,*gnorm,*gnorm,PETSC_DEFAULT); */
 88:     /* enforce bound constraints -- experimental */
 89:     if (tao->XU && tao->XL) {
 90:       VecCopy(tao->XU,mfqP->subxu);
 91:       VecAXPY(mfqP->subxu,-1.0,tao->solution);
 92:       VecScale(mfqP->subxu,1.0/mfqP->delta);
 93:       VecCopy(tao->XL,mfqP->subxl);
 94:       VecAXPY(mfqP->subxl,-1.0,tao->solution);
 95:       VecScale(mfqP->subxl,1.0/mfqP->delta);

 97:       VecPointwiseMin(mfqP->subxu,mfqP->subxu,mfqP->subpdel);
 98:       VecPointwiseMax(mfqP->subxl,mfqP->subxl,mfqP->subndel);
 99:     } else {
100:       VecCopy(mfqP->subpdel,mfqP->subxu);
101:       VecCopy(mfqP->subndel,mfqP->subxl);
102:     }
103:     /* Make sure xu > xl */
104:     VecCopy(mfqP->subxl,mfqP->subpdel);
105:     VecAXPY(mfqP->subpdel,-1.0,mfqP->subxu);
106:     VecMax(mfqP->subpdel,NULL,&maxval);
108:     /* Make sure xu > tao->solution > xl */
109:     VecCopy(mfqP->subxl,mfqP->subpdel);
110:     VecAXPY(mfqP->subpdel,-1.0,mfqP->subx);
111:     VecMax(mfqP->subpdel,NULL,&maxval);

114:     VecCopy(mfqP->subx,mfqP->subpdel);
115:     VecAXPY(mfqP->subpdel,-1.0,mfqP->subxu);
116:     VecMax(mfqP->subpdel,NULL,&maxval);

119:     TaoSolve(mfqP->subtao);
120:     TaoGetSolutionStatus(mfqP->subtao,NULL,qmin,NULL,NULL,NULL,NULL);

122:     /* test bounds post-solution*/
123:     VecCopy(mfqP->subxl,mfqP->subpdel);
124:     VecAXPY(mfqP->subpdel,-1.0,mfqP->subx);
125:     VecMax(mfqP->subpdel,NULL,&maxval);
126:     if (maxval > 1e-5) {
127:       PetscInfo(tao,"subproblem solution < lower bound\n");
128:       tao->reason = TAO_DIVERGED_TR_REDUCTION;
129:     }

131:     VecCopy(mfqP->subx,mfqP->subpdel);
132:     VecAXPY(mfqP->subpdel,-1.0,mfqP->subxu);
133:     VecMax(mfqP->subpdel,NULL,&maxval);
134:     if (maxval > 1e-5) {
135:       PetscInfo(tao,"subproblem solution > upper bound\n");
136:       tao->reason = TAO_DIVERGED_TR_REDUCTION;
137:     }
138:   } else {
139:     gqt(mfqP->n,mfqP->Hres,mfqP->n,mfqP->Gres,1.0,mfqP->gqt_rtol,atol,mfqP->gqt_maxits,gnorm,qmin,mfqP->Xsubproblem,&info,&its,mfqP->work,mfqP->work2, mfqP->work3);
140:   }
141:   *qmin *= -1;
142:   return 0;
143: }

145: static PetscErrorCode pounders_update_res(Tao tao)
146: {
147:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;
148:   PetscInt       i,row,col;
149:   PetscBLASInt   blasn=mfqP->n,blasn2=blasn*blasn,blasm=mfqP->m,ione=1;
150:   PetscReal      zero=0.0,one=1.0,wii,factor;

152:   for (i=0;i<mfqP->n;i++) {
153:     mfqP->Gres[i]=0;
154:   }
155:   for (i=0;i<mfqP->n*mfqP->n;i++) {
156:     mfqP->Hres[i]=0;
157:   }

159:   /* Compute Gres= sum_ij[wij * (cjgi + cigj)] */
160:   if (tao->res_weights_v) {
161:     /* Vector(diagonal) weights: gres = sum_i(wii*ci*gi) */
162:     for (i=0;i<mfqP->m;i++) {
163:       VecGetValues(tao->res_weights_v,1,&i,&factor);
164:       factor=factor*mfqP->C[i];
165:       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn,&factor,&mfqP->Fdiff[blasn*i],&ione,mfqP->Gres,&ione));
166:     }

168:     /* compute Hres = sum_ij [wij * (*ci*Hj + cj*Hi + gi gj' + gj gi') ] */
169:     /* vector(diagonal weights) Hres = sum_i(wii*(ci*Hi + gi * gi')*/
170:     for (i=0;i<mfqP->m;i++) {
171:       VecGetValues(tao->res_weights_v,1,&i,&wii);
172:       if (tao->niter>1) {
173:         factor=wii*mfqP->C[i];
174:         /* add wii * ci * Hi */
175:         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn2,&factor,&mfqP->H[i],&blasm,mfqP->Hres,&ione));
176:       }
177:       /* add wii * gi * gi' */
178:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&blasn,&blasn,&ione,&wii,&mfqP->Fdiff[blasn*i],&blasn,&mfqP->Fdiff[blasn*i],&blasn,&one,mfqP->Hres,&blasn));
179:     }
180:   } else if (tao->res_weights_w) {
181:     /* General case: .5 * Gres= sum_ij[wij * (cjgi + cigj)] */
182:     for (i=0;i<tao->res_weights_n;i++) {
183:       row=tao->res_weights_rows[i];
184:       col=tao->res_weights_cols[i];

186:       factor = tao->res_weights_w[i]*mfqP->C[col]/2.0;
187:       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn,&factor,&mfqP->Fdiff[blasn*row],&ione,mfqP->Gres,&ione));
188:       factor = tao->res_weights_w[i]*mfqP->C[row]/2.0;
189:       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn,&factor,&mfqP->Fdiff[blasn*col],&ione,mfqP->Gres,&ione));
190:     }

192:     /* compute Hres = sum_ij [wij * (*ci*Hj + cj*Hi + gi gj' + gj gi') ] */
193:     /* .5 * sum_ij [wij * (*ci*Hj + cj*Hi + gi gj' + gj gi') ] */
194:     for (i=0;i<tao->res_weights_n;i++) {
195:       row=tao->res_weights_rows[i];
196:       col=tao->res_weights_cols[i];
197:       factor=tao->res_weights_w[i]/2.0;
198:       /* add wij * gi gj' + wij * gj gi' */
199:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&blasn,&blasn,&ione,&factor,&mfqP->Fdiff[blasn*row],&blasn,&mfqP->Fdiff[blasn*col],&blasn,&one,mfqP->Hres,&blasn));
200:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&blasn,&blasn,&ione,&factor,&mfqP->Fdiff[blasn*col],&blasn,&mfqP->Fdiff[blasn*row],&blasn,&one,mfqP->Hres,&blasn));
201:     }
202:     if (tao->niter > 1) {
203:       for (i=0;i<tao->res_weights_n;i++) {
204:         row=tao->res_weights_rows[i];
205:         col=tao->res_weights_cols[i];

207:         /* add  wij*cj*Hi */
208:         factor = tao->res_weights_w[i]*mfqP->C[col]/2.0;
209:         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn2,&factor,&mfqP->H[row],&blasm,mfqP->Hres,&ione));

211:         /* add wij*ci*Hj */
212:         factor = tao->res_weights_w[i]*mfqP->C[row]/2.0;
213:         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn2,&factor,&mfqP->H[col],&blasm,mfqP->Hres,&ione));
214:       }
215:     }
216:   } else {
217:     /* Default: Gres= sum_i[cigi] = G*c' */
218:     PetscInfo(tao,"Identity weights\n");
219:     PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&blasn,&blasm,&one,mfqP->Fdiff,&blasn,mfqP->C,&ione,&zero,mfqP->Gres,&ione));

221:     /* compute Hres = sum_ij [wij * (*ci*Hj + cj*Hi + gi gj' + gj gi') ] */
222:     /*  Hres = G*G' + 0.5 sum {F(xkin,i)*H(:,:,i)}  */
223:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&blasn,&blasn,&blasm,&one,mfqP->Fdiff, &blasn,mfqP->Fdiff, &blasn,&zero,mfqP->Hres,&blasn));

225:     /* sum(F(xkin,i)*H(:,:,i)) */
226:     if (tao->niter>1) {
227:       for (i=0;i<mfqP->m;i++) {
228:         factor = mfqP->C[i];
229:         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&blasn2,&factor,&mfqP->H[i],&blasm,mfqP->Hres,&ione));
230:       }
231:     }
232:   }
233:   return 0;
234: }

236: static PetscErrorCode phi2eval(PetscReal *x, PetscInt n, PetscReal *phi)
237: {
238: /* Phi = .5*[x(1)^2  sqrt(2)*x(1)*x(2) ... sqrt(2)*x(1)*x(n) ... x(2)^2 sqrt(2)*x(2)*x(3) .. x(n)^2] */
239:   PetscInt  i,j,k;
240:   PetscReal sqrt2 = PetscSqrtReal(2.0);

242:   j=0;
243:   for (i=0;i<n;i++) {
244:     phi[j] = 0.5 * x[i]*x[i];
245:     j++;
246:     for (k=i+1;k<n;k++) {
247:       phi[j]  = x[i]*x[k]/sqrt2;
248:       j++;
249:     }
250:   }
251:   return 0;
252: }

254: static PetscErrorCode getquadpounders(TAO_POUNDERS *mfqP)
255: {
256: /* Computes the parameters of the quadratic Q(x) = c + g'*x + 0.5*x*G*x'
257:    that satisfies the interpolation conditions Q(X[:,j]) = f(j)
258:    for j=1,...,m and with a Hessian matrix of least Frobenius norm */

260:     /* NB --we are ignoring c */
261:   PetscInt     i,j,k,num,np = mfqP->nmodelpoints;
262:   PetscReal    one = 1.0,zero=0.0,negone=-1.0;
263:   PetscBLASInt blasnpmax = mfqP->npmax;
264:   PetscBLASInt blasnplus1 = mfqP->n+1;
265:   PetscBLASInt blasnp = np;
266:   PetscBLASInt blasint = mfqP->n*(mfqP->n+1) / 2;
267:   PetscBLASInt blasint2 = np - mfqP->n-1;
268:   PetscBLASInt info,ione=1;
269:   PetscReal    sqrt2 = PetscSqrtReal(2.0);

271:   for (i=0;i<mfqP->n*mfqP->m;i++) {
272:     mfqP->Gdel[i] = 0;
273:   }
274:   for (i=0;i<mfqP->n*mfqP->n*mfqP->m;i++) {
275:     mfqP->Hdel[i] = 0;
276:   }

278:     /* factor M */
279:   PetscStackCallBLAS("LAPACKgetrf",LAPACKgetrf_(&blasnplus1,&blasnp,mfqP->M,&blasnplus1,mfqP->npmaxiwork,&info));

282:   if (np == mfqP->n+1) {
283:     for (i=0;i<mfqP->npmax-mfqP->n-1;i++) {
284:       mfqP->omega[i]=0.0;
285:     }
286:     for (i=0;i<mfqP->n*(mfqP->n+1)/2;i++) {
287:       mfqP->beta[i]=0.0;
288:     }
289:   } else {
290:     /* Let Ltmp = (L'*L) */
291:     PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&blasint2,&blasint2,&blasint,&one,&mfqP->L[(mfqP->n+1)*blasint],&blasint,&mfqP->L[(mfqP->n+1)*blasint],&blasint,&zero,mfqP->L_tmp,&blasint));

293:     /* factor Ltmp */
294:     PetscStackCallBLAS("LAPACKpotrf",LAPACKpotrf_("L",&blasint2,mfqP->L_tmp,&blasint,&info));
296:   }

298:   for (k=0;k<mfqP->m;k++) {
299:     if (np != mfqP->n+1) {
300:       /* Solve L'*L*Omega = Z' * RESk*/
301:       PetscStackCallBLAS("BLASgemv",BLASgemv_("T",&blasnp,&blasint2,&one,mfqP->Z,&blasnpmax,&mfqP->RES[mfqP->npmax*k],&ione,&zero,mfqP->omega,&ione));
302:       PetscStackCallBLAS("LAPACKpotrs",LAPACKpotrs_("L",&blasint2,&ione,mfqP->L_tmp,&blasint,mfqP->omega,&blasint2,&info));

305:       /* Beta = L*Omega */
306:       PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&blasint,&blasint2,&one,&mfqP->L[(mfqP->n+1)*blasint],&blasint,mfqP->omega,&ione,&zero,mfqP->beta,&ione));
307:     }

309:     /* solve M'*Alpha = RESk - N'*Beta */
310:     PetscStackCallBLAS("BLASgemv",BLASgemv_("T",&blasint,&blasnp,&negone,mfqP->N,&blasint,mfqP->beta,&ione,&one,&mfqP->RES[mfqP->npmax*k],&ione));
311:     PetscStackCallBLAS("LAPACKgetrs",LAPACKgetrs_("T",&blasnplus1,&ione,mfqP->M,&blasnplus1,mfqP->npmaxiwork,&mfqP->RES[mfqP->npmax*k],&blasnplus1,&info));

314:     /* Gdel(:,k) = Alpha(2:n+1) */
315:     for (i=0;i<mfqP->n;i++) {
316:       mfqP->Gdel[i + mfqP->n*k] = mfqP->RES[mfqP->npmax*k + i+1];
317:     }

319:     /* Set Hdels */
320:     num=0;
321:     for (i=0;i<mfqP->n;i++) {
322:       /* H[i,i,k] = Beta(num) */
323:       mfqP->Hdel[(i*mfqP->n + i)*mfqP->m + k] = mfqP->beta[num];
324:       num++;
325:       for (j=i+1;j<mfqP->n;j++) {
326:         /* H[i,j,k] = H[j,i,k] = Beta(num)/sqrt(2) */
327:         mfqP->Hdel[(j*mfqP->n + i)*mfqP->m + k] = mfqP->beta[num]/sqrt2;
328:         mfqP->Hdel[(i*mfqP->n + j)*mfqP->m + k] = mfqP->beta[num]/sqrt2;
329:         num++;
330:       }
331:     }
332:   }
333:   return 0;
334: }

336: static PetscErrorCode morepoints(TAO_POUNDERS *mfqP)
337: {
338:   /* Assumes mfqP->model_indices[0]  is minimum index
339:    Finishes adding points to mfqP->model_indices (up to npmax)
340:    Computes L,Z,M,N
341:    np is actual number of points in model (should equal npmax?) */
342:   PetscInt        point,i,j,offset;
343:   PetscInt        reject;
344:   PetscBLASInt    blasn=mfqP->n,blasnpmax=mfqP->npmax,blasnplus1=mfqP->n+1,info,blasnmax=mfqP->nmax,blasint,blasint2,blasnp,blasmaxmn;
345:   const PetscReal *x;
346:   PetscReal       normd;

348:   /* Initialize M,N */
349:   for (i=0;i<mfqP->n+1;i++) {
350:     VecGetArrayRead(mfqP->Xhist[mfqP->model_indices[i]],&x);
351:     mfqP->M[(mfqP->n+1)*i] = 1.0;
352:     for (j=0;j<mfqP->n;j++) {
353:       mfqP->M[j+1+((mfqP->n+1)*i)] = (x[j]  - mfqP->xmin[j]) / mfqP->delta;
354:     }
355:     VecRestoreArrayRead(mfqP->Xhist[mfqP->model_indices[i]],&x);
356:     phi2eval(&mfqP->M[1+((mfqP->n+1)*i)],mfqP->n,&mfqP->N[mfqP->n*(mfqP->n+1)/2 * i]);
357:   }

359:   /* Now we add points until we have npmax starting with the most recent ones */
360:   point = mfqP->nHist-1;
361:   mfqP->nmodelpoints = mfqP->n+1;
362:   while (mfqP->nmodelpoints < mfqP->npmax && point>=0) {
363:     /* Reject any points already in the model */
364:     reject = 0;
365:     for (j=0;j<mfqP->n+1;j++) {
366:       if (point == mfqP->model_indices[j]) {
367:         reject = 1;
368:         break;
369:       }
370:     }

372:     /* Reject if norm(d) >c2 */
373:     if (!reject) {
374:       VecCopy(mfqP->Xhist[point],mfqP->workxvec);
375:       VecAXPY(mfqP->workxvec,-1.0,mfqP->Xhist[mfqP->minindex]);
376:       VecNorm(mfqP->workxvec,NORM_2,&normd);
377:       normd /= mfqP->delta;
378:       if (normd > mfqP->c2) {
379:         reject =1;
380:       }
381:     }
382:     if (reject) {
383:       point--;
384:       continue;
385:     }

387:     VecGetArrayRead(mfqP->Xhist[point],&x);
388:     mfqP->M[(mfqP->n+1)*mfqP->nmodelpoints] = 1.0;
389:     for (j=0;j<mfqP->n;j++) {
390:       mfqP->M[j+1+((mfqP->n+1)*mfqP->nmodelpoints)] = (x[j]  - mfqP->xmin[j]) / mfqP->delta;
391:     }
392:     VecRestoreArrayRead(mfqP->Xhist[point],&x);
393:     phi2eval(&mfqP->M[1+(mfqP->n+1)*mfqP->nmodelpoints],mfqP->n,&mfqP->N[mfqP->n*(mfqP->n+1)/2 * (mfqP->nmodelpoints)]);

395:     /* Update QR factorization */
396:     /* Copy M' to Q_tmp */
397:     for (i=0;i<mfqP->n+1;i++) {
398:       for (j=0;j<mfqP->npmax;j++) {
399:         mfqP->Q_tmp[j+mfqP->npmax*i] = mfqP->M[i+(mfqP->n+1)*j];
400:       }
401:     }
402:     blasnp = mfqP->nmodelpoints+1;
403:     /* Q_tmp,R = qr(M') */
404:     blasmaxmn=PetscMax(mfqP->m,mfqP->n+1);
405:     PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&blasnp,&blasnplus1,mfqP->Q_tmp,&blasnpmax,mfqP->tau_tmp,mfqP->mwork,&blasmaxmn,&info));

408:     /* Reject if min(svd(N*Q(:,n+2:np+1)) <= theta2 */
409:     /* L = N*Qtmp */
410:     blasint2 = mfqP->n * (mfqP->n+1) / 2;
411:     /* Copy N to L_tmp */
412:     for (i=0;i<mfqP->n*(mfqP->n+1)/2 * mfqP->npmax;i++) {
413:       mfqP->L_tmp[i]= mfqP->N[i];
414:     }
415:     /* Copy L_save to L_tmp */

417:     /* L_tmp = N*Qtmp' */
418:     PetscStackCallBLAS("LAPACKormqr",LAPACKormqr_("R","N",&blasint2,&blasnp,&blasnplus1,mfqP->Q_tmp,&blasnpmax,mfqP->tau_tmp,mfqP->L_tmp,&blasint2,mfqP->npmaxwork,&blasnmax,&info));

421:     /* Copy L_tmp to L_save */
422:     for (i=0;i<mfqP->npmax * mfqP->n*(mfqP->n+1)/2;i++) {
423:       mfqP->L_save[i] = mfqP->L_tmp[i];
424:     }

426:     /* Get svd for L_tmp(:,n+2:np+1) (L_tmp is modified in process) */
427:     blasint = mfqP->nmodelpoints - mfqP->n;
428:     PetscFPTrapPush(PETSC_FP_TRAP_OFF);
429:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&blasint2,&blasint,&mfqP->L_tmp[(mfqP->n+1)*blasint2],&blasint2,mfqP->beta,mfqP->work,&blasn,mfqP->work,&blasn,mfqP->npmaxwork,&blasnmax,&info));
430:     PetscFPTrapPop();

433:     if (mfqP->beta[PetscMin(blasint,blasint2)-1] > mfqP->theta2) {
434:       /* accept point */
435:       mfqP->model_indices[mfqP->nmodelpoints] = point;
436:       /* Copy Q_tmp to Q */
437:       for (i=0;i<mfqP->npmax* mfqP->npmax;i++) {
438:         mfqP->Q[i] = mfqP->Q_tmp[i];
439:       }
440:       for (i=0;i<mfqP->npmax;i++) {
441:         mfqP->tau[i] = mfqP->tau_tmp[i];
442:       }
443:       mfqP->nmodelpoints++;
444:       blasnp = mfqP->nmodelpoints;

446:       /* Copy L_save to L */
447:       for (i=0;i<mfqP->npmax * mfqP->n*(mfqP->n+1)/2;i++) {
448:         mfqP->L[i] = mfqP->L_save[i];
449:       }
450:     }
451:     point--;
452:   }

454:   blasnp = mfqP->nmodelpoints;
455:   /* Copy Q(:,n+2:np) to Z */
456:   /* First set Q_tmp to I */
457:   for (i=0;i<mfqP->npmax*mfqP->npmax;i++) {
458:     mfqP->Q_tmp[i] = 0.0;
459:   }
460:   for (i=0;i<mfqP->npmax;i++) {
461:     mfqP->Q_tmp[i + mfqP->npmax*i] = 1.0;
462:   }

464:   /* Q_tmp = I * Q */
465:   PetscStackCallBLAS("LAPACKormqr",LAPACKormqr_("R","N",&blasnp,&blasnp,&blasnplus1,mfqP->Q,&blasnpmax,mfqP->tau,mfqP->Q_tmp,&blasnpmax,mfqP->npmaxwork,&blasnmax,&info));

468:   /* Copy Q_tmp(:,n+2:np) to Z) */
469:   offset = mfqP->npmax * (mfqP->n+1);
470:   for (i=offset;i<mfqP->npmax*mfqP->npmax;i++) {
471:     mfqP->Z[i-offset] = mfqP->Q_tmp[i];
472:   }

474:   if (mfqP->nmodelpoints == mfqP->n + 1) {
475:     /* Set L to I_{n+1} */
476:     for (i=0;i<mfqP->npmax * mfqP->n*(mfqP->n+1)/2;i++) {
477:       mfqP->L[i] = 0.0;
478:     }
479:     for (i=0;i<mfqP->n;i++) {
480:       mfqP->L[(mfqP->n*(mfqP->n+1)/2)*i + i] = 1.0;
481:     }
482:   }
483:   return 0;
484: }

486: /* Only call from modelimprove, addpoint() needs ->Q_tmp and ->work to be set */
487: static PetscErrorCode addpoint(Tao tao, TAO_POUNDERS *mfqP, PetscInt index)
488: {
489:   /* Create new vector in history: X[newidx] = X[mfqP->index] + delta*X[index]*/
490:   VecDuplicate(mfqP->Xhist[0],&mfqP->Xhist[mfqP->nHist]);
491:   VecSetValues(mfqP->Xhist[mfqP->nHist],mfqP->n,mfqP->indices,&mfqP->Q_tmp[index*mfqP->npmax],INSERT_VALUES);
492:   VecAssemblyBegin(mfqP->Xhist[mfqP->nHist]);
493:   VecAssemblyEnd(mfqP->Xhist[mfqP->nHist]);
494:   VecAYPX(mfqP->Xhist[mfqP->nHist],mfqP->delta,mfqP->Xhist[mfqP->minindex]);

496:   /* Project into feasible region */
497:   if (tao->XU && tao->XL) {
498:     VecMedian(mfqP->Xhist[mfqP->nHist], tao->XL, tao->XU, mfqP->Xhist[mfqP->nHist]);
499:   }

501:   /* Compute value of new vector */
502:   VecDuplicate(mfqP->Fhist[0],&mfqP->Fhist[mfqP->nHist]);
503:   CHKMEMQ;
504:   pounders_feval(tao,mfqP->Xhist[mfqP->nHist],mfqP->Fhist[mfqP->nHist],&mfqP->Fres[mfqP->nHist]);

506:   /* Add new vector to model */
507:   mfqP->model_indices[mfqP->nmodelpoints] = mfqP->nHist;
508:   mfqP->nmodelpoints++;
509:   mfqP->nHist++;
510:   return 0;
511: }

513: static PetscErrorCode modelimprove(Tao tao, TAO_POUNDERS *mfqP, PetscInt addallpoints)
514: {
515:   /* modeld = Q(:,np+1:n)' */
516:   PetscInt       i,j,minindex=0;
517:   PetscReal      dp,half=0.5,one=1.0,minvalue=PETSC_INFINITY;
518:   PetscBLASInt   blasn=mfqP->n,  blasnpmax = mfqP->npmax, blask,info;
519:   PetscBLASInt   blas1=1,blasnmax = mfqP->nmax;

521:   blask = mfqP->nmodelpoints;
522:   /* Qtmp = I(n x n) */
523:   for (i=0;i<mfqP->n;i++) {
524:     for (j=0;j<mfqP->n;j++) {
525:       mfqP->Q_tmp[i + mfqP->npmax*j] = 0.0;
526:     }
527:   }
528:   for (j=0;j<mfqP->n;j++) {
529:     mfqP->Q_tmp[j + mfqP->npmax*j] = 1.0;
530:   }

532:   /* Qtmp = Q * I */
533:   PetscStackCallBLAS("LAPACKormqr",LAPACKormqr_("R","N",&blasn,&blasn,&blask,mfqP->Q,&blasnpmax,mfqP->tau, mfqP->Q_tmp, &blasnpmax, mfqP->npmaxwork,&blasnmax, &info));

535:   for (i=mfqP->nmodelpoints;i<mfqP->n;i++) {
536:     PetscStackCallBLAS("BLASdot",dp = BLASdot_(&blasn,&mfqP->Q_tmp[i*mfqP->npmax],&blas1,mfqP->Gres,&blas1));
537:     if (dp>0.0) { /* Model says use the other direction! */
538:       for (j=0;j<mfqP->n;j++) {
539:         mfqP->Q_tmp[i*mfqP->npmax+j] *= -1;
540:       }
541:     }
542:     /* mfqP->work[i] = Cres+Modeld(i,:)*(Gres+.5*Hres*Modeld(i,:)') */
543:     for (j=0;j<mfqP->n;j++) {
544:       mfqP->work2[j] = mfqP->Gres[j];
545:     }
546:     PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&blasn,&blasn,&half,mfqP->Hres,&blasn,&mfqP->Q_tmp[i*mfqP->npmax], &blas1, &one, mfqP->work2,&blas1));
547:     PetscStackCallBLAS("BLASdot",mfqP->work[i] = BLASdot_(&blasn,&mfqP->Q_tmp[i*mfqP->npmax],&blas1,mfqP->work2,&blas1));
548:     if (i==mfqP->nmodelpoints || mfqP->work[i] < minvalue) {
549:       minindex=i;
550:       minvalue = mfqP->work[i];
551:     }
552:     if (addallpoints != 0) {
553:       addpoint(tao,mfqP,i);
554:     }
555:   }
556:   if (!addallpoints) {
557:     addpoint(tao,mfqP,minindex);
558:   }
559:   return 0;
560: }

562: static PetscErrorCode affpoints(TAO_POUNDERS *mfqP, PetscReal *xmin,PetscReal c)
563: {
564:   PetscInt        i,j;
565:   PetscBLASInt    blasm=mfqP->m,blasj,blask,blasn=mfqP->n,ione=1,info;
566:   PetscBLASInt    blasnpmax = mfqP->npmax,blasmaxmn;
567:   PetscReal       proj,normd;
568:   const PetscReal *x;

570:   for (i=mfqP->nHist-1;i>=0;i--) {
571:     VecGetArrayRead(mfqP->Xhist[i],&x);
572:     for (j=0;j<mfqP->n;j++) {
573:       mfqP->work[j] = (x[j] - xmin[j])/mfqP->delta;
574:     }
575:     VecRestoreArrayRead(mfqP->Xhist[i],&x);
576:     PetscStackCallBLAS("BLAScopy",BLAScopy_(&blasn,mfqP->work,&ione,mfqP->work2,&ione));
577:     PetscStackCallBLAS("BLASnrm2",normd = BLASnrm2_(&blasn,mfqP->work,&ione));
578:     if (normd <= c) {
579:       blasj=PetscMax((mfqP->n - mfqP->nmodelpoints),0);
580:       if (!mfqP->q_is_I) {
581:         /* project D onto null */
582:         blask=(mfqP->nmodelpoints);
583:         PetscStackCallBLAS("LAPACKormqr",LAPACKormqr_("R","N",&ione,&blasn,&blask,mfqP->Q,&blasnpmax,mfqP->tau,mfqP->work2,&ione,mfqP->mwork,&blasm,&info));
585:       }
586:       PetscStackCallBLAS("BLASnrm2",proj = BLASnrm2_(&blasj,&mfqP->work2[mfqP->nmodelpoints],&ione));

588:       if (proj >= mfqP->theta1) { /* add this index to model */
589:         mfqP->model_indices[mfqP->nmodelpoints]=i;
590:         mfqP->nmodelpoints++;
591:         PetscStackCallBLAS("BLAScopy",BLAScopy_(&blasn,mfqP->work,&ione,&mfqP->Q_tmp[mfqP->npmax*(mfqP->nmodelpoints-1)],&ione));
592:         blask=mfqP->npmax*(mfqP->nmodelpoints);
593:         PetscStackCallBLAS("BLAScopy",BLAScopy_(&blask,mfqP->Q_tmp,&ione,mfqP->Q,&ione));
594:         blask = mfqP->nmodelpoints;
595:         blasmaxmn = PetscMax(mfqP->m,mfqP->n);
596:         PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&blasn,&blask,mfqP->Q,&blasnpmax,mfqP->tau,mfqP->mwork,&blasmaxmn,&info));
598:         mfqP->q_is_I = 0;
599:       }
600:       if (mfqP->nmodelpoints == mfqP->n)  {
601:         break;
602:       }
603:     }
604:   }

606:   return 0;
607: }

609: static PetscErrorCode TaoSolve_POUNDERS(Tao tao)
610: {
611:   TAO_POUNDERS       *mfqP = (TAO_POUNDERS *)tao->data;
612:   PetscInt           i,ii,j,k,l;
613:   PetscReal          step=1.0;
614:   PetscInt           low,high;
615:   PetscReal          minnorm;
616:   PetscReal          *x,*f;
617:   const PetscReal    *xmint,*fmin;
618:   PetscReal          deltaold;
619:   PetscReal          gnorm;
620:   PetscBLASInt       info,ione=1,iblas;
621:   PetscBool          valid,same;
622:   PetscReal          mdec, rho, normxsp;
623:   PetscReal          one=1.0,zero=0.0,ratio;
624:   PetscBLASInt       blasm,blasn,blasncopy,blasnpmax;
625:   static PetscBool   set = PETSC_FALSE;

627:   /* n = # of parameters
628:      m = dimension (components) of function  */
629:   PetscCall(PetscCitationsRegister("@article{UNEDF0,\n"
630:                                  "title = {Nuclear energy density optimization},\n"
631:                                 "author = {Kortelainen, M.  and Lesinski, T.  and Mor\'e, J.  and Nazarewicz, W.\n"
632:                                 "          and Sarich, J.  and Schunck, N.  and Stoitsov, M. V. and Wild, S. },\n"
633:                                 "journal = {Phys. Rev. C},\n"
634:                                 "volume = {82},\n"
635:                                 "number = {2},\n"
636:                                 "pages = {024313},\n"
637:                                 "numpages = {18},\n"
638:                                 "year = {2010},\n"
639:                                 "month = {Aug},\n"
640:                                  "doi = {10.1103/PhysRevC.82.024313}\n}\n",&set));
641:   tao->niter=0;
642:   if (tao->XL && tao->XU) {
643:     /* Check x0 <= XU */
644:     PetscReal val;

646:     VecCopy(tao->solution,mfqP->Xhist[0]);
647:     VecAXPY(mfqP->Xhist[0],-1.0,tao->XU);
648:     VecMax(mfqP->Xhist[0],NULL,&val);

651:     /* Check x0 >= xl */
652:     VecCopy(tao->XL,mfqP->Xhist[0]);
653:     VecAXPY(mfqP->Xhist[0],-1.0,tao->solution);
654:     VecMax(mfqP->Xhist[0],NULL,&val);

657:     /* Check x0 + delta < XU  -- should be able to get around this eventually */

659:     VecSet(mfqP->Xhist[0],mfqP->delta);
660:     VecAXPY(mfqP->Xhist[0],1.0,tao->solution);
661:     VecAXPY(mfqP->Xhist[0],-1.0,tao->XU);
662:     VecMax(mfqP->Xhist[0],NULL,&val);
664:   }

666:   blasm = mfqP->m; blasn=mfqP->n; blasnpmax = mfqP->npmax;
667:   for (i=0;i<mfqP->n*mfqP->n*mfqP->m;++i) mfqP->H[i]=0;

669:   VecCopy(tao->solution,mfqP->Xhist[0]);

671:   /* This provides enough information to approximate the gradient of the objective */
672:   /* using a forward difference scheme. */

674:   PetscInfo(tao,"Initialize simplex; delta = %10.9e\n",(double)mfqP->delta);
675:   pounders_feval(tao,mfqP->Xhist[0],mfqP->Fhist[0],&mfqP->Fres[0]);
676:   mfqP->minindex = 0;
677:   minnorm = mfqP->Fres[0];

679:   VecGetOwnershipRange(mfqP->Xhist[0],&low,&high);
680:   for (i=1;i<mfqP->n+1;++i) {
681:     VecCopy(mfqP->Xhist[0],mfqP->Xhist[i]);

683:     if (i-1 >= low && i-1 < high) {
684:       VecGetArray(mfqP->Xhist[i],&x);
685:       x[i-1-low] += mfqP->delta;
686:       VecRestoreArray(mfqP->Xhist[i],&x);
687:     }
688:     CHKMEMQ;
689:     pounders_feval(tao,mfqP->Xhist[i],mfqP->Fhist[i],&mfqP->Fres[i]);
690:     if (mfqP->Fres[i] < minnorm) {
691:       mfqP->minindex = i;
692:       minnorm = mfqP->Fres[i];
693:     }
694:   }
695:   VecCopy(mfqP->Xhist[mfqP->minindex],tao->solution);
696:   VecCopy(mfqP->Fhist[mfqP->minindex],tao->ls_res);
697:   PetscInfo(tao,"Finalize simplex; minnorm = %10.9e\n",(double)minnorm);

699:   /* Gather mpi vecs to one big local vec */

701:   /* Begin serial code */

703:   /* Disp[i] = Xi-xmin, i=1,..,mfqP->minindex-1,mfqP->minindex+1,..,n */
704:   /* Fdiff[i] = (Fi-Fmin)', i=1,..,mfqP->minindex-1,mfqP->minindex+1,..,n */
705:   /* (Column oriented for blas calls) */
706:   ii=0;

708:   PetscInfo(tao,"Build matrix: %D\n",(PetscInt)mfqP->size);
709:   if (1 == mfqP->size) {
710:     VecGetArrayRead(mfqP->Xhist[mfqP->minindex],&xmint);
711:     for (i=0;i<mfqP->n;i++) mfqP->xmin[i] = xmint[i];
712:     VecRestoreArrayRead(mfqP->Xhist[mfqP->minindex],&xmint);
713:     VecGetArrayRead(mfqP->Fhist[mfqP->minindex],&fmin);
714:     for (i=0;i<mfqP->n+1;i++) {
715:       if (i == mfqP->minindex) continue;

717:       VecGetArray(mfqP->Xhist[i],&x);
718:       for (j=0;j<mfqP->n;j++) {
719:         mfqP->Disp[ii+mfqP->npmax*j] = (x[j] - mfqP->xmin[j])/mfqP->delta;
720:       }
721:       VecRestoreArray(mfqP->Xhist[i],&x);

723:       VecGetArray(mfqP->Fhist[i],&f);
724:       for (j=0;j<mfqP->m;j++) {
725:         mfqP->Fdiff[ii+mfqP->n*j] = f[j] - fmin[j];
726:       }
727:       VecRestoreArray(mfqP->Fhist[i],&f);

729:       mfqP->model_indices[ii++] = i;
730:     }
731:     for (j=0;j<mfqP->m;j++) {
732:       mfqP->C[j] = fmin[j];
733:     }
734:     VecRestoreArrayRead(mfqP->Fhist[mfqP->minindex],&fmin);
735:   } else {
736:     VecSet(mfqP->localxmin,0);
737:     VecScatterBegin(mfqP->scatterx,mfqP->Xhist[mfqP->minindex],mfqP->localxmin,INSERT_VALUES,SCATTER_FORWARD);
738:     VecScatterEnd(mfqP->scatterx,mfqP->Xhist[mfqP->minindex],mfqP->localxmin,INSERT_VALUES,SCATTER_FORWARD);

740:     VecGetArrayRead(mfqP->localxmin,&xmint);
741:     for (i=0;i<mfqP->n;i++) mfqP->xmin[i] = xmint[i];
742:     VecRestoreArrayRead(mfqP->localxmin,&xmint);

744:     VecScatterBegin(mfqP->scatterf,mfqP->Fhist[mfqP->minindex],mfqP->localfmin,INSERT_VALUES,SCATTER_FORWARD);
745:     VecScatterEnd(mfqP->scatterf,mfqP->Fhist[mfqP->minindex],mfqP->localfmin,INSERT_VALUES,SCATTER_FORWARD);
746:     VecGetArrayRead(mfqP->localfmin,&fmin);
747:     for (i=0;i<mfqP->n+1;i++) {
748:       if (i == mfqP->minindex) continue;

750:       VecScatterBegin(mfqP->scatterx,mfqP->Xhist[ii],mfqP->localx,INSERT_VALUES, SCATTER_FORWARD);
751:       VecScatterEnd(mfqP->scatterx,mfqP->Xhist[ii],mfqP->localx,INSERT_VALUES, SCATTER_FORWARD);
752:       VecGetArray(mfqP->localx,&x);
753:       for (j=0;j<mfqP->n;j++) {
754:         mfqP->Disp[ii+mfqP->npmax*j] = (x[j] - mfqP->xmin[j])/mfqP->delta;
755:       }
756:       VecRestoreArray(mfqP->localx,&x);

758:       VecScatterBegin(mfqP->scatterf,mfqP->Fhist[ii],mfqP->localf,INSERT_VALUES, SCATTER_FORWARD);
759:       VecScatterEnd(mfqP->scatterf,mfqP->Fhist[ii],mfqP->localf,INSERT_VALUES, SCATTER_FORWARD);
760:       VecGetArray(mfqP->localf,&f);
761:       for (j=0;j<mfqP->m;j++) {
762:         mfqP->Fdiff[ii+mfqP->n*j] = f[j] - fmin[j];
763:       }
764:       VecRestoreArray(mfqP->localf,&f);

766:       mfqP->model_indices[ii++] = i;
767:     }
768:     for (j=0;j<mfqP->m;j++) {
769:       mfqP->C[j] = fmin[j];
770:     }
771:     VecRestoreArrayRead(mfqP->localfmin,&fmin);
772:   }

774:   /* Determine the initial quadratic models */
775:   /* G = D(ModelIn,:) \ (F(ModelIn,1:m)-repmat(F(xkin,1:m),n,1)); */
776:   /* D (nxn) Fdiff (nxm)  => G (nxm) */
777:   blasncopy = blasn;
778:   PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&blasn,&blasm,mfqP->Disp,&blasnpmax,mfqP->iwork,mfqP->Fdiff,&blasncopy,&info));
779:   PetscInfo(tao,"Linear solve return: %D\n",(PetscInt)info);

781:   pounders_update_res(tao);

783:   valid = PETSC_TRUE;

785:   VecSetValues(tao->gradient,mfqP->n,mfqP->indices,mfqP->Gres,INSERT_VALUES);
786:   VecAssemblyBegin(tao->gradient);
787:   VecAssemblyEnd(tao->gradient);
788:   VecNorm(tao->gradient,NORM_2,&gnorm);
789:   gnorm *= mfqP->delta;
790:   VecCopy(mfqP->Xhist[mfqP->minindex],tao->solution);

792:   tao->reason = TAO_CONTINUE_ITERATING;
793:   TaoLogConvergenceHistory(tao,minnorm,gnorm,0.0,tao->ksp_its);
794:   TaoMonitor(tao,tao->niter,minnorm,gnorm,0.0,step);
795:   (*tao->ops->convergencetest)(tao,tao->cnvP);

797:   mfqP->nHist = mfqP->n+1;
798:   mfqP->nmodelpoints = mfqP->n+1;
799:   PetscInfo(tao,"Initial gradient: %20.19e\n",(double)gnorm);

801:   while (tao->reason == TAO_CONTINUE_ITERATING) {
802:     PetscReal gnm = 1e-4;
803:     /* Call general purpose update function */
804:     if (tao->ops->update) {
805:       (*tao->ops->update)(tao, tao->niter, tao->user_update);
806:     }
807:     tao->niter++;
808:     /* Solve the subproblem min{Q(s): ||s|| <= 1.0} */
809:     gqtwrap(tao,&gnm,&mdec);
810:     /* Evaluate the function at the new point */

812:     for (i=0;i<mfqP->n;i++) {
813:         mfqP->work[i] = mfqP->Xsubproblem[i]*mfqP->delta + mfqP->xmin[i];
814:     }
815:     VecDuplicate(tao->solution,&mfqP->Xhist[mfqP->nHist]);
816:     VecDuplicate(tao->ls_res,&mfqP->Fhist[mfqP->nHist]);
817:     VecSetValues(mfqP->Xhist[mfqP->nHist],mfqP->n,mfqP->indices,mfqP->work,INSERT_VALUES);
818:     VecAssemblyBegin(mfqP->Xhist[mfqP->nHist]);
819:     VecAssemblyEnd(mfqP->Xhist[mfqP->nHist]);

821:     pounders_feval(tao,mfqP->Xhist[mfqP->nHist],mfqP->Fhist[mfqP->nHist],&mfqP->Fres[mfqP->nHist]);

823:     rho = (mfqP->Fres[mfqP->minindex] - mfqP->Fres[mfqP->nHist]) / mdec;
824:     mfqP->nHist++;

826:     /* Update the center */
827:     if ((rho >= mfqP->eta1) || (rho > mfqP->eta0 && valid==PETSC_TRUE)) {
828:       /* Update model to reflect new base point */
829:       for (i=0;i<mfqP->n;i++) {
830:         mfqP->work[i] = (mfqP->work[i] - mfqP->xmin[i])/mfqP->delta;
831:       }
832:       for (j=0;j<mfqP->m;j++) {
833:         /* C(j) = C(j) + work*G(:,j) + .5*work*H(:,:,j)*work';
834:          G(:,j) = G(:,j) + H(:,:,j)*work' */
835:         for (k=0;k<mfqP->n;k++) {
836:           mfqP->work2[k]=0.0;
837:           for (l=0;l<mfqP->n;l++) {
838:             mfqP->work2[k]+=mfqP->H[j + mfqP->m*(k + l*mfqP->n)]*mfqP->work[l];
839:           }
840:         }
841:         for (i=0;i<mfqP->n;i++) {
842:           mfqP->C[j]+=mfqP->work[i]*(mfqP->Fdiff[i + mfqP->n* j] + 0.5*mfqP->work2[i]);
843:           mfqP->Fdiff[i+mfqP->n*j] +=mfqP-> work2[i];
844:         }
845:       }
846:       /* Cres += work*Gres + .5*work*Hres*work';
847:        Gres += Hres*work'; */

849:       PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&blasn,&blasn,&one,mfqP->Hres,&blasn,mfqP->work,&ione,&zero,mfqP->work2,&ione));
850:       for (i=0;i<mfqP->n;i++) {
851:         mfqP->Gres[i] += mfqP->work2[i];
852:       }
853:       mfqP->minindex = mfqP->nHist-1;
854:       minnorm = mfqP->Fres[mfqP->minindex];
855:       VecCopy(mfqP->Fhist[mfqP->minindex],tao->ls_res);
856:       /* Change current center */
857:       VecGetArrayRead(mfqP->Xhist[mfqP->minindex],&xmint);
858:       for (i=0;i<mfqP->n;i++) {
859:         mfqP->xmin[i] = xmint[i];
860:       }
861:       VecRestoreArrayRead(mfqP->Xhist[mfqP->minindex],&xmint);
862:     }

864:     /* Evaluate at a model-improving point if necessary */
865:     if (valid == PETSC_FALSE) {
866:       mfqP->q_is_I = 1;
867:       mfqP->nmodelpoints = 0;
868:       affpoints(mfqP,mfqP->xmin,mfqP->c1);
869:       if (mfqP->nmodelpoints < mfqP->n) {
870:         PetscInfo(tao,"Model not valid -- model-improving\n");
871:         modelimprove(tao,mfqP,1);
872:       }
873:     }

875:     /* Update the trust region radius */
876:     deltaold = mfqP->delta;
877:     normxsp = 0;
878:     for (i=0;i<mfqP->n;i++) {
879:       normxsp += mfqP->Xsubproblem[i]*mfqP->Xsubproblem[i];
880:     }
881:     normxsp = PetscSqrtReal(normxsp);
882:     if (rho >= mfqP->eta1 && normxsp > 0.5*mfqP->delta) {
883:       mfqP->delta = PetscMin(mfqP->delta*mfqP->gamma1,mfqP->deltamax);
884:     } else if (valid == PETSC_TRUE) {
885:       mfqP->delta = PetscMax(mfqP->delta*mfqP->gamma0,mfqP->deltamin);
886:     }

888:     /* Compute the next interpolation set */
889:     mfqP->q_is_I = 1;
890:     mfqP->nmodelpoints=0;
891:     PetscInfo(tao,"Affine Points: xmin = %20.19e, c1 = %20.19e\n",(double)*mfqP->xmin,(double)mfqP->c1);
892:     affpoints(mfqP,mfqP->xmin,mfqP->c1);
893:     if (mfqP->nmodelpoints == mfqP->n) {
894:       valid = PETSC_TRUE;
895:     } else {
896:       valid = PETSC_FALSE;
897:       PetscInfo(tao,"Affine Points: xmin = %20.19e, c2 = %20.19e\n",(double)*mfqP->xmin,(double)mfqP->c2);
898:       affpoints(mfqP,mfqP->xmin,mfqP->c2);
899:       if (mfqP->n > mfqP->nmodelpoints) {
900:         PetscInfo(tao,"Model not valid -- adding geometry points\n");
901:         modelimprove(tao,mfqP,mfqP->n - mfqP->nmodelpoints);
902:       }
903:     }
904:     for (i=mfqP->nmodelpoints;i>0;i--) {
905:       mfqP->model_indices[i] = mfqP->model_indices[i-1];
906:     }
907:     mfqP->nmodelpoints++;
908:     mfqP->model_indices[0] = mfqP->minindex;
909:     morepoints(mfqP);
910:     for (i=0;i<mfqP->nmodelpoints;i++) {
911:       VecGetArray(mfqP->Xhist[mfqP->model_indices[i]],&x);
912:       for (j=0;j<mfqP->n;j++) {
913:         mfqP->Disp[i + mfqP->npmax*j] = (x[j]  - mfqP->xmin[j]) / deltaold;
914:       }
915:       VecRestoreArray(mfqP->Xhist[mfqP->model_indices[i]],&x);
916:       VecGetArray(mfqP->Fhist[mfqP->model_indices[i]],&f);
917:       for (j=0;j<mfqP->m;j++) {
918:         for (k=0;k<mfqP->n;k++)  {
919:           mfqP->work[k]=0.0;
920:           for (l=0;l<mfqP->n;l++) {
921:             mfqP->work[k] += mfqP->H[j + mfqP->m*(k + mfqP->n*l)] * mfqP->Disp[i + mfqP->npmax*l];
922:           }
923:         }
924:         PetscStackCallBLAS("BLASdot",mfqP->RES[j*mfqP->npmax + i] = -mfqP->C[j] - BLASdot_(&blasn,&mfqP->Fdiff[j*mfqP->n],&ione,&mfqP->Disp[i],&blasnpmax) - 0.5*BLASdot_(&blasn,mfqP->work,&ione,&mfqP->Disp[i],&blasnpmax) + f[j]);
925:       }
926:       VecRestoreArray(mfqP->Fhist[mfqP->model_indices[i]],&f);
927:     }

929:     /* Update the quadratic model */
930:     PetscInfo(tao,"Get Quad, size: %D, points: %D\n",mfqP->n,mfqP->nmodelpoints);
931:     getquadpounders(mfqP);
932:     VecGetArrayRead(mfqP->Fhist[mfqP->minindex],&fmin);
933:     PetscStackCallBLAS("BLAScopy",BLAScopy_(&blasm,fmin,&ione,mfqP->C,&ione));
934:     /* G = G*(delta/deltaold) + Gdel */
935:     ratio = mfqP->delta/deltaold;
936:     iblas = blasm*blasn;
937:     PetscStackCallBLAS("BLASscal",BLASscal_(&iblas,&ratio,mfqP->Fdiff,&ione));
938:     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&iblas,&one,mfqP->Gdel,&ione,mfqP->Fdiff,&ione));
939:     /* H = H*(delta/deltaold)^2 + Hdel */
940:     iblas = blasm*blasn*blasn;
941:     ratio *= ratio;
942:     PetscStackCallBLAS("BLASscal",BLASscal_(&iblas,&ratio,mfqP->H,&ione));
943:     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&iblas,&one,mfqP->Hdel,&ione,mfqP->H,&ione));

945:     /* Get residuals */
946:     pounders_update_res(tao);

948:     /* Export solution and gradient residual to TAO */
949:     VecCopy(mfqP->Xhist[mfqP->minindex],tao->solution);
950:     VecSetValues(tao->gradient,mfqP->n,mfqP->indices,mfqP->Gres,INSERT_VALUES);
951:     VecAssemblyBegin(tao->gradient);
952:     VecAssemblyEnd(tao->gradient);
953:     VecNorm(tao->gradient,NORM_2,&gnorm);
954:     gnorm *= mfqP->delta;
955:     /*  final criticality test */
956:     TaoLogConvergenceHistory(tao,minnorm,gnorm,0.0,tao->ksp_its);
957:     TaoMonitor(tao,tao->niter,minnorm,gnorm,0.0,step);
958:     (*tao->ops->convergencetest)(tao,tao->cnvP);
959:     /* test for repeated model */
960:     if (mfqP->nmodelpoints==mfqP->last_nmodelpoints) {
961:       same = PETSC_TRUE;
962:     } else {
963:       same = PETSC_FALSE;
964:     }
965:     for (i=0;i<mfqP->nmodelpoints;i++) {
966:       if (same) {
967:         if (mfqP->model_indices[i] == mfqP->last_model_indices[i]) {
968:           same = PETSC_TRUE;
969:         } else {
970:           same = PETSC_FALSE;
971:         }
972:       }
973:       mfqP->last_model_indices[i] = mfqP->model_indices[i];
974:     }
975:     mfqP->last_nmodelpoints = mfqP->nmodelpoints;
976:     if (same && mfqP->delta == deltaold) {
977:       PetscInfo(tao,"Identical model used in successive iterations\n");
978:       tao->reason = TAO_CONVERGED_STEPTOL;
979:     }
980:   }
981:   return 0;
982: }

984: static PetscErrorCode TaoSetUp_POUNDERS(Tao tao)
985: {
986:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;
987:   PetscInt       i,j;
988:   IS             isfloc,isfglob,isxloc,isxglob;

990:   if (!tao->gradient) VecDuplicate(tao->solution,&tao->gradient);
991:   if (!tao->stepdirection) VecDuplicate(tao->solution,&tao->stepdirection);
992:   VecGetSize(tao->solution,&mfqP->n);
993:   VecGetSize(tao->ls_res,&mfqP->m);
994:   mfqP->c1 = PetscSqrtReal((PetscReal)mfqP->n);
995:   if (mfqP->npmax == PETSC_DEFAULT) {
996:     mfqP->npmax = 2*mfqP->n + 1;
997:   }
998:   mfqP->npmax = PetscMin((mfqP->n+1)*(mfqP->n+2)/2,mfqP->npmax);
999:   mfqP->npmax = PetscMax(mfqP->npmax, mfqP->n+2);

1001:   PetscMalloc1(tao->max_funcs+100,&mfqP->Xhist);
1002:   PetscMalloc1(tao->max_funcs+100,&mfqP->Fhist);
1003:   for (i=0;i<mfqP->n+1;i++) {
1004:     VecDuplicate(tao->solution,&mfqP->Xhist[i]);
1005:     VecDuplicate(tao->ls_res,&mfqP->Fhist[i]);
1006:   }
1007:   VecDuplicate(tao->solution,&mfqP->workxvec);
1008:   VecDuplicate(tao->ls_res,&mfqP->workfvec);
1009:   mfqP->nHist = 0;

1011:   PetscMalloc1(tao->max_funcs+100,&mfqP->Fres);
1012:   PetscMalloc1(mfqP->npmax*mfqP->m,&mfqP->RES);
1013:   PetscMalloc1(mfqP->n,&mfqP->work);
1014:   PetscMalloc1(mfqP->n,&mfqP->work2);
1015:   PetscMalloc1(mfqP->n,&mfqP->work3);
1016:   PetscMalloc1(PetscMax(mfqP->m,mfqP->n+1),&mfqP->mwork);
1017:   PetscMalloc1(mfqP->npmax - mfqP->n - 1,&mfqP->omega);
1018:   PetscMalloc1(mfqP->n * (mfqP->n+1) / 2,&mfqP->beta);
1019:   PetscMalloc1(mfqP->n + 1 ,&mfqP->alpha);

1021:   PetscMalloc1(mfqP->n*mfqP->n*mfqP->m,&mfqP->H);
1022:   PetscMalloc1(mfqP->npmax*mfqP->npmax,&mfqP->Q);
1023:   PetscMalloc1(mfqP->npmax*mfqP->npmax,&mfqP->Q_tmp);
1024:   PetscMalloc1(mfqP->n*(mfqP->n+1)/2*(mfqP->npmax),&mfqP->L);
1025:   PetscMalloc1(mfqP->n*(mfqP->n+1)/2*(mfqP->npmax),&mfqP->L_tmp);
1026:   PetscMalloc1(mfqP->n*(mfqP->n+1)/2*(mfqP->npmax),&mfqP->L_save);
1027:   PetscMalloc1(mfqP->n*(mfqP->n+1)/2*(mfqP->npmax),&mfqP->N);
1028:   PetscMalloc1(mfqP->npmax * (mfqP->n+1) ,&mfqP->M);
1029:   PetscMalloc1(mfqP->npmax * (mfqP->npmax - mfqP->n - 1) , &mfqP->Z);
1030:   PetscMalloc1(mfqP->npmax,&mfqP->tau);
1031:   PetscMalloc1(mfqP->npmax,&mfqP->tau_tmp);
1032:   mfqP->nmax = PetscMax(5*mfqP->npmax,mfqP->n*(mfqP->n+1)/2);
1033:   PetscMalloc1(mfqP->nmax,&mfqP->npmaxwork);
1034:   PetscMalloc1(mfqP->nmax,&mfqP->npmaxiwork);
1035:   PetscMalloc1(mfqP->n,&mfqP->xmin);
1036:   PetscMalloc1(mfqP->m,&mfqP->C);
1037:   PetscMalloc1(mfqP->m*mfqP->n,&mfqP->Fdiff);
1038:   PetscMalloc1(mfqP->npmax*mfqP->n,&mfqP->Disp);
1039:   PetscMalloc1(mfqP->n,&mfqP->Gres);
1040:   PetscMalloc1(mfqP->n*mfqP->n,&mfqP->Hres);
1041:   PetscMalloc1(mfqP->n*mfqP->n,&mfqP->Gpoints);
1042:   PetscMalloc1(mfqP->npmax,&mfqP->model_indices);
1043:   PetscMalloc1(mfqP->npmax,&mfqP->last_model_indices);
1044:   PetscMalloc1(mfqP->n,&mfqP->Xsubproblem);
1045:   PetscMalloc1(mfqP->m*mfqP->n,&mfqP->Gdel);
1046:   PetscMalloc1(mfqP->n*mfqP->n*mfqP->m, &mfqP->Hdel);
1047:   PetscMalloc1(PetscMax(mfqP->m,mfqP->n),&mfqP->indices);
1048:   PetscMalloc1(mfqP->n,&mfqP->iwork);
1049:   PetscMalloc1(mfqP->m*mfqP->m,&mfqP->w);
1050:   for (i=0;i<mfqP->m;i++) {
1051:     for (j=0;j<mfqP->m;j++) {
1052:       if (i==j) {
1053:         mfqP->w[i+mfqP->m*j]=1.0;
1054:       } else {
1055:         mfqP->w[i+mfqP->m*j]=0.0;
1056:       }
1057:     }
1058:   }
1059:   for (i=0;i<PetscMax(mfqP->m,mfqP->n);i++) {
1060:     mfqP->indices[i] = i;
1061:   }
1062:   MPI_Comm_size(((PetscObject)tao)->comm,&mfqP->size);
1063:   if (mfqP->size > 1) {
1064:     VecCreateSeq(PETSC_COMM_SELF,mfqP->n,&mfqP->localx);
1065:     VecCreateSeq(PETSC_COMM_SELF,mfqP->n,&mfqP->localxmin);
1066:     VecCreateSeq(PETSC_COMM_SELF,mfqP->m,&mfqP->localf);
1067:     VecCreateSeq(PETSC_COMM_SELF,mfqP->m,&mfqP->localfmin);
1068:     ISCreateStride(MPI_COMM_SELF,mfqP->n,0,1,&isxloc);
1069:     ISCreateStride(MPI_COMM_SELF,mfqP->n,0,1,&isxglob);
1070:     ISCreateStride(MPI_COMM_SELF,mfqP->m,0,1,&isfloc);
1071:     ISCreateStride(MPI_COMM_SELF,mfqP->m,0,1,&isfglob);

1073:     VecScatterCreate(tao->solution,isxglob,mfqP->localx,isxloc,&mfqP->scatterx);
1074:     VecScatterCreate(tao->ls_res,isfglob,mfqP->localf,isfloc,&mfqP->scatterf);

1076:     ISDestroy(&isxloc);
1077:     ISDestroy(&isxglob);
1078:     ISDestroy(&isfloc);
1079:     ISDestroy(&isfglob);
1080:   }

1082:   if (!mfqP->usegqt) {
1083:     KSP       ksp;
1084:     PC        pc;
1085:     VecCreateSeqWithArray(PETSC_COMM_SELF,mfqP->n,mfqP->n,mfqP->Xsubproblem,&mfqP->subx);
1086:     VecCreateSeq(PETSC_COMM_SELF,mfqP->n,&mfqP->subxl);
1087:     VecDuplicate(mfqP->subxl,&mfqP->subb);
1088:     VecDuplicate(mfqP->subxl,&mfqP->subxu);
1089:     VecDuplicate(mfqP->subxl,&mfqP->subpdel);
1090:     VecDuplicate(mfqP->subxl,&mfqP->subndel);
1091:     TaoCreate(PETSC_COMM_SELF,&mfqP->subtao);
1092:     PetscObjectIncrementTabLevel((PetscObject)mfqP->subtao, (PetscObject)tao, 1);
1093:     TaoSetType(mfqP->subtao,TAOBNTR);
1094:     TaoSetOptionsPrefix(mfqP->subtao,"pounders_subsolver_");
1095:     TaoSetSolution(mfqP->subtao,mfqP->subx);
1096:     TaoSetObjectiveAndGradient(mfqP->subtao,NULL,pounders_fg,(void*)mfqP);
1097:     TaoSetMaximumIterations(mfqP->subtao,mfqP->gqt_maxits);
1098:     TaoSetFromOptions(mfqP->subtao);
1099:     TaoGetKSP(mfqP->subtao,&ksp);
1100:     if (ksp) {
1101:       KSPGetPC(ksp,&pc);
1102:       PCSetType(pc,PCNONE);
1103:     }
1104:     TaoSetVariableBounds(mfqP->subtao,mfqP->subxl,mfqP->subxu);
1105:     MatCreateSeqDense(PETSC_COMM_SELF,mfqP->n,mfqP->n,mfqP->Hres,&mfqP->subH);
1106:     TaoSetHessian(mfqP->subtao,mfqP->subH,mfqP->subH,pounders_h,(void*)mfqP);
1107:   }
1108:   return 0;
1109: }

1111: static PetscErrorCode TaoDestroy_POUNDERS(Tao tao)
1112: {
1113:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;
1114:   PetscInt       i;

1116:   if (!mfqP->usegqt) {
1117:     TaoDestroy(&mfqP->subtao);
1118:     VecDestroy(&mfqP->subx);
1119:     VecDestroy(&mfqP->subxl);
1120:     VecDestroy(&mfqP->subxu);
1121:     VecDestroy(&mfqP->subb);
1122:     VecDestroy(&mfqP->subpdel);
1123:     VecDestroy(&mfqP->subndel);
1124:     MatDestroy(&mfqP->subH);
1125:   }
1126:   PetscFree(mfqP->Fres);
1127:   PetscFree(mfqP->RES);
1128:   PetscFree(mfqP->work);
1129:   PetscFree(mfqP->work2);
1130:   PetscFree(mfqP->work3);
1131:   PetscFree(mfqP->mwork);
1132:   PetscFree(mfqP->omega);
1133:   PetscFree(mfqP->beta);
1134:   PetscFree(mfqP->alpha);
1135:   PetscFree(mfqP->H);
1136:   PetscFree(mfqP->Q);
1137:   PetscFree(mfqP->Q_tmp);
1138:   PetscFree(mfqP->L);
1139:   PetscFree(mfqP->L_tmp);
1140:   PetscFree(mfqP->L_save);
1141:   PetscFree(mfqP->N);
1142:   PetscFree(mfqP->M);
1143:   PetscFree(mfqP->Z);
1144:   PetscFree(mfqP->tau);
1145:   PetscFree(mfqP->tau_tmp);
1146:   PetscFree(mfqP->npmaxwork);
1147:   PetscFree(mfqP->npmaxiwork);
1148:   PetscFree(mfqP->xmin);
1149:   PetscFree(mfqP->C);
1150:   PetscFree(mfqP->Fdiff);
1151:   PetscFree(mfqP->Disp);
1152:   PetscFree(mfqP->Gres);
1153:   PetscFree(mfqP->Hres);
1154:   PetscFree(mfqP->Gpoints);
1155:   PetscFree(mfqP->model_indices);
1156:   PetscFree(mfqP->last_model_indices);
1157:   PetscFree(mfqP->Xsubproblem);
1158:   PetscFree(mfqP->Gdel);
1159:   PetscFree(mfqP->Hdel);
1160:   PetscFree(mfqP->indices);
1161:   PetscFree(mfqP->iwork);
1162:   PetscFree(mfqP->w);
1163:   for (i=0;i<mfqP->nHist;i++) {
1164:     VecDestroy(&mfqP->Xhist[i]);
1165:     VecDestroy(&mfqP->Fhist[i]);
1166:   }
1167:   VecDestroy(&mfqP->workxvec);
1168:   VecDestroy(&mfqP->workfvec);
1169:   PetscFree(mfqP->Xhist);
1170:   PetscFree(mfqP->Fhist);

1172:   if (mfqP->size > 1) {
1173:     VecDestroy(&mfqP->localx);
1174:     VecDestroy(&mfqP->localxmin);
1175:     VecDestroy(&mfqP->localf);
1176:     VecDestroy(&mfqP->localfmin);
1177:   }
1178:   PetscFree(tao->data);
1179:   return 0;
1180: }

1182: static PetscErrorCode TaoSetFromOptions_POUNDERS(PetscOptionItems *PetscOptionsObject,Tao tao)
1183: {
1184:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;

1186:   PetscOptionsHead(PetscOptionsObject,"POUNDERS method for least-squares optimization");
1187:   PetscOptionsReal("-tao_pounders_delta","initial delta","",mfqP->delta,&mfqP->delta0,NULL);
1188:   mfqP->delta = mfqP->delta0;
1189:   PetscOptionsInt("-tao_pounders_npmax","max number of points in model","",mfqP->npmax,&mfqP->npmax,NULL);
1190:   PetscOptionsBool("-tao_pounders_gqt","use gqt algorithm for subproblem","",mfqP->usegqt,&mfqP->usegqt,NULL);
1191:   PetscOptionsTail();
1192:   return 0;
1193: }

1195: static PetscErrorCode TaoView_POUNDERS(Tao tao, PetscViewer viewer)
1196: {
1197:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS *)tao->data;
1198:   PetscBool      isascii;

1200:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1201:   if (isascii) {
1202:     PetscViewerASCIIPrintf(viewer, "initial delta: %g\n",(double)mfqP->delta0);
1203:     PetscViewerASCIIPrintf(viewer, "final delta: %g\n",(double)mfqP->delta);
1204:     PetscViewerASCIIPrintf(viewer, "model points: %D\n",mfqP->nmodelpoints);
1205:     if (mfqP->usegqt) {
1206:       PetscViewerASCIIPrintf(viewer, "subproblem solver: gqt\n");
1207:     } else {
1208:       TaoView(mfqP->subtao, viewer);
1209:     }
1210:   }
1211:   return 0;
1212: }
1213: /*MC
1214:   TAOPOUNDERS - POUNDERS derivate-free model-based algorithm for nonlinear least squares

1216:   Options Database Keys:
1217: + -tao_pounders_delta - initial step length
1218: . -tao_pounders_npmax - maximum number of points in model
1219: - -tao_pounders_gqt - use gqt algorithm for subproblem instead of TRON

1221:   Level: beginner

1223: M*/

1225: PETSC_EXTERN PetscErrorCode TaoCreate_POUNDERS(Tao tao)
1226: {
1227:   TAO_POUNDERS   *mfqP = (TAO_POUNDERS*)tao->data;

1229:   tao->ops->setup = TaoSetUp_POUNDERS;
1230:   tao->ops->solve = TaoSolve_POUNDERS;
1231:   tao->ops->view = TaoView_POUNDERS;
1232:   tao->ops->setfromoptions = TaoSetFromOptions_POUNDERS;
1233:   tao->ops->destroy = TaoDestroy_POUNDERS;

1235:   PetscNewLog(tao,&mfqP);
1236:   tao->data = (void*)mfqP;
1237:   /* Override default settings (unless already changed) */
1238:   if (!tao->max_it_changed) tao->max_it = 2000;
1239:   if (!tao->max_funcs_changed) tao->max_funcs = 4000;
1240:   mfqP->npmax = PETSC_DEFAULT;
1241:   mfqP->delta0 = 0.1;
1242:   mfqP->delta = 0.1;
1243:   mfqP->deltamax=1e3;
1244:   mfqP->deltamin=1e-6;
1245:   mfqP->c2 = 10.0;
1246:   mfqP->theta1=1e-5;
1247:   mfqP->theta2=1e-4;
1248:   mfqP->gamma0=0.5;
1249:   mfqP->gamma1=2.0;
1250:   mfqP->eta0 = 0.0;
1251:   mfqP->eta1 = 0.1;
1252:   mfqP->usegqt = PETSC_FALSE;
1253:   mfqP->gqt_rtol = 0.001;
1254:   mfqP->gqt_maxits = 50;
1255:   mfqP->workxvec = NULL;
1256:   return 0;
1257: }