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