Actual source code: mlApply.c

  1: #ifdef PETSC_RCS_HEADER
  2: static char vcid[] = "$Id: mlApply.c,v 1.5 2000/01/10 03:20:33 knepley Exp $";
  3: #endif
  4: /*
  5:    Defines the application of the multilevel preconditioner
  6: */
 7:  #include src/sles/pc/pcimpl.h
 8:  #include ml.h

 10: int DQMV(char *trans, int numRows, PetscReal *Q, int ldQ, PetscReal *Tau, int numCols, PetscReal *x, PetscReal *y)
 11: {
 12:   /* Matvec with orthogonal matrix Q (elementary reflections)
 13:      Assumes LAPACK representation : Q is lower triangular with diagonal entries = 1 (which are not stored)
 14:   */
 15:   PetscTruth isnormal, istrans;
 16:   PetscReal  dot;
 17:   int        start, end, step;
 18:   int        i, j;
 19:   int        ierr;

 22:   if (numCols > numRows) SETERRQ(PETSC_ERR_ARG_WRONG, "Number of reflectors cannot exceed the size of Q");

 24:   PetscMemcpy(y, x, numRows * sizeof(double));
 25:   PetscStrcasecmp(trans, "N", &isnormal);
 26:   PetscStrcasecmp(trans, "T", &istrans);
 27:   if (isnormal == PETSC_TRUE) {
 28:     start = numCols-1;
 29:     end   = -1;
 30:     step  = -1;
 31:   } else if (istrans == PETSC_TRUE) {
 32:     start = 0;
 33:     end   = numCols;
 34:     step  = 1;
 35:   } else {
 36:     SETERRQ1(PETSC_ERR_ARG_WRONG, "Application type must be 'N' or 'T', not %s", trans);
 37:   }

 39:   for(j = start; j != end; j += step)
 40:   {
 41:     if (Tau[j] != 0.0)
 42:     {
 43:       /* dot = v^T_j y */
 44:       dot = y[j];
 45:       for(i = j+1; i < numRows; i++)
 46:         dot  += Q[j*ldQ+i]*y[i];
 47:       /* dot = tau v^T_j y */
 48:       dot  *= Tau[j];
 49:       /* y = (I - tau v_j v^T_j) y */
 50:       y[j] -= dot;
 51:       for(i = j+1; i < numRows; i++)
 52:         y[i] -= Q[j*ldQ+i]*dot;
 53:     }
 54:   }
 55:   PetscLogFlops(numCols*(2 + numRows*2));
 56:   return(0);
 57: }

 59: /*@C PCMultiLevelApplyGradient
 60:         This function applies the gradient to a vector.

 62:   Input Parameters:
 63: + pc - The preconditioner context
 64: - x  - The input vector

 66:   Output Parameter:
 67: . y  - The output vector

 69:   Level: intermediate

 71: .keywords multilevel
 72: .seealso PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans, PCMultiLevelApplyV,
 73:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
 74: @*/
 75: int PCMultiLevelApplyGradient(PC pc, GVec x, GVec y)
 76: {
 77:   PC_Multilevel *ml;
 78:   int            size, rows, cols;
 79:   int            ierr;

 85:   if (pc->setupcalled < 2) {
 86:     PCSetUp(pc);
 87:   }

 89:   ml = (PC_Multilevel *) pc->data;
 90: #ifdef PETSC_USE_BOPT_g
 91:   if (ml->useMath == PETSC_FALSE) {
 92:     PCValidQ_Multilevel(pc);
 93:   }
 94: #endif
 95:   VecGetSize(y, &size);
 96:   if (ml->B != PETSC_NULL) {
 97:     MatGetSize(ml->B, &rows, &cols);
 98:   }
 99:   if ((ml->B != PETSC_NULL) && (size == rows)) {
100:     MatMult(ml->B, x, y);
101:   } else {
102:     GVecEvaluateOperatorGalerkinRectangular(y, x, ml->sOrder, ml->sLocOrder, ml->tOrder, ml->tLocOrder,
103:                                                    ml->gradOp, ml->gradAlpha, PETSC_NULL);
104: 
105:   }
106:   return(0);
107: }

109: /*@C PCMultiLevelApplyGradientTrans
110:         This function applies the transpose of the
111:   gradient to a vector.

113:   Input Parameters:
114: + pc - The preconditioner context
115: - x  - The input vector

117:   Output Parameter:
118: . y  - The output vector

120:   Level: intermediate

122: .keywords multilevel
123: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyP, PCMultiLevelApplyPTrans, PCMultiLevelApplyV,
124:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
125: @*/
126: int PCMultiLevelApplyGradientTrans(PC pc, GVec x, GVec y)
127: {
128:   PC_Multilevel *ml;
129:   int            size, rows, cols;
130:   int            ierr;

136:   if (pc->setupcalled < 2) {
137:     PCSetUp(pc);
138:   }

140:   ml = (PC_Multilevel *) pc->data;
141: #ifdef PETSC_USE_BOPT_g
142:   if (ml->useMath == PETSC_FALSE) {
143:     PCValidQ_Multilevel(pc);
144:   }
145: #endif
146:   VecGetSize(x, &size);
147:   if (ml->B != PETSC_NULL) {
148:     MatGetSize(ml->B, &rows, &cols);
149:   }
150:   if ((ml->B != PETSC_NULL) && (size == rows)) {
151:     MatMultTranspose(ml->B, x, y);
152:   } else {
153:     GVecEvaluateOperatorGalerkinRectangular(y, x, ml->tOrder, ml->tLocOrder, ml->sOrder, ml->sLocOrder,
154:                                                    ml->divOp, ml->gradAlpha, PETSC_NULL);
155: 
156:   }
157:   return(0);
158: }

160: /* This is for just applying the interior portions of D^{-1} */
161: int PCMultiLevelApplyDInvLoc_Private(PC pc, GVec x, GVec y)
162: {
163: #ifdef HAVE_MATHEMATICA
164:   MLINK          link;
165: #endif
166:   PC_Multilevel *ml = (PC_Multilevel *) pc->data;
167:   double         zeroTol = ml->zeroTol;
168:   PetscScalar   *yArray;
169:   PetscReal     *invSingVals;
170:   int           *colIndices;
171:   int            level, part, col;
172:   int            ierr;

175:   /* Apply D^{-1} which is block diagonal, so we just split the vector and apply each local matrix */
176:   if (ml->useMath == PETSC_FALSE)
177:   {
178: #ifdef PETSC_USE_BOPT_g
179:     PCValidQ_Multilevel(pc);
180: #endif
181:     if (x != y)
182:       {VecCopy(x, y);                                                                              }
183:     /* Apply D^{-1} for each level */
184:     for(level = 0; level < ml->numLevels; level++)
185:     {
186:       /* Apply D^{-1} for each partition */
187:       for(part = 0; part < ml->numPartitions[level]; part++)
188:       {
189:         colIndices  = ml->colPartition[level][part];
190:         invSingVals = ml->factors[level][part][FACT_DINV];
191:         /* Here, null singular values are replaced by 1 instead of zero since these columns
192:            are carried to the next level */
193:         VecGetArray(y, &yArray);
194:         for(col = 0; col < ml->numPartitionCols[level][part]; col++)
195:           if (invSingVals[col] > zeroTol)
196:             yArray[colIndices[col]] *= invSingVals[col];
197:         VecRestoreArray(y, &yArray);
198:         PetscLogFlops(ml->numPartitionCols[level][part]);
199:       }
200:     }
201:   }
202:   else
203:   {
204: #ifdef HAVE_MATHEMATICA
205:     /* The link to Mathematica */
206:     PetscViewerMathematicaGetLink(ml->mathViewer, &link);

208:     /* vec1 = input vector */
209:     PetscViewerMathematicaSetName(ml->mathViewer, "vec1");
210:     VecView(x, ml->mathViewer);

212:     /* vec2 = DInverseApply[mattML,vec] */
213:     MLPutFunction(link, "EvaluatePacket", 1);
214:       MLPutFunction(link, "Set", 2);
215:         MLPutSymbol(link, "vec2");
216:         MLPutFunction(link, "DInverseApply", 2);
217:           MLPutSymbol(link, "mattML");
218:           MLPutSymbol(link, "vec1");
219:     MLEndPacket(link);
220:     /* Skip packets until ReturnPacket */
221:     PetscViewerMathematicaSkipPackets(ml->mathViewer, RETURNPKT);
222:     /* Skip ReturnPacket */
223:     MLNewPacket(link);

225:     /* y = vec2 */
226:     PetscViewerMathematicaSetName(ml->mathViewer, "vec2");
227:     PetscViewerMathematicaGetVector(ml->mathViewer, y);
228:     PetscViewerMathematicaClearName(ml->mathViewer);
229: #endif
230:   }
231:   return(0);
232: }

234: /*@C PCMultiLevelApplyDInv
235:         This function applies the inverse of D to a vector.

237:   Input Parameters:
238: + pc - The preconditioner context
239: - x  - The input vector

241:   Output Parameter:
242: . y  - The output vector

244:   Level: intermediate

246: .keywords multilevel
247: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
248:          PCMultiLevelApplyV, PCMultiLevelApplyVTrans, PCMultiLevelApplyDInvTrans
249: @*/
250: int PCMultiLevelApplyDInv(PC pc, GVec x, GVec y)
251: {
252:   PC_Multilevel *ml;
253:   PetscScalar   *rhsArray;
254:   int            numProcs, rank;
255: #ifdef PETSC_HAVE_PLAPACK
256:   PetscScalar    zero = 0.0;
257:   double         one  = 1.0;
258:   PLA_Obj        globalR = PETSC_NULL;
259: #else
260:   int            numRhs;
261: #endif
262:   int            ierr;

265:   /* Setup the PC context */
269:   if (pc->setupcalled < 2)
270:   {
271:     PCSetUp(pc);
272:   }

274:   /* Scatter in interface vector now since D^{-1} zeros out null space rows */
275:   ml = (PC_Multilevel *) pc->data;
276:   MPI_Comm_size(pc->comm, &numProcs);
277:   MPI_Comm_rank(pc->comm, &rank);
278:   if (numProcs > 1)
279:   {
280:     VecScatterBegin(x, ml->interfaceColRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceColScatter);
281:     VecScatterEnd(x, ml->interfaceColRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceColScatter);
282:   }

284:   /* Apply interior portion of D^{-1} */
285:   PCMultiLevelApplyDInvLoc_Private(pc, x, y);

287:   /* Apply R^{-1} from the QR of the interface matrix */
288: #ifdef PETSC_HAVE_PLAPACK
289:   if (numProcs > 1)
290:   {
291:     /* Put result in y */
292:     VecGetArray(ml->interfaceColRhs, &rhsArray);
293:     PLA_Obj_set_to_zero(ml->PLArhsD);
294:     PLA_API_begin();
295:     PLA_Obj_API_open(ml->PLArhsD);
296:     PLA_API_axpy_vector_to_global(ml->numLocNullCols, &one, rhsArray, 1, ml->PLArhsD, ml->firstNullCol[rank]);
297: 
298:     PLA_Obj_API_close(ml->PLArhsD);
299:     PLA_API_end();
300:     /* Solve y <-- R^{-1} y */
301:     PLA_Obj_horz_split_2(ml->interfaceQR, ml->numNullCols, &globalR, PLA_DUMMY);
302:     PLA_Trsv(PLA_UPPER_TRIANGULAR, PLA_NO_TRANSPOSE, PLA_NONUNIT_DIAG, globalR, ml->PLArhsD);
303:     PLA_Obj_free(&globalR);
304:     /* Get result from y */
305:     VecSet(&zero, ml->interfaceColRhs);
306:     PLA_API_begin();
307:     PLA_Obj_API_open(ml->PLArhsD);
308:     PLA_API_axpy_global_to_vector(ml->numLocNullCols, &one, ml->PLArhsD, ml->firstNullCol[rank], rhsArray, 1);
309: 
310:     PLA_Obj_API_close(ml->PLArhsD);
311:     PLA_API_end();
312:     VecRestoreArray(ml->interfaceColRhs, &rhsArray);
313:   }
314: #else
315:   if ((numProcs > 1) && (rank == 0))
316:   {
317:     numRhs = 1;
318:     VecGetArray(ml->interfaceColRhs, &rhsArray);
319:     LAtrtrs_("U", "N", "N", &ml->numNullCols, &numRhs, ml->interfaceQR, &ml->numInterfaceRows, rhsArray, &ml->numNullCols, &ierr);
320: 
321:     VecRestoreArray(ml->interfaceColRhs, &rhsArray);
322:     PetscLogFlops((ml->numNullCols*(ml->numNullCols-1))/2 + 2*ml->numNullCols);
323:   }
324: #endif

326:   /* Scatter out interface vector */
327:   if (numProcs > 1)
328:   {
329:     VecScatterBegin(ml->interfaceColRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceColScatter);
330:     VecScatterEnd(ml->interfaceColRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceColScatter);
331:   }
332:   return(0);
333: }

335: /* This is for just applying the interior portions of D^{-T} */
336: int PCMultiLevelApplyDInvTransLoc_Private(PC pc, GVec x, GVec y)
337: {
338: #ifdef HAVE_MATHEMATICA
339:   MLINK          link;
340: #endif
341:   PC_Multilevel *ml = (PC_Multilevel *) pc->data;
342:   double         zeroTol = ml->zeroTol;
343:   PetscScalar   *yArray;
344:   PetscReal     *invSingVals;
345:   int           *colIndices;
346:   int            level, part, col;
347:   int            ierr;

350:   /* Apply D^{-T} which is block diagonal, so we just split the vector and apply each local matrix */
351:   if (ml->useMath == PETSC_FALSE)
352:   {
353: #ifdef PETSC_USE_BOPT_g
354:     PCValidQ_Multilevel(pc);
355: #endif
356:     if (x != y)
357:       {VecCopy(x, y);                                                                              }
358:     /* Apply D^{-T} for each level */
359:     for(level = ml->numLevels-1; level >= 0; level--)
360:     {
361:       /* Apply D^{-T} for each partition */
362:       for(part = 0; part < ml->numPartitions[level]; part++)
363:       {
364:         colIndices  = ml->colPartition[level][part];
365:         invSingVals = ml->factors[level][part][FACT_DINV];
366:         /* Here, null singular values are replaced by 1 instead of zero since these columns
367:            are carried to the next level */
368:         VecGetArray(y, &yArray);
369:         for(col = 0; col < ml->numPartitionCols[level][part]; col++)
370:           if (invSingVals[col] > zeroTol)
371:             yArray[colIndices[col]] *= invSingVals[col];
372:         VecRestoreArray(y, &yArray);
373:         PetscLogFlops(ml->numPartitionCols[level][part]);
374:       }
375:     }
376:   }
377:   else
378:   {
379: #ifdef HAVE_MATHEMATICA
380:     /* The link to Mathematica */
381:     PetscViewerMathematicaGetLink(ml->mathViewer, &link);

383:     /* vec1 = input vector */
384:     PetscViewerMathematicaSetName(ml->mathViewer, "vec1");
385:     VecView(x, ml->mathViewer);

387:     /* vec2 = DInverseApply[mattML,vec] */
388:     MLPutFunction(link, "EvaluatePacket", 1);
389:       MLPutFunction(link, "Set", 2);
390:         MLPutSymbol(link, "vec2");
391:         MLPutFunction(link, "DInverseTransposeApply", 2);
392:           MLPutSymbol(link, "mattML");
393:           MLPutSymbol(link, "vec1");
394:     MLEndPacket(link);
395:     /* Skip packets until ReturnPacket */
396:     PetscViewerMathematicaSkipPackets(ml->mathViewer, RETURNPKT);
397:     /* Skip ReturnPacket */
398:     MLNewPacket(link);

400:     /* y = vec2 */
401:     PetscViewerMathematicaSetName(ml->mathViewer, "vec2");
402:     PetscViewerMathematicaGetVector(ml->mathViewer, y);
403:     PetscViewerMathematicaClearName(ml->mathViewer);
404: #endif
405:   }
406:   return(0);
407: }

409: /*@C PCMultiLevelApplyDInvTrans
410:         This function applies the inverse transpose of D to a vector.

412:   Input Parameters:
413: + pc - The preconditioner context
414: - x  - The input vector

416:   Output Parameter:
417: . y  - The output vector

419:   Level: intermediate

421: .keywords multilevel
422: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
423:          PCMultiLevelApplyV, PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv
424: @*/
425: int PCMultiLevelApplyDInvTrans(PC pc, GVec x, GVec y)
426: {
427:   PC_Multilevel *ml;
428:   PetscScalar   *rhsArray;
429:   int            numProcs, rank;
430: #ifdef PETSC_HAVE_PLAPACK
431:   PetscScalar    zero = 0.0;
432:   double         one  = 1.0;
433:   PLA_Obj        globalR = PETSC_NULL;
434: #else
435:   int            numRhs;
436: #endif
437:   int            ierr;

440:   /* Setup the PC context */
444:   if (pc->setupcalled < 2)
445:   {
446:     PCSetUp(pc);
447:   }

449:   /* Scatter in interface vector now since D^{-T} zeros out null space rows */
450:   ml = (PC_Multilevel *) pc->data;
451:   MPI_Comm_size(pc->comm, &numProcs);
452:   MPI_Comm_rank(pc->comm, &rank);
453:   if (numProcs > 1)
454:   {
455:     VecScatterBegin(x, ml->interfaceColRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceColScatter);
456:     VecScatterEnd(x, ml->interfaceColRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceColScatter);
457:   }

459:   /* Apply interior portion of D^{-T} */
460:   PCMultiLevelApplyDInvTransLoc_Private(pc, x, y);

462:   /* Apply R^{-T} from the QR of the interface matrix */
463: #ifdef PETSC_HAVE_PLAPACK
464:   if (numProcs > 1)
465:   {
466:     /* Put result in y */
467:     VecGetArray(ml->interfaceColRhs, &rhsArray);
468:     PLA_Obj_set_to_zero(ml->PLArhsD);
469:     PLA_API_begin();
470:     PLA_Obj_API_open(ml->PLArhsD);
471:     PLA_API_axpy_vector_to_global(ml->numLocNullCols, &one, rhsArray, 1, ml->PLArhsD, ml->firstNullCol[rank]);
472: 
473:     PLA_Obj_API_close(ml->PLArhsD);
474:     PLA_API_end();
475:     /* Solve y <-- R^{-T} y */
476:     PLA_Obj_horz_split_2(ml->interfaceQR, ml->numNullCols, &globalR, PLA_DUMMY);
477:     PLA_Trsv(PLA_UPPER_TRIANGULAR, PLA_TRANSPOSE, PLA_NONUNIT_DIAG, globalR, ml->PLArhsD);
478:     PLA_Obj_free(&globalR);
479:     /* Get result from y */
480:     VecSet(&zero, ml->interfaceColRhs);
481:     PLA_API_begin();
482:     PLA_Obj_API_open(ml->PLArhsD);
483:     PLA_API_axpy_global_to_vector(ml->numLocNullCols, &one, ml->PLArhsD, ml->firstNullCol[rank], rhsArray, 1);
484: 
485:     PLA_Obj_API_close(ml->PLArhsD);
486:     PLA_API_end();
487:     VecRestoreArray(ml->interfaceColRhs, &rhsArray);
488:   }
489: #else
490:   if ((numProcs > 1) && (rank == 0))
491:   {
492:     numRhs = 1;
493:     VecGetArray(ml->interfaceColRhs, &rhsArray);
494:     LAtrtrs_("U", "T", "N", &ml->numNullCols, &numRhs, ml->interfaceQR, &ml->numInterfaceRows, rhsArray, &ml->numNullCols, &ierr);
495: 
496:     VecRestoreArray(ml->interfaceColRhs, &rhsArray);
497:     PetscLogFlops((ml->numNullCols*(ml->numNullCols-1))/2 + 2*ml->numNullCols);
498:   }
499: #endif

501:   /* Scatter out interface vector */
502:   if (numProcs > 1)
503:   {
504:     VecScatterBegin(ml->interfaceColRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceColScatter);
505:     VecScatterEnd(ml->interfaceColRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceColScatter);
506:   }

508:   return(0);
509: }

511: /*@C PCMultiLevelApplyV
512:         This function applies V to a vector.

514:   Input Parameters:
515: + pc - The preconditioner context
516: - x  - The input vector

518:   Output Parameter:
519: . y  - The output vector

521:   Level: intermediate

523: .keywords multilevel
524: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
525:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
526: @*/
527: int PCMultiLevelApplyV(PC pc, GVec x, GVec y)
528: {
529: #ifdef HAVE_MATHEMATICA
530:   MLINK          link;
531: #endif
532:   PC_Multilevel *ml;
533:   PetscScalar   *yArray;
534:   PetscScalar   *colArray;
535:   PetscScalar   *colArray2;
536:   PetscReal     *VArray;
537:   int           *colIndices;
538:   PetscScalar    zero = 0.0;
539:   PetscScalar    one  = 1.0;
540:   int            dummy;
541:   int            level, part, dim, col;
542:   int            ierr;

545:   /* Setup the PC context */
549:   if (pc->setupcalled < 2)
550:   {
551:     PCSetUp(pc);
552:   }

554:   /* Apply V which is block diagonal, so we just split the vector and apply each local matrix */
555:   ml = (PC_Multilevel *) pc->data;
556:   if (ml->useMath == PETSC_FALSE)
557:   {
558: #ifdef PETSC_USE_BOPT_g
559:     PCValidQ_Multilevel(pc);
560: #endif
561:     if (x != y)
562:       {VecCopy(x, y);                                                                              }
563:     /* Apply V for each level */
564:     VecGetArray(y, &yArray);
565:     for(level = ml->numLevels-1; level >= 0; level--)
566:     {
567:       VecGetArray(ml->colReduceVecs[level],  &colArray);
568:       VecGetArray(ml->colReduceVecs2[level], &colArray2);
569:       /* Apply V for each partition */
570:       for(part = 0; part < ml->numPartitions[level]; part++)
571:       {
572:         colIndices = ml->colPartition[level][part];
573:         VArray     = ml->factors[level][part][FACT_V];
574:         dim        = ml->numPartitionCols[level][part];
575:         /* Scatter into work vector */
576:         for(col = 0; col < dim; col++)
577:           colArray[col] = yArray[colIndices[col]];
578:         dummy = 1;
579:         LAgemv_("T", &dim, &dim, &one, VArray, &dim, colArray, &dummy, &zero, colArray2, &dummy);
580:         /* Scatter from work vector */
581:         for(col = 0; col < dim; col++)
582:           yArray[colIndices[col]] = colArray2[col];
583:         PetscLogFlops(2*dim*dim - dim);
584:       }
585:       VecRestoreArray(ml->colReduceVecs[level],  &colArray);
586:       VecRestoreArray(ml->colReduceVecs2[level], &colArray2);
587:     }
588:     VecRestoreArray(y, &yArray);
589:   }
590:   else
591:   {
592: #ifdef HAVE_MATHEMATICA
593:     /* The link to Mathematica */
594:     PetscViewerMathematicaGetLink(ml->mathViewer, &link);

596:     /* vec1 = input vector */
597:     PetscViewerMathematicaSetName(ml->mathViewer, "vec1");
598:     VecView(x, ml->mathViewer);

600:     /* vec2 = VApply[mattML,vec] */
601:     MLPutFunction(link, "EvaluatePacket", 1);
602:       MLPutFunction(link, "Set", 2);
603:         MLPutSymbol(link, "vec2");
604:         MLPutFunction(link, "VTransposeApply", 2);
605:           MLPutSymbol(link, "mattML");
606:           MLPutSymbol(link, "vec1");
607:     MLEndPacket(link);
608:     /* Skip packets until ReturnPacket */
609:     PetscViewerMathematicaSkipPackets(ml->mathViewer, RETURNPKT);
610:     /* Skip ReturnPacket */
611:     MLNewPacket(link);

613:     /* y = vec2 */
614:     PetscViewerMathematicaSetName(ml->mathViewer, "vec2");
615:     PetscViewerMathematicaGetVector(ml->mathViewer, y);
616:     PetscViewerMathematicaClearName(ml->mathViewer);
617: #endif
618:   }
619:   return(0);
620: }

622: /*@C PCMultiLevelApplyVTrans
623:         This function applies the transpose of V to a vector.

625:   Input Parameters:
626: + pc - The preconditioner context
627: - x  - The input vector

629:   Output Parameter:
630: . y  - The output vector

632:   Level: intermediate

634: .keywords multilevel
635: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
636:          PCMultiLevelApplyV, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
637: @*/
638: int PCMultiLevelApplyVTrans(PC pc, GVec x, GVec y)
639: {
640: #ifdef HAVE_MATHEMATICA
641:   MLINK          link;
642: #endif
643:   PC_Multilevel *ml;
644:   PetscScalar   *yArray;
645:   PetscScalar   *colArray;
646:   PetscScalar   *colArray2;
647:   PetscReal     *VArray;
648:   int           *colIndices;
649:   PetscScalar    zero = 0.0;
650:   PetscScalar    one  = 1.0;
651:   int            dummy;
652:   int            level, part, dim, col;
653:   int            ierr;

656:   /* Setup the PC context */
660:   if (pc->setupcalled < 2)
661:   {
662:     PCSetUp(pc);
663:   }

665:   /* Apply V^T which is block diagonal, so we just split the vector and apply each local matrix */
666:   ml = (PC_Multilevel *) pc->data;
667:   if (ml->useMath == PETSC_FALSE)
668:   {
669: #ifdef PETSC_USE_BOPT_g
670:     PCValidQ_Multilevel(pc);
671: #endif
672:     if (x != y)
673:       {VecCopy(x, y);                                                                              }
674:     /* Apply V^T for each level */
675:     VecGetArray(y, &yArray);
676:     for(level = 0; level < ml->numLevels; level++)
677:     {
678:       VecGetArray(ml->colReduceVecs[level],  &colArray);
679:       VecGetArray(ml->colReduceVecs2[level], &colArray2);
680:       /* Apply V^T for each partition */
681:       for(part = 0; part < ml->numPartitions[level]; part++)
682:       {
683:         colIndices = ml->colPartition[level][part];
684:         VArray     = ml->factors[level][part][FACT_V];
685:         dim        = ml->numPartitionCols[level][part];
686:         /* Scatter into work vector */
687:         for(col = 0; col < dim; col++)
688:           colArray[col] = yArray[colIndices[col]];
689:         dummy = 1;
690:         LAgemv_("N", &dim, &dim, &one, VArray, &dim, colArray, &dummy, &zero, colArray2, &dummy);
691:         /* Scatter from work vector */
692:         for(col = 0; col < dim; col++)
693:           yArray[colIndices[col]] = colArray2[col];
694:         PetscLogFlops(2*dim*dim - dim);
695:       }
696:       VecRestoreArray(ml->colReduceVecs[level],  &colArray);
697:       VecRestoreArray(ml->colReduceVecs2[level], &colArray2);
698:     }
699:     VecRestoreArray(y, &yArray);
700:   }
701:   else
702:   {
703: #ifdef HAVE_MATHEMATICA
704:     /* The link to Mathematica */
705:     PetscViewerMathematicaGetLink(ml->mathViewer, &link);

707:     /* vec1 = input vector */
708:     PetscViewerMathematicaSetName(ml->mathViewer, "vec1");
709:     VecView(x, ml->mathViewer);

711:     /* vec2 = VApply[mattML,vec] */
712:     MLPutFunction(link, "EvaluatePacket", 1);
713:       MLPutFunction(link, "Set", 2);
714:         MLPutSymbol(link, "vec2");
715:         MLPutFunction(link, "VApply", 2);
716:           MLPutSymbol(link, "mattML");
717:           MLPutSymbol(link, "vec1");
718:     MLEndPacket(link);
719:     /* Skip packets until ReturnPacket */
720:     PetscViewerMathematicaSkipPackets(ml->mathViewer, RETURNPKT);
721:     /* Skip ReturnPacket */
722:     MLNewPacket(link);

724:     /* y = vec2 */
725:     PetscViewerMathematicaSetName(ml->mathViewer, "vec2");
726:     PetscViewerMathematicaGetVector(ml->mathViewer, y);
727:     PetscViewerMathematicaClearName(ml->mathViewer);
728: #endif
729:   }
730:   return(0);
731: }

733: /*@C PCMultiLevelApplyP
734:         This function applies P to a vector.

736:   Input Parameters:
737: + pc - The preconditioner context
738: - x  - The input vector

740:   Output Parameter:
741: . y  - The output vector

743:   Level: intermediate

745: .keywords multilevel
746: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyPTrans, PCMultiLevelApplyP1,
747:          PCMultiLevelApplyP1Trans, PCMultiLevelApplyP2, PCMultiLevelApplyP2Trans, PCMultiLevelApplyV
748:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
749: @*/
750: int PCMultiLevelApplyP(PC pc, GVec x, GVec y)
751: {
752: #ifdef HAVE_MATHEMATICA
753:   MLINK          link;
754: #endif
755:   PC_Multilevel *ml;
756:   PetscScalar   *yArray;
757:   PetscScalar   *rhsArray;
758:   PetscScalar   *localWorkArray;
759:   PetscScalar   *interiorArray;
760:   PetscScalar   *interiorArray2;
761:   PetscScalar   *bdArray;
762:   PetscScalar   *colArray;
763:   PetscScalar   *colArray2;
764:   PetscReal     *UArray;
765:   PetscReal     *QRArray;
766:   PetscReal     *TAUArray;
767:   PetscReal     *invSingVals;
768:   PetscReal     *VArray;
769:   int           *rowIndices;
770:   int            numParts, numBdRows, numResRows;
771:   int            partOffset, locColVars;
772:   int            numProcs, rank;
773:   int            nullCol, rangeCol;
774:   PetscScalar    zero =  0.0;
775:   PetscScalar    one  =  1.0;
776:   int            dummy;
777: #ifndef PETSC_HAVE_PLAPACK
778: #ifdef PETSC_USE_DEBUG
779:   int            numInterfaceRows;
780: #endif
781: #endif
782:   int            level, part, dim, col, row;
783:   int            ierr;

786:   /* Setup the PC context */
790:   if (pc->setupcalled < 2)
791:   {
792:     PCSetUp(pc);
793:   }

795:   /* Initialization */
796:   ml   = (PC_Multilevel *) pc->data;
797:   MPI_Comm_size(pc->comm, &numProcs);
798:   MPI_Comm_rank(pc->comm, &rank);

800:   /* Copy x into y if necessary */
801:   if (x != y)
802:     {VecCopy(x, y);                                                                                }

804:   /* Calculate interface values */
805:   if (numProcs > 1)
806:   {
807:     PC_MLLogEventBegin(PC_ML_ApplySymmetricRightParallel, pc, x, y, 0);
808: #ifdef PETSC_HAVE_PLAPACK
809:     /* Get the interface vector and reduce interface columns */
810:     VecScatterBegin(y, ml->interfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceScatter);
811:     VecScatterEnd(y, ml->interfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceScatter);

813:     PC_MLLogEventBegin(PC_ML_ApplyQR, pc, x, y, 0);
814:     VecGetArray(ml->interfaceRhs, &rhsArray);
815:     /* Put result in x */
816:     PLA_Obj_set_to_zero(ml->PLArhsP);
817:     PLA_API_begin();
818:     PLA_Obj_API_open(ml->PLArhsP);
819:     PLA_API_axpy_vector_to_global(ml->numLocInterfaceRows, &one, rhsArray, 1, ml->PLArhsP, ml->firstInterfaceRow[rank]);
820: 
821:     PLA_Obj_API_close(ml->PLArhsP);
822:     PLA_API_end();
823:     /* Apply x <-- Q x */
824:     PLA_Q_solve(PLA_SIDE_LEFT, PLA_TRANS, ml->interfaceQR, ml->interfaceTAU, ml->PLArhsP);
825:     /* Get result from x */
826:     VecSet(&zero, ml->interfaceRhs);
827:     PLA_API_begin();
828:     PLA_Obj_API_open(ml->PLArhsP);
829:     PLA_API_axpy_global_to_vector(ml->numLocInterfaceRows, &one, ml->PLArhsP, ml->firstInterfaceRow[rank], rhsArray, 1);
830: 
831:     PLA_Obj_API_close(ml->PLArhsP);
832:     PLA_API_end();
833:     VecRestoreArray(ml->interfaceRhs, &rhsArray);
834:     PC_MLLogEventEnd(PC_ML_ApplyQR, pc, x, y, 0);

836:     /* Set the interface values */
837:     VecScatterBegin(ml->interfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceScatter);
838:     VecScatterEnd(ml->interfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceScatter);
839: #else
840:     /* Get the interface vector and reduce interface columns */
841:     VecScatterBegin(y, ml->locInterfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->locInterfaceScatter);
842:     VecScatterEnd(y, ml->locInterfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->locInterfaceScatter);
843:     VecGetArray(ml->locInterfaceRhs, &rhsArray);

845:     PC_MLLogEventBegin(PC_ML_ApplyQR, pc, x, y, 0);
846:     if (rank == 0)
847:     {
848:       /* Apply Q from the QR of the interface matrix */
849:       dummy = 1;
850: #ifdef PETSC_USE_DEBUG
851:       VecGetSize(ml->locInterfaceRhs, &numInterfaceRows);
852:       if (numInterfaceRows != ml->numInterfaceRows) SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid interface vector");
853: #endif
854:       LAormqr_("L", "N", &ml->numInterfaceRows, &dummy, &ml->numNullCols, ml->interfaceQR, &ml->numInterfaceRows,
855:              ml->interfaceTAU, rhsArray, &ml->numInterfaceRows, ml->work, &ml->workLen, &ierr);
856: 
857:       PetscLogFlops(ml->numNullCols*(2 + ml->numInterfaceRows*2));
858:     }
859:     PC_MLLogEventEnd(PC_ML_ApplyQR, pc, x, y, 0);

861:     /* Set the interface values */
862:     VecRestoreArray(ml->locInterfaceRhs, &rhsArray);
863:     VecScatterBegin(ml->locInterfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->locInterfaceScatter);
864:     VecScatterEnd(ml->locInterfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->locInterfaceScatter);

866:     /* Retrieve the local interface columns */
867:     VecScatterBegin(y, ml->interfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceScatter);
868:     VecScatterEnd(y, ml->interfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interfaceScatter);
869: #endif

871:     /* Multiply x by B^T_I */
872:     MatMultTranspose(ml->interfaceB, ml->interfaceRhs, ml->colWorkVec);

874:     /* Multiply B_p^(IT) x by V^T_p */
875:     PCMultiLevelApplyVTrans(pc, ml->colWorkVec, ml->colWorkVec);

877:     /* Multiply V^T_p B_p^(IT) x by -D_p^{-T} */
878:     PCMultiLevelApplyDInvTransLoc_Private(pc, ml->colWorkVec, ml->colWorkVec);

880:     /* Reduce rows */
881:     VecGetArray(ml->colWorkVec,         &localWorkArray);
882:     VecGetArray(y,                      &yArray);
883:     VarOrderingGetLocalSize(ml->sOrder, &locColVars);
884:     for(col = 0, nullCol = 0, rangeCol = 0; col < locColVars; col++)
885:       if (ml->nullCols[nullCol] == col)
886:         /* yArray[ml->nullCols[nullCol++]] -= localWorkArray[col]; */
887:         nullCol++;
888:       else
889:         yArray[ml->range[rangeCol++]]   -= localWorkArray[col];
890:     PetscLogFlops(rangeCol);
891:     if ((rangeCol != ml->localRank) || (nullCol != ml->numLocNullCols)) {
892:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid range space");
893:     }
894:     VecRestoreArray(ml->colWorkVec, &localWorkArray);
895:     VecRestoreArray(y,              &yArray);
896:     /* Here the new interface values are in y, and the old interior values */

898:     /* Scatter in interior values */
899:     VecScatterBegin(y, ml->interiorRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interiorScatter);
900:     VecScatterEnd(y, ml->interiorRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interiorScatter);
901:     PC_MLLogEventEnd(PC_ML_ApplySymmetricRightParallel, pc, x, y, 0);
902:   } else {
903:     ml->interiorRhs = y;
904:   }

906:   /* Apply P */
907:   if (ml->useMath == PETSC_FALSE)
908:   {
909: #ifdef PETSC_USE_BOPT_g
910:     PCValidQ_Multilevel(pc);
911: #endif
912:     /* Apply P for each level */
913:     VecGetArray(ml->interiorRhs, &rhsArray);
914:     interiorArray  = ml->interiorWork;
915:     interiorArray2 = ml->interiorWork2;
916:     for(level = ml->numLevels-1; level >= 0; level--)
917:     {
918:       numParts = ml->numPartitions[level];
919:       /* Scatter in boundary rows */
920:       VecGetArray(ml->bdReduceVecs[level], &bdArray);
921:       rowIndices = ml->rowPartition[level][PART_ROW_BD][0];
922:       numBdRows  = ml->numPartitionRows[level][numParts];
923:       for(row = 0; row < numBdRows; row++)
924:         bdArray[row] = rhsArray[rowIndices[row]];
925:       /* Scatter in residual rows */
926:       rowIndices = ml->rowPartition[level][PART_ROW_RES][0];
927:       numResRows = ml->numPartitionRows[level][numParts+1];
928:       for(row = 0; row < numResRows; row++)
929:         bdArray[row+numBdRows] = rhsArray[rowIndices[row]];
930:       VecRestoreArray(ml->bdReduceVecs[level], &bdArray);
931:       /* Create B^T_Gamma x */
932:       MatMultTranspose(ml->grads[level], ml->bdReduceVecs[level], ml->colReduceVecs[level]);
933:       if (numBdRows+numResRows == 0)
934:       {
935:         /* If ml->grads[level] has no rows, the default behavior is to leave ml->colReduceVecs[level] untouched */
936:         VecSet(&zero, ml->colReduceVecs[level]);
937:       }
938:       /* Reduce interior columns using / I   -D^{-T} V^T B^T_Gamma    and apply U
939:                                         0              I           /                  */
940:       VecGetArray(ml->colReduceVecs[level],  &colArray);
941:       VecGetArray(ml->colReduceVecs2[level], &colArray2);
942:       for(part = 0, partOffset = 0; part < numParts; part++)
943:       {
944:         /* Apply V^T */
945:         VArray = ml->factors[level][part][FACT_V];
946:         dim    = ml->numPartitionCols[level][part];
947:         dummy  = 1;
948:         LAgemv_("N", &dim, &dim, &one, VArray, &dim, &colArray[partOffset], &dummy, &zero, colArray2, &dummy);
949:         PetscLogFlops(2*dim*dim - dim);
950:         partOffset += dim;
951:         /* Apply D^{-T} and reduce, since we take D as rectangular we must watch out for the dimension */
952:         rowIndices  = ml->rowPartition[level][PART_ROW_INT][part];
953:         invSingVals = ml->factors[level][part][FACT_DINV];
954:         dim         = PetscMin(ml->numPartitionCols[level][part], ml->numPartitionRows[level][part]);
955:         for(col = 0; col < dim; col++)
956:           rhsArray[rowIndices[col]] -= colArray2[col] * invSingVals[col];
957:         PetscLogFlops(2*dim);
958:         /* Apply U */
959:         UArray = ml->factors[level][part][FACT_U];
960:         dim    = ml->numPartitionRows[level][part];
961:         if (dim > 0) {
962:           col = ml->numPartitionCols[level][part];
963:           if (PCMultiLevelDoQR_Private(pc, dim, col) == PETSC_TRUE) {
964:             QRArray  = ml->factors[level][part][FACT_QR];
965:             TAUArray = ml->factors[level][part][FACT_TAU];
966:             /* Scatter into work vector */
967:             for(row = 0; row < dim; row++) interiorArray[row] = rhsArray[rowIndices[row]];
968:             dummy = 1;
969:             LAgemv_("N", &col, &col, &one, UArray, &col, interiorArray, &dummy, &zero, interiorArray2, &dummy);
970:             PetscLogFlops(2*col*col - col);
971:             PetscMemcpy(interiorArray2+col, interiorArray+col, (dim - col) * sizeof(double));
972:             DQMV("N", dim, QRArray, dim, TAUArray, col, interiorArray2, interiorArray);
973:             /* Scatter from work vector */
974:             for(row = 0; row < dim; row++)
975:               rhsArray[rowIndices[row]] = interiorArray[row];
976:           }
977:           else
978:           {
979:             /* Scatter into work vector */
980:             for(row = 0; row < dim; row++)
981:               interiorArray[row] = rhsArray[rowIndices[row]];
982:             dummy = 1;
983:             LAgemv_("N", &dim, &dim, &one, UArray, &dim, interiorArray, &dummy, &zero, interiorArray2, &dummy);
984:             PetscLogFlops(2*dim*dim - dim);
985:             /* Scatter from work vector */
986:             for(row = 0; row < dim; row++)
987:               rhsArray[rowIndices[row]] = interiorArray2[row];
988:           }
989:         }
990:       }
991:       VecRestoreArray(ml->colReduceVecs[level],  &colArray);
992:       VecRestoreArray(ml->colReduceVecs2[level], &colArray2);
993:     }
994:     VecRestoreArray(ml->interiorRhs, &rhsArray);
995:   }
996:   else
997:   {
998: #ifdef HAVE_MATHEMATICA
999:     /* The link to Mathematica */
1000:     PetscViewerMathematicaGetLink(ml->mathViewer, &link);

1002:     /* vec1 = input vector */
1003:     PetscViewerMathematicaSetName(ml->mathViewer, "vec1");
1004:     VecView(ml->interiorRhs, ml->mathViewer);

1006:     /* vec2 = PApply[mattML,vec] */
1007:     MLPutFunction(link, "EvaluatePacket", 1);
1008:       MLPutFunction(link, "Set", 2);
1009:         MLPutSymbol(link, "vec2");
1010:         MLPutFunction(link, "PApply", 2);
1011:           MLPutSymbol(link, "mattML");
1012:           MLPutSymbol(link, "vec1");
1013:     MLEndPacket(link);
1014:     /* Skip packets until ReturnPacket */
1015:     PetscViewerMathematicaSkipPackets(ml->mathViewer, RETURNPKT);
1016:     /* Skip ReturnPacket */
1017:     MLNewPacket(link);

1019:     /* y = vec2 */
1020:     PetscViewerMathematicaSetName(ml->mathViewer, "vec2");
1021:     PetscViewerMathematicaGetVector(ml->mathViewer,  ml->interiorRhs);
1022:     PetscViewerMathematicaClearName(ml->mathViewer);
1023: #endif
1024:   }

1026:   /* Scatter back interior values */
1027:   if (numProcs > 1)
1028:   {
1029:     PC_MLLogEventBegin(PC_ML_ApplySymmetricRightParallel, pc, x, y, 0);
1030:     VecScatterBegin(ml->interiorRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interiorScatter);
1031:     VecScatterEnd(ml->interiorRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interiorScatter);
1032:     PC_MLLogEventEnd(PC_ML_ApplySymmetricRightParallel, pc, x, y, 0);
1033:   }

1035:   /* Scale by the diagonal of A */
1036:   if (ml->diag != PETSC_NULL) {
1037:     VecPointwiseMult(y, ml->diag, y);
1038:   }
1039:   return(0);
1040: }

1042: /*@C PCMultiLevelApplyPTrans
1043:         This function applies the transpose of P a vector.

1045:   Input Parameters:
1046: + pc - The preconditioner context
1047: - x  - The input vector

1049:   Output Parameter:
1050: . y  - The output vector

1052:   Level: intermediate

1054: .keywords multilevel
1055: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyP1,
1056:          PCMultiLevelApplyP1Trans, PCMultiLevelApplyP2, PCMultiLevelApplyP2Trans, PCMultiLevelApplyV
1057:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
1058: @*/
1059: int PCMultiLevelApplyPTrans(PC pc, GVec x, GVec y)
1060: {
1061: #ifdef HAVE_MATHEMATICA
1062:   MLINK          link;
1063: #endif
1064:   PC_Multilevel *ml;
1065:   PetscScalar   *yArray;
1066:   PetscScalar   *rhsArray;
1067:   PetscScalar   *localWorkArray;
1068:   PetscScalar   *interiorArray;
1069:   PetscScalar   *interiorArray2;
1070:   PetscScalar   *bdArray;
1071:   PetscScalar   *colArray;
1072:   PetscScalar   *colArray2;
1073:   PetscReal     *UArray;
1074:   PetscReal     *QRArray;
1075:   PetscReal     *TAUArray;
1076:   PetscReal     *invSingVals;
1077:   PetscReal     *VArray;
1078:   int           *rowIndices;
1079:   int            numParts, numBdRows, numResRows;
1080:   int            partOffset, locColVars;
1081:   int            numProcs, rank;
1082:   int            nullCol, rangeCol;
1083:   PetscScalar    minusOne = -1.0;
1084:   PetscScalar    zero     =  0.0;
1085:   PetscScalar    one      =  1.0;
1086:   int            dummy;
1087: #ifndef PETSC_HAVE_PLAPACK
1088: #ifdef PETSC_USE_DEBUG
1089:   int            numInterfaceRows;
1090: #endif
1091: #endif
1092:   int            level, part, dim, row, col;
1093:   int            ierr;

1096:   /* Setup the PC context */
1100:   if (pc->setupcalled < 2)
1101:   {
1102:     PCSetUp(pc);
1103:   }

1105:   /* Initialization */
1106:   ml   = (PC_Multilevel *) pc->data;
1107:   MPI_Comm_size(pc->comm, &numProcs);
1108:   MPI_Comm_rank(pc->comm, &rank);

1110:   if (ml->diag != PETSC_NULL) {
1111:     /* Scale by the diagonal of A */
1112:     VecPointwiseMult(x, ml->diag, y);
1113:   } else if (x != y) {
1114:     /* Copy x into y if necessary */
1115:     VecCopy(x, y);
1116:   }

1118:   /* Scatter in interior values */
1119:   if (numProcs > 1)
1120:   {
1121:     PC_MLLogEventBegin(PC_ML_ApplySymmetricLeftParallel, pc, x, y, 0);
1122:     VecScatterBegin(y, ml->interiorRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interiorScatter);
1123:     VecScatterEnd(y, ml->interiorRhs, INSERT_VALUES, SCATTER_FORWARD, ml->interiorScatter);
1124:     PC_MLLogEventEnd(PC_ML_ApplySymmetricLeftParallel, pc, x, y, 0);
1125:   }
1126:   else
1127:   {
1128:     ml->interiorRhs = y;
1129:   }

1131:   /* Apply P^T */
1132:   if (ml->useMath == PETSC_FALSE)
1133:   {
1134: #ifdef PETSC_USE_BOPT_g
1135:     PCValidQ_Multilevel(pc);
1136: #endif
1137:     /* Apply P^T for each level */
1138:     VecGetArray(ml->interiorRhs, &rhsArray);
1139:     interiorArray  = ml->interiorWork;
1140:     interiorArray2 = ml->interiorWork2;
1141:     for(level = 0; level < ml->numLevels; level++)
1142:     {
1143:       numParts = ml->numPartitions[level];
1144:       VecGetArray(ml->colReduceVecs[level],  &colArray);
1145:       VecGetArray(ml->colReduceVecs2[level], &colArray2);
1146:       /* Apply U^T for each partition and form V D^{-1} */
1147:       for(part = 0, partOffset = 0; part < numParts; part++)
1148:       {
1149:         /* Apply U^T */
1150:         rowIndices = ml->rowPartition[level][PART_ROW_INT][part];
1151:         UArray     = ml->factors[level][part][FACT_U];
1152:         dim        = ml->numPartitionRows[level][part];
1153:         if (dim  > 0)
1154:         {
1155:           col = ml->numPartitionCols[level][part];
1156:           if (PCMultiLevelDoQR_Private(pc, dim, col) == PETSC_TRUE)
1157:           {
1158:             QRArray  = ml->factors[level][part][FACT_QR];
1159:             TAUArray = ml->factors[level][part][FACT_TAU];
1160:             /* Scatter into work vector */
1161:             for(row = 0; row < dim; row++)
1162:               interiorArray[row] = rhsArray[rowIndices[row]];
1163:             DQMV("T", dim, QRArray, dim, TAUArray, col, interiorArray, interiorArray2);
1164:             dummy = 1;
1165:             LAgemv_("T", &col, &col, &one, UArray, &col, interiorArray2, &dummy, &zero, interiorArray, &dummy);
1166:             PetscLogFlops(2*col*col - col);
1167:             PetscMemcpy(interiorArray+col, interiorArray2+col, (dim - col) * sizeof(double));
1168:             /* Scatter from work vector */
1169:             for(row = 0; row < dim; row++)
1170:               rhsArray[rowIndices[row]] = interiorArray[row];
1171:           }
1172:           else
1173:           {
1174:             /* Scatter into work vector */
1175:             for(row = 0; row < dim; row++)
1176:               interiorArray[row] = rhsArray[rowIndices[row]];
1177:             dummy = 1;
1178:             LAgemv_("T", &dim, &dim, &one, UArray, &dim, interiorArray, &dummy, &zero, interiorArray2, &dummy);
1179:             PetscLogFlops(2*dim*dim - dim);
1180:             /* Scatter from work vector */
1181:             for(row = 0; row < dim; row++)
1182:               rhsArray[rowIndices[row]] = interiorArray2[row];
1183:           }
1184:         }
1185:         /* Apply D^{-1}, since we take D as rectangular we must watch out for the dimension */
1186:         invSingVals = ml->factors[level][part][FACT_DINV];
1187:         dim         = PetscMin(ml->numPartitionCols[level][part], ml->numPartitionRows[level][part]);
1188:         PetscMemzero(colArray2, ml->numPartitionCols[level][part] * sizeof(double));
1189:         for(col = 0; col < dim; col++)
1190:           colArray2[col] = rhsArray[rowIndices[col]] * invSingVals[col];
1191:         PetscLogFlops(dim);
1192:         /* Apply V */
1193:         VArray = ml->factors[level][part][FACT_V];
1194:         dim    = ml->numPartitionCols[level][part];
1195:         dummy = 1;
1196:         LAgemv_("T", &dim, &dim, &one, VArray, &dim, colArray2, &dummy, &zero, &colArray[partOffset], &dummy);
1197:         PetscLogFlops(2*dim*dim - dim);
1198:         partOffset += dim;
1199:       }
1200:       VecRestoreArray(ml->colReduceVecs[level],  &colArray);
1201:       VecRestoreArray(ml->colReduceVecs2[level], &colArray2);

1203:       /* Reduce boundary columns using /          I           0 
1204:                                         -B_Gamma V D^{-1}   I / */
1205:       MatMult(ml->grads[level], ml->colReduceVecs[level], ml->bdReduceVecs[level]);
1206:       VecGetArray(ml->bdReduceVecs[level], &bdArray);
1207:       /* Update boundary rows */
1208:       rowIndices = ml->rowPartition[level][PART_ROW_BD][0];
1209:       numBdRows  = ml->numPartitionRows[level][numParts];
1210:       for(row = 0; row < numBdRows; row++)
1211:         rhsArray[rowIndices[row]] -= bdArray[row];
1212:       /* Update residual rows */
1213:       rowIndices = ml->rowPartition[level][PART_ROW_RES][0];
1214:       numResRows = ml->numPartitionRows[level][numParts+1];
1215:       for(row = 0; row < numResRows; row++)
1216:         rhsArray[rowIndices[row]] -= bdArray[row+numBdRows];
1217:       PetscLogFlops(numBdRows+numResRows);
1218:       VecRestoreArray(ml->bdReduceVecs[level], &bdArray);
1219:     }
1220:     VecRestoreArray(ml->interiorRhs, &rhsArray);
1221:   }
1222:   else
1223:   {
1224: #ifdef HAVE_MATHEMATICA
1225:     /* The link to Mathematica */
1226:     PetscViewerMathematicaGetLink(ml->mathViewer, &link);

1228:     /* vec1 = input vector */
1229:     PetscViewerMathematicaSetName(ml->mathViewer, "vec1");
1230:     VecView(ml->interiorRhs, ml->mathViewer);

1232:     /* vec2 = PApply[mattML,vec] */
1233:     MLPutFunction(link, "EvaluatePacket", 1);
1234:       MLPutFunction(link, "Set", 2);
1235:         MLPutSymbol(link, "vec2");
1236:         MLPutFunction(link, "PTransposeApply", 2);
1237:           MLPutSymbol(link, "mattML");
1238:           MLPutSymbol(link, "vec1");
1239:     MLEndPacket(link);
1240:     /* Skip packets until ReturnPacket */
1241:     PetscViewerMathematicaSkipPackets(ml->mathViewer, RETURNPKT);
1242:     /* Skip ReturnPacket */
1243:     MLNewPacket(link);

1245:     /* y = vec2 */
1246:     PetscViewerMathematicaSetName(ml->mathViewer, "vec2");
1247:     PetscViewerMathematicaGetVector(ml->mathViewer,  ml->interiorRhs);
1248:     PetscViewerMathematicaClearName(ml->mathViewer);
1249: #endif
1250:   }

1252:   if (numProcs > 1)
1253:   {
1254:     PC_MLLogEventBegin(PC_ML_ApplySymmetricLeftParallel, pc, x, y, 0);
1255:     /* Scatter back interior values */
1256:     VecScatterBegin(ml->interiorRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interiorScatter);
1257:     VecScatterEnd(ml->interiorRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interiorScatter);

1259:     /* Calculate interface values */
1260:     /* Apply (I - D^{-1} D): Scatter some of the interior of y into a column work vector */
1261:     VecGetArray(y,                      &yArray);
1262:     VecGetArray(ml->colWorkVec,         &localWorkArray);
1263:     VarOrderingGetLocalSize(ml->sOrder, &locColVars);
1264:     PetscMemzero(localWorkArray, locColVars * sizeof(PetscScalar));
1265:     for(col = 0, nullCol = 0, rangeCol = 0; col < locColVars; col++)
1266:       if (ml->nullCols[nullCol] == col)
1267:         /* localWorkArray[col] = yArray[ml->nullCols[nullCol++]]; */
1268:         nullCol++;
1269:       else
1270:         localWorkArray[col] = yArray[ml->range[rangeCol++]];
1271:     if ((rangeCol != ml->localRank) || (nullCol != ml->numLocNullCols)) {
1272:       SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid range space");
1273:     }
1274:     VecRestoreArray(y,                    &yArray);
1275:     VecRestoreArray(ml->colWorkVec,       &localWorkArray);

1277:     /* Multiply y by D_p^{-1} */
1278:     PCMultiLevelApplyDInvLoc_Private(pc, ml->colWorkVec, ml->colWorkVec);

1280:     /* Multiply (I - D_p^{-1} D_p) y by V_p */
1281:     PCMultiLevelApplyV(pc, ml->colWorkVec, ml->colWorkVec);

1283:     /* Multiply V (I - D^{-1} D) y by -B_I */
1284:     MatMult(ml->interfaceB, ml->colWorkVec, ml->interfaceRhs);
1285:     VecScale(&minusOne, ml->interfaceRhs);

1287: #ifdef PETSC_HAVE_PLAPACK
1288:     /* Reduce the local interface columns */
1289:     VecScatterBegin(y, ml->interfaceRhs, ADD_VALUES, SCATTER_FORWARD, ml->interfaceScatter);
1290:     VecScatterEnd(y, ml->interfaceRhs, ADD_VALUES, SCATTER_FORWARD, ml->interfaceScatter);

1292:     PC_MLLogEventBegin(PC_ML_ApplyQR, pc, x, y, 0);
1293:     VecGetArray(ml->interfaceRhs, &rhsArray);
1294:     /* Put result in x */
1295:     PLA_Obj_set_to_zero(ml->PLArhsP);
1296:     PLA_API_begin();
1297:     PLA_Obj_API_open(ml->PLArhsP);
1298:     PLA_API_axpy_vector_to_global(ml->numLocInterfaceRows, &one, rhsArray, 1, ml->PLArhsP, ml->firstInterfaceRow[rank]);
1299: 
1300:     PLA_Obj_API_close(ml->PLArhsP);
1301:     PLA_API_end();
1302:     /* Apply x <-- Q^T x */
1303:     PLA_Q_solve(PLA_SIDE_LEFT, PLA_NO_TRANS, ml->interfaceQR, ml->interfaceTAU, ml->PLArhsP);
1304:     /* Get result from x */
1305:     VecSet(&zero, ml->interfaceRhs);
1306:     PLA_API_begin();
1307:     PLA_Obj_API_open(ml->PLArhsP);
1308:     PLA_API_axpy_global_to_vector(ml->numLocInterfaceRows, &one, ml->PLArhsP, ml->firstInterfaceRow[rank], rhsArray, 1);
1309: 
1310:     PLA_Obj_API_close(ml->PLArhsP);
1311:     PLA_API_end();
1312:     VecRestoreArray(ml->interfaceRhs, &rhsArray);
1313:     PC_MLLogEventEnd(PC_ML_ApplyQR, pc, x, y, 0);

1315:     /* Set the interface values */
1316:     VecScatterBegin(ml->interfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceScatter);
1317:     VecScatterEnd(ml->interfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->interfaceScatter);
1318: #else
1319:     /* Reduce the local interface columns */
1320:     VecScatterBegin(ml->interfaceRhs, y, ADD_VALUES, SCATTER_REVERSE, ml->interfaceScatter);
1321:     VecScatterEnd(ml->interfaceRhs, y, ADD_VALUES, SCATTER_REVERSE, ml->interfaceScatter);

1323:     /* Get the interface vector */
1324:     VecScatterBegin(y, ml->locInterfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->locInterfaceScatter);
1325:     VecScatterEnd(y, ml->locInterfaceRhs, INSERT_VALUES, SCATTER_FORWARD, ml->locInterfaceScatter);
1326:     VecGetArray(ml->locInterfaceRhs, &rhsArray);

1328:     PC_MLLogEventBegin(PC_ML_ApplyQR, pc, x, y, 0);
1329:     if (rank == 0) {
1330:       /* Apply Q^T from the QR of the interface matrix */
1331:       dummy = 1;
1332: #ifdef PETSC_USE_DEBUG
1333:       VecGetSize(ml->locInterfaceRhs, &numInterfaceRows);
1334:       if (numInterfaceRows != ml->numInterfaceRows) SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid interface vector");
1335: #endif
1336:       LAormqr_("L", "T", &ml->numInterfaceRows, &dummy, &ml->numNullCols, ml->interfaceQR, &ml->numInterfaceRows,
1337:              ml->interfaceTAU, rhsArray, &ml->numInterfaceRows, ml->work, &ml->workLen, &ierr);
1338:       PetscLogFlops(ml->numNullCols*(2 + ml->numInterfaceRows*2));
1339: 
1340:     }
1341:     PC_MLLogEventEnd(PC_ML_ApplyQR, pc, x, y, 0);

1343:     /* Set the interface values */
1344:     VecRestoreArray(ml->locInterfaceRhs, &rhsArray);
1345:     VecScatterBegin(ml->locInterfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->locInterfaceScatter);
1346:     VecScatterEnd(ml->locInterfaceRhs, y, INSERT_VALUES, SCATTER_REVERSE, ml->locInterfaceScatter);
1347: #endif
1348:     PC_MLLogEventEnd(PC_ML_ApplySymmetricLeftParallel, pc, x, y, 0);
1349:   }
1350:   return(0);
1351: }

1353: /*@C PCMultiLevelApplyP1
1354:         This function applies P_1, the projector on the range of B, to a vector.

1356:   Input Parameters:
1357: + pc - The preconditioner context
1358: - x  - The input vector

1360:   Output Parameter:
1361: . y  - The output vector

1363:   Level: intermediate

1365: .keywords multilevel
1366: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
1367:          PCMultiLevelApplyP1Trans, PCMultiLevelApplyP2, PCMultiLevelApplyP2Trans, PCMultiLevelApplyV
1368:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
1369: @*/
1370: int PCMultiLevelApplyP1(PC pc, GVec x, GVec y)
1371: {
1372:   PC_Multilevel *ml;
1373:   PetscScalar    zero = 0.0;
1374:   int            ierr;

1377:   /* Setup the PC context */
1381:   if (pc->setupcalled < 2) {
1382:     PCSetUp(pc);
1383:   }

1385:   /* Scatter the column vector x to the solution vector y */
1386:   ml   = (PC_Multilevel *) pc->data;
1387:   VecSet(&zero, y);
1388:   VecScatterBegin(x, y, INSERT_VALUES, SCATTER_REVERSE, ml->rangeScatter);
1389:   VecScatterEnd(x, y, INSERT_VALUES, SCATTER_REVERSE, ml->rangeScatter);

1391:   /* Apply P */
1392:   PCMultiLevelApplyP(pc, y, y);
1393:   return(0);
1394: }

1396: /*@C PCMultiLevelApplyP1Trans
1397:         This function applies the transpose of P_1, the projector on the range of B, to a vector.

1399:   Input Parameters:
1400: + pc - The preconditioner context
1401: - x  - The input vector

1403:   Output Parameter:
1404: . y  - The output vector

1406:   Level: intermediate

1408: .keywords multilevel
1409: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
1410:          PCMultiLevelApplyP1, PCMultiLevelApplyP2, PCMultiLevelApplyP2Trans, PCMultiLevelApplyV
1411:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
1412: @*/
1413: int PCMultiLevelApplyP1Trans(PC pc, GVec x, GVec y)
1414: {
1415:   PC_Multilevel *ml;
1416:   GVec           z;
1417:   PetscScalar    zero = 0.0;
1418:   int            ierr;

1421:   /* Setup the PC context */
1425:   if (pc->setupcalled < 2)
1426:   {
1427:     PCSetUp(pc);
1428:   }

1430:   /* Apply P^T */
1431:   VecDuplicate(x, &z);
1432:   PCMultiLevelApplyPTrans(pc, x, z);

1434:   /* Scatter the solution vector z to the column vector y */
1435:   ml = (PC_Multilevel *) pc->data;
1436:   VecSet(&zero, y);
1437:   VecScatterBegin(z, y, INSERT_VALUES, SCATTER_FORWARD, ml->rangeScatter);
1438:   VecScatterEnd(z, y, INSERT_VALUES, SCATTER_FORWARD, ml->rangeScatter);
1439:   VecDestroy(z);
1440:   return(0);
1441: }

1443: /*@C PCMultiLevelApplyP2
1444:         This function applies P_2, the projector on the nullspace of B, to a vector.
1445:   Note that this function is setup to take two vectors of the same size. The
1446:   component of x and y in the range of B is zero on output.

1448:   Input Parameters:
1449: + pc - The preconditioner context
1450: - x  - The input vector

1452:   Output Parameter:
1453: . y  - The output vector

1455:   Level: intermediate

1457: .keywords multilevel
1458: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
1459:          PCMultiLevelApplyP1, PCMultiLevelApplyP1Trans, PCMultiLevelApplyP2Trans, PCMultiLevelApplyV
1460:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
1461: @*/
1462: int PCMultiLevelApplyP2(PC pc, GVec x, GVec y)
1463: {
1464:   PC_Multilevel *ml;
1465:   PetscScalar   *xArray;
1466:   int            row;
1467:   int            ierr;

1470:   /* Setup the PC context */
1474:   if (pc->setupcalled < 2)
1475:   {
1476:     PCSetUp(pc);
1477:   }

1479:   /* Zero out range space of B */
1480:   ml = (PC_Multilevel *) pc->data;
1481:   VecGetArray(x, &xArray);
1482:   for(row = 0; row < ml->rank; row++)
1483:   {
1484:     xArray[ml->range[row]] = 0.0;
1485:   }
1486:   VecRestoreArray(x, &xArray);

1488:   /* Apply P */
1489:   PCMultiLevelApplyP(pc, x, y);
1490:   return(0);
1491: }

1493: /*@C PCMultiLevelApplyP2Trans
1494:         This function applies the transpose of P_2, the projector on the nullspace of B, to a vector.
1495:   Note that this function is setup to take two vectors of the same size. The component of y in
1496:   the range of B is zero on output.

1498:   Input Parameters:
1499: + pc - The preconditioner context
1500: - x  - The input vector

1502:   Output Parameter:
1503: . y  - The output vector

1505:   Level: intermediate

1507: .keywords multilevel
1508: .seealso PCMultiLevelApplyGradient, PCMultiLevelApplyGradientTrans, PCMultiLevelApplyP, PCMultiLevelApplyPTrans,
1509:          PCMultiLevelApplyP1, PCMultiLevelApplyP1Trans, PCMultiLevelApplyP2, PCMultiLevelApplyV
1510:          PCMultiLevelApplyVTrans, PCMultiLevelApplyDInv, PCMultiLevelApplyDInvTrans
1511: @*/
1512: int PCMultiLevelApplyP2Trans(PC pc, GVec x, GVec y)
1513: {
1514:   PC_Multilevel *ml;
1515:   PetscScalar   *yArray;
1516:   int            row;
1517:   int            ierr;

1523:   /* Apply P */
1524:   PCMultiLevelApplyPTrans(pc, x, y);

1526:   /* Zero out range space of B */
1527:   ml = (PC_Multilevel *) pc->data;
1528:   VecGetArray(y, &yArray);
1529:   for(row = 0; row < ml->rank; row++)
1530:   {
1531:     yArray[ml->range[row]] = 0.0;
1532:   }
1533:   VecRestoreArray(y, &yArray);
1534:   return(0);
1535: }