Actual source code: gmat.c

  1: #ifdef PETSC_RCS_HEADER
  2: static char vcid[] = "$Id: gmat.c,v 1.34 2000/07/16 23:20:03 knepley Exp $";
  3: #endif

  5: /* This file provides routines for grid matrices */

 7:  #include src/gvec/gvecimpl.h
 8:  #include petscts.h
 9:  #include gsolver.h

 11: /* Logging support */
 12: int GMAT_CreateRectangular, GMAT_EvaluateOperatorGalerkin, GMAT_EvaluateSystemMatrix, GMAT_SetBoundary;
 13: int GMAT_MatMultConstrained, GMAT_MatMultTransposeConstrained;

 15: extern int MatMult_MPIAIJ(Mat, Vec, Vec); /* For GMatMatMultConstrained */

 17: /*@C
 18:    GMatDestroy - Destroys a grid matrix.
 19:   
 20:    Input Parameter:
 21: .  mat - the matrix

 23:   Level: beginner

 25: .keywords: matrix, destroy
 26: @*/
 27: int GMatDestroy(Mat mat)
 28: {

 33:   if (--mat->refct > 0) return(0);
 34:   MatDestroy(mat);
 35:   return(0);
 36: }

 38: /*@ 
 39:   GMatView - Views a grid matrix.

 41:   Input Parameters:
 42: + mat    - the grid matrix
 43: - viewer - an optional visualization context

 45:    Notes:
 46:    GMatView() supports the same viewers as MatView().  The only difference
 47:    is that for all multiprocessor cases, the output vector employs the natural
 48:    ordering of the grid, so it many cases this corresponds to the ordering 
 49:    that would have been used for the uniprocessor case.

 51:    The available visualization contexts include
 52: $     VIEWER_STDOUT_SELF - standard output (default)
 53: $     VIEWER_STDOUT_WORLD - synchronized standard
 54: $       output where only the first processor opens
 55: $       the file.  All other processors send their 
 56: $       data to the first processor to print. 

 58:    The user can open alternative visualization contexts with
 59: $    PetscViewerFileOpenASCII() - output vector to a specified file
 60: $    PetscViewerFileOpenBinary() - output in binary to a
 61: $         specified file; corresponding input uses VecLoad()
 62: $    PetscViewerDrawOpenX() - output vector to an X window display
 63: $    DrawLGCreate() - output vector as a line graph to an X window display
 64: $    PetscViewerMatlabOpen() - output vector to Matlab viewer

 66:   Level: beginner

 68: .keywords: view, visualize, output, print, write, draw
 69: .seealso: MatView()
 70: @*/
 71: int GMatView(GMat mat, PetscViewer viewer)
 72: {
 73:   Grid grid;
 74:   int  ierr;

 79:   if (!viewer) {
 80:     viewer = PETSC_VIEWER_STDOUT_SELF;
 81:   } else {
 83:   }
 84:   GMatGetGrid(mat, &grid);
 85:   (*grid->ops->gmatview)(mat, viewer);
 86:   return(0);
 87: }

 89: /*@ 
 90:   GMatSerialize - This function stores or recreates a grid matrix using a viewer for
 91:   a binary file.

 93:   Input Parameters:
 94: . viewer - The viewer context
 95: . store  - This flag is PETSC_TRUE is data is being written, otherwise it will be read

 97:   Output Parameter:
 98: . m      - The grid matrix

100:   Level: beginner

102: .keywords: grid vector, serialize
103: .seealso: GridSerialize()
104: @*/
105: int GMatSerialize(Grid grid, GMat *m, PetscViewer viewer, PetscTruth store)
106: {
107:   int          fd;
108:   GMat         mat;
109:   MatInfo      info;
110:   PetscScalar *vals, *vals2;
111:   int         *cols, *cols2;
112:   int         *diag;
113:   int         *offdiag;
114:   int         *firstCol;
115:   int          type, rowVars, rowLocVars, colVars, colLocVars, numNonZeros;
116:   int          rowStart, rowEnd, colStart, colEnd, offset, size;
117:   int          numProcs, rank;
118:   int          proc, row, col;
119:   PetscTruth   match;
120:   int          ierr;


127:   PetscTypeCompare((PetscObject) viewer, PETSC_VIEWER_BINARY, &match);
128:   if (match == PETSC_FALSE) SETERRQ(PETSC_ERR_ARG_WRONG, "Must be binary viewer");
129:   PetscViewerBinaryGetDescriptor(viewer, &fd);
130:   if (store) {
132:     MatGetSize(*m, &rowVars, &colVars);
133:     MatGetLocalSize(*m, &rowLocVars, &colLocVars);
134:     MatGetInfo(*m, MAT_LOCAL, &info);
135:     MatGetOwnershipRange(*m, &rowStart, &rowEnd);
136:     PetscBinaryWrite(fd, &(*m)->cookie, 1,            PETSC_INT,     0);
137:     PetscBinaryWrite(fd, &rowVars,      1,            PETSC_INT,     0);
138:     PetscBinaryWrite(fd, &rowLocVars,   1,            PETSC_INT,     0);
139:     PetscBinaryWrite(fd, &colVars,      1,            PETSC_INT,     0);
140:     PetscBinaryWrite(fd, &colLocVars,   1,            PETSC_INT,     0);
141:     PetscBinaryWrite(fd, &info.nz_used, 1,            PETSC_INT,     0);
142:     numNonZeros = (int) info.nz_used;
143:     PetscMalloc((rowLocVars*2 + numNonZeros) * sizeof(int) + numNonZeros * sizeof(PetscScalar), &diag);
144:     offdiag = diag + rowLocVars;
145:     cols = offdiag + rowLocVars;
146:     vals = (PetscScalar *) (cols + numNonZeros);
147:     PetscMemzero(diag, rowLocVars*2 * sizeof(int));
148:     MPI_Comm_size(grid->comm, &numProcs);
149:     MPI_Comm_rank(grid->comm, &rank);
150:     PetscMalloc((numProcs+1) * sizeof(int), &firstCol);
151:     MPI_Allgather(&colLocVars, 1, MPI_INT, &firstCol[1], 1, MPI_INT, grid->comm);
152:     for(proc = 1, firstCol[0] = 0; proc <= numProcs; proc++)
153:       firstCol[proc] += firstCol[proc-1];
154:     if (firstCol[numProcs] != colVars) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid column partition");
155:     colStart = firstCol[rank];
156:     colEnd   = firstCol[rank+1];
157:     for(row = rowStart, offset = 0; row < rowEnd; row++, offset += size) {
158:       MatGetRow(*m, row, &size, &cols2, &vals2);
159:       for(col = 0; col < size; col++)
160:         if ((col >= colStart) && (col < colEnd)) {
161:           diag[row]++;
162:         } else {
163:           offdiag[row]++;
164:         }
165:       PetscMemcpy(&cols[offset], cols2, size * sizeof(int));
166:       PetscMemcpy(&vals[offset], vals2, size * sizeof(PetscScalar));
167:       MatRestoreRow(*m, row, &size, &cols2, &vals2);
168:     }
169:     PetscBinaryWrite(fd,  diag,         rowLocVars,   PETSC_INT,     0);
170:     PetscBinaryWrite(fd,  offdiag,      rowLocVars,   PETSC_INT,     0);
171:     PetscBinaryWrite(fd,  cols,         numNonZeros,  PETSC_INT,     0);
172:     PetscBinaryWrite(fd,  vals,         numNonZeros,  PETSC_SCALAR,  0);
173:     PetscFree(diag);
174:     PetscFree(offdiag);
175:     PetscFree(cols);
176:     PetscFree(vals);
177:   } else {
178:     PetscBinaryRead(fd, &type,        1,           PETSC_INT);
179:     if (type != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_ARG_WRONG, "Non-matrix object");
180:     PetscBinaryRead(fd, &rowVars,     1,           PETSC_INT);
181:     PetscBinaryRead(fd, &rowLocVars,  1,           PETSC_INT);
182:     PetscBinaryRead(fd, &colVars,     1,           PETSC_INT);
183:     PetscBinaryRead(fd, &colLocVars,  1,           PETSC_INT);
184:     PetscBinaryRead(fd, &numNonZeros, 1,           PETSC_INT);
185:     MPI_Reduce(&rowLocVars, &size, 1, MPI_INT, MPI_SUM, 0, grid->comm);
186:     if (size != rowVars) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid row partition");
187:     MPI_Reduce(&colLocVars, &size, 1, MPI_INT, MPI_SUM, 0, grid->comm);
188:     if (size != colVars) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid column partition");
189:     PetscMalloc((rowLocVars*2 + numNonZeros) * sizeof(int) + numNonZeros * sizeof(PetscScalar), &diag);
190:     offdiag = diag + rowLocVars;
191:     cols = offdiag + rowLocVars;
192:     vals = (PetscScalar *) (cols + numNonZeros);
193:     PetscBinaryRead(fd,  diag,        rowLocVars,  PETSC_INT);
194:     PetscBinaryRead(fd,  offdiag,     rowLocVars,  PETSC_INT);
195:     MatCreateMPIAIJ(grid->comm, rowLocVars, colLocVars, rowVars, colVars, 0, diag, 0, offdiag, &mat);
196:     PetscObjectCompose((PetscObject) mat, "Grid", (PetscObject) grid);
197:     MatGetOwnershipRange(mat, &rowStart, &rowEnd);
198:     if (rowEnd - rowStart + 1 != rowLocVars) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid row partition");
199:     PetscBinaryRead(fd, cols,         numNonZeros, PETSC_INT);
200:     PetscBinaryRead(fd, vals,         numNonZeros, PETSC_SCALAR);
201:     for(row = rowStart, offset = 0; row < rowEnd; row++, offset += size)
202:     {
203:       size = diag[row] + offdiag[row];
204:       MatSetValues(mat, 1, &row, size, &cols[offset], &vals[offset], INSERT_VALUES);
205:     }
206:     PetscFree(diag);
207:     PetscFree(offdiag);
208:     PetscFree(cols);
209:     PetscFree(vals);

211:     MatAssemblyBegin(mat, MAT_FINAL_ASSEMBLY);
212:     MatAssemblyEnd(mat, MAT_FINAL_ASSEMBLY);
213:     *m   = mat;
214:   }
215:   return(0);
216: }

218: /*@C
219:   GMatDuplicate - Duplicates a grid vector.

221:   Input Parameters:
222: . mat - The matrix

224:   Level: beginner

226: .keywords: grid matrix, destroy
227: .seealso: MatDuplicate(), GMatDestroy()
228: @*/
229: int GMatDuplicate(GMat mat, GMat *newmat)
230: {
231:   int  ierr;

236:   MatConvert(mat, MATSAME, newmat);
237:   PetscFunctionReturn(ierr);
238: }

240: /*@
241:    GMatGetSize - Returns the numbers of rows and columns in a matrix.

243:    Not Collective

245:    Input Parameter:
246: .  mat - the matrix

248:    Output Parameters:
249: +  M - the number of global rows
250: -  N - the number of global columns

252:    Level: intermediate

254: .keywords: matrix, dimension, size, rows, columns, global, get
255: .seealso: GMatGetLocalSize()
256: @*/
257: int GMatGetSize(GMat mat, int *M, int* N)
258: {
259:   Grid       grid;
260:   PetscTruth isConstrained       = PETSC_FALSE;
261:   PetscTruth explicitConstraints = PETSC_TRUE;
262:   int        gM, gN;
263:   int        ierr;

267:   GMatGetGrid(mat, &grid);
268:   GridIsConstrained(grid, &isConstrained);
269:   GridGetExplicitConstraints(grid, &explicitConstraints);
270:   if ((isConstrained == PETSC_FALSE) || (explicitConstraints == PETSC_TRUE)) {
271:     if (M) *M = mat->M;
272:     if (N) *N = mat->N;
273:   } else {
274:     GridGetConstraints(grid, PETSC_NULL, PETSC_NULL, &gM, PETSC_NULL);
275:     gN = gM;
276:     /* KLUDGE - Must catch matrices which arise from nonstandard orderings
277:     if (mat->N == x->N) gN = x->N;
278:     if (mat->M == y->N) gM = y->N; */
279:     if (M) *M = gM;
280:     if (N) *N = gN;
281:   }
282:   return(0);
283: }

285: /*@
286:    GMatGetLocalSize - Returns the number of rows and columns in a matrix
287:    stored locally.  This information may be implementation dependent, so
288:    use with care.

290:    Not Collective

292:    Input Parameters:
293: .  mat - the matrix

295:    Output Parameters:
296: +  m - the number of local rows
297: -  n - the number of local columns

299:    Level: intermediate

301: .keywords: matrix, dimension, size, local, rows, columns, get
302: .seealso: GMatGetSize()
303: @*/
304: int GMatGetLocalSize(GMat mat, int *m, int* n)
305: {
306:   Grid       grid;
307:   PetscTruth isConstrained       = PETSC_FALSE;
308:   PetscTruth explicitConstraints = PETSC_TRUE;
309:   int        gm, gn;
310:   int        ierr;

314:   GMatGetGrid(mat, &grid);
315:   GridIsConstrained(grid, &isConstrained);
316:   GridGetExplicitConstraints(grid, &explicitConstraints);
317:   if ((isConstrained == PETSC_FALSE) || (explicitConstraints == PETSC_TRUE)) {
318:     if (m) *m = mat->m;
319:     if (n) *n = mat->n;
320:   } else {
321:     GridGetConstraints(grid, PETSC_NULL, PETSC_NULL, PETSC_NULL, &gm);
322:     gn = gm;
323:     /* KLUDGE - Must catch matrices which arise from nonstandard orderings
324:     if (mat->n == x->n) gn = x->n;
325:     if (mat->m == y->n) gm = y->n; */
326:     if (m) *m = gm;
327:     if (n) *n = gn;
328:   }
329:   return(0);
330: }

332: /*@
333:   GMatGetGrid - This function returns the grid from a grid matrix.

335:   Not collective

337:   Input Parameter:
338: . m    - The grid matrix

340:   Output Parameter:
341: . grid - The grid

343:   Level: intermediate

345: .keywords: grid matrix, grid, get
346: .seealso: GridGetMesh(), GVecGetGrid()
347: @*/
348: int GMatGetGrid(GMat m, Grid *grid)
349: {


356:   PetscObjectQuery((PetscObject) m, "Grid", (PetscObject *) grid);
358:   return(0);
359: }

361: /*@
362:   GMatGetOrder - This function returns the orderings from a grid matrix.

364:   Not collective

366:   Input Parameter:
367: . m    - The grid matrix

369:   Output Parameters:
370: + rowOrder - The row (or test function) ordering
371: - colOrder - The column (or shape function) ordering

373:   Level: intermediate

375: .keywords: grid matrix, variable ordering, get
376: .seealso: GMatGetGrid(), GVecGetOrder()
377: @*/
378: int GMatGetOrder(GMat m, VarOrdering *rowOrder, VarOrdering *colOrder)
379: {


385:   if (rowOrder != PETSC_NULL) {
387:     PetscObjectQuery((PetscObject) m, "RowOrder", (PetscObject *) rowOrder);
389:   }
390:   if (colOrder != PETSC_NULL) {
392:     PetscObjectQuery((PetscObject) m, "ColOrder", (PetscObject *) colOrder);
394:   }
395:   return(0);
396: }

398: /*@
399:   GMatGetDiagonalConstrained - This function returns the diagonal of a constrained matrix.

401:   Input Paramter:
402: . mat  - The grid matrix

404:   Output Paramter:
405: . diag - A constrained grid vector containing the diagonal elements

407:    Level: advanced

409: .keyowrds grid matrix, constraint
410: .seealso MatGetDiagonal()
411: @*/
412: int GMatGetDiagonalConstrained(GMat mat, GVec diag)
413: {
414:   Grid         grid;
415:   PetscTruth   isConstrained, explicitConstraints;
416:   Vec          diagLong;
417:   PetscScalar *array;
418:   PetscScalar *arrayC;
419:   int         *ordering;
420:   int          numInteriorVars;
421:   int          var, size;
422:   int          ierr;

427:   GMatGetGrid(mat, &grid);
428:   GridIsConstrained(grid, &isConstrained);
429:   GridGetExplicitConstraints(grid, &explicitConstraints);
430:   if ((isConstrained == PETSC_FALSE) || (explicitConstraints == PETSC_TRUE)) {
431:     MatGetDiagonal(mat, diag);
432:     return(0);
433:   }

435:   VecGetLocalSize(diag, &size);
436:   if (size != grid->constraintOrder->numLocVars) SETERRQ(PETSC_ERR_ARG_INCOMP, "Vector wrong size for matrix");
437:   ISGetSize(grid->constraintOrdering, &size);
438:   if (size != grid->order->numLocVars) SETERRQ(PETSC_ERR_ARG_INCOMP, "Constraint mapping wrong size for matrix");

440:   /* First copy all the interior variables */
441:   GVecCreate(grid, &diagLong);
442:   MatGetDiagonal(mat, diagLong);
443:   VecGetArray(diagLong, &array);
444:   VecGetArray(diag,     &arrayC);
445:   ISGetIndices(grid->constraintOrdering, &ordering);
446:   numInteriorVars = grid->constraintOrder->numLocVars - grid->constraintOrder->numLocNewVars;
447:   for(var = 0; var < grid->order->numLocVars; var++) {
448:     if (ordering[var] < numInteriorVars)   {
449:       if (PetscAbsScalar(array[var]) > PETSC_MACHINE_EPSILON)
450:         arrayC[ordering[var]] = array[var];
451:       else
452:         arrayC[ordering[var]] = 1.0;
453:     }
454:   }
455:   ISRestoreIndices(grid->constraintOrdering, &ordering);
456:   VecRestoreArray(diagLong, &array);
457:   VecRestoreArray(diag,     &arrayC);
458:   GVecDestroy(diagLong);

460:   /* Now ask grid for diagonal of extra variables */
461:   if ((isConstrained == PETSC_TRUE) && (grid->constraintCtx->ops->jacgetdiag)) {
462:     (*grid->constraintCtx->ops->jacgetdiag)(mat, diag);
463:   }

465:   return(0);
466: }

468: /*@
469:   GMatGetDiagonalMF - This function returns the diagonal of the matrix.

471:   Input Parameter:
472: . mat  - The grid matrix

474:   Output Parameter:
475: . diag - A grid vector containing the diagonal elements

477:   Notes:
478:   See comments in GMatGetDiagonalConstrained() about dealing with implicit constraints

480:   Level: intermediate

482: .keywords grid matrix, constraint
483: .seealso GMatGetDiagonalConstrained
484: @*/
485: int GMatGetDiagonalMF(GMat mat, GVec diag)
486: {
487:   Grid grid;
488:   int  ierr;

493:   GMatGetGrid(mat, &grid);
494:   GVecEvaluateJacobianDiagonal(diag, grid->matrixFreeArg, grid->matrixFreeContext);
495:   return(0);
496: }

498: /*@
499:    GMatDiagonalScaleConstrained - Scales a constrained matrix on the left and
500:    right by diagonal matrices that are stored as vectors. Either of the two scaling
501:    matrices can be PETSC_NULL.

503:    Input Parameters:
504: .  mat - The grid matrix to be scaled
505: .  l   - The left scaling vector (or PETSC_NULL)
506: .  r   - The right scaling vector (or PETSC_NULL)

508:    Notes:
509:    GMatDiagonalScaleConstrained() computes A <- LAR, where
510: $      L = a diagonal matrix
511: $      R = a diagonal matrix

513:   Level: advanced

515: .keywords: matrix, diagonal, scale
516: .seealso: MatDiagonalScale()
517: @*/
518: int GMatDiagonalScaleConstrained(GMat mat, GVec l, GVec r)
519: {
520:   Grid         grid;
521:   GVec         newL, newR;
522:   PetscScalar *arrayL, *arrayR;
523:   PetscScalar *arrayNewL, *arrayNewR;
524:   PetscScalar  one = 1.0;
525:   int         *ordering;
526:   int          numInteriorVars;
527:   int          var, size;
528:   int          ierr;

532:   GMatGetGrid(mat, &grid);
534:   if (grid->isConstrained == PETSC_FALSE) {
535:     MatDiagonalScale(mat, l, r);
536:     return(0);
537:   }
538:   ISGetSize(grid->constraintOrdering, &size);
539:   if (size != grid->order->numLocVars) SETERRQ(PETSC_ERR_ARG_INCOMP, "Constraint mapping wrong size for matrix");

541:   newL   = PETSC_NULL;
542:   newR   = PETSC_NULL;
543:   arrayL = PETSC_NULL;
544:   arrayR = PETSC_NULL;
545:   numInteriorVars = grid->constraintOrder->numLocVars - grid->constraintOrder->numLocNewVars;
546:   ISGetIndices(grid->constraintOrdering, &ordering);
547:   if (l != PETSC_NULL)
548:   {
550:     VecGetLocalSize(l, &size);
551:     if (size != grid->constraintOrder->numLocVars) SETERRQ(PETSC_ERR_ARG_INCOMP, "Left vector wrong size for matrix");
552:     GVecCreate(grid, &newL);
553:     VecSet(&one, newL);
554:     VecGetArray(l,    &arrayL);
555:     VecGetArray(newL, &arrayNewL);
556:     for(var = 0; var < grid->order->numLocVars; var++) {
557:       if (ordering[var] < numInteriorVars)
558:         arrayNewL[var] = arrayL[ordering[var]];
559:     }
560:     VecRestoreArray(l,    &arrayL);
561:     VecRestoreArray(newL, &arrayNewL);
562:   }
563:   if (r != PETSC_NULL) {
565:     VecGetLocalSize(r, &size);
566:     if (size != grid->constraintOrder->numLocVars) SETERRQ(PETSC_ERR_ARG_INCOMP, "Right vector wrong size for matrix");
567:     GVecCreate(grid, &newR);
568:     VecSet(&one, newR);
569:     VecGetArray(r,    &arrayR);
570:     VecGetArray(newR, &arrayNewR);
571:     for(var = 0; var < grid->order->numLocVars; var++) {
572:       if (ordering[var] < numInteriorVars)
573:         arrayNewR[var] = arrayR[ordering[var]];
574:     }
575:     VecRestoreArray(r,    &arrayR);
576:     VecRestoreArray(newR, &arrayNewR);
577:   }
578:   ISRestoreIndices(grid->constraintOrdering, &ordering);

580:   MatDiagonalScale(mat, newL, newR);

582:   if (l != PETSC_NULL) {
583:     VecDestroy(newL);
584:   }
585:   if (r != PETSC_NULL) {
586:     VecDestroy(newR);
587:   }
588:   return(0);
589: }

591: /*@
592:   GMatOrderConstrained - This function creates an ordering which places
593:   all interior variables before variables eliminated by constraints.

595:   Input Paramter:
596: . mat   - The grid matrix
597: . type  - The reordering type

599:   Output Paramter:
600: . rowIS - The row reordering
601: . colIS - The column reordering

603:   Level: advanced

605: .keyowrds grid matrix, constraint
606: .seealso GMatGetDiagonalConstrained()
607: @*/
608: int GMatOrderConstrained(GMat mat, MatOrderingType type, IS *rowIS, IS *colIS)
609: {
610:   Grid       grid;
611:   PetscTruth opt, match;
612:   int        ierr;

618:   PetscStrcmp(type, MATORDERING_CONSTRAINED, &match);
619:   if (match == PETSC_FALSE) SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid ordering type %s", type);
620:   GMatGetGrid(mat, &grid);
621:   if (grid->constraintOrdering) {
622:     ISDuplicate(grid->constraintOrdering, rowIS);
623:     ISDuplicate(grid->constraintOrdering, colIS);
624:     PetscOptionsHasName(PETSC_NULL, "-gmat_order_nonzero_diagonal", &opt);
625:     if (opt == PETSC_TRUE) {
626:       /* Remove the zeros from the diagonal in both blocks */
627:       GMatReorderForNonzeroDiagonalConstrained(mat, 1e-10, *rowIS, *colIS);
628:     }
629:   } else {
630:     *rowIS = PETSC_NULL;
631:     *colIS = PETSC_NULL;
632:   }
633:   return(0);
634: }

636: /*
637:   GMatFindPreviousPivot_Private - Finds a pivot element in the lower
638:   triangle which does not introduce a zero on the above diagonal.

640:   Input Parameters:
641: . mat     - The grid matrix
642: . prow    - The row with a zero pivot
643: . rowPerm - The row permutation
644: . colPerm - The column permutation
645: . atol    - The smallest acceptable pivot

647:   Output Paramters:
648: . replCol - The column to interchange with
649: . replVal - The magnitude of the new pivot

651:   Level: developer
652: */
653: int GMatFindPreviousPivot_Private(GMat mat, int prow, int *rowPerm, int *colPerm, double atol, int *replCol, double *replVal)
654: {
655:   int          nz;
656:   int         *cols;
657:   PetscScalar *vals;
658:   int          newNz;
659:   int         *newCols;
660:   PetscScalar *newVals;
661:   int          newRow;
662:   int          repl;
663:   int          colIndex, newColIndex;
664:   int          ierr;

667:   newRow = rowPerm[prow];
668:   MatGetRow(mat, prow, &nz, &cols, &vals);
669:   for(colIndex = 0; colIndex < nz; colIndex++)
670:   {
671:     /* Find an acceptable pivot in the lower triangle */
672:     if ((colPerm[cols[colIndex]] < newRow) && (PetscAbsScalar(vals[colIndex]) > atol))
673:     {
674:       /* Check previous diagonal for zero pivot */
675:       repl = cols[colIndex];
676:       MatGetRow(mat, repl, &newNz, &newCols, &newVals);
677:       for(newColIndex = 0; newColIndex < newNz; newColIndex++)
678:       {
679:         if ((colPerm[newCols[newColIndex]] == newRow) && (PetscAbsScalar(newVals[newColIndex]) > atol))
680:         {
681:           *replCol = repl;
682:           *replVal = PetscAbsScalar(vals[colIndex]);
683:           MatRestoreRow(mat, repl, &newNz, &newCols, &newVals);
684:           MatRestoreRow(mat, prow, &nz,    &cols,    &vals);
685:           return(0);
686:         }
687:       }
688:       MatRestoreRow(mat, repl, &newNz, &newCols, &newVals);
689:     }
690:   }
691:   MatRestoreRow(mat, prow, &nz, &cols, &vals);
692:   /* Signal error since no acceptable pivot was found */
693:   PetscFunctionReturn(1);
694: }

696: /*
697:   GMatReorderForNonzeroDiagonal_Private - This is identical to
698:   MatReorderForNonzeroDiagonal(), but allows reordering of a
699:   block of the matrix.

701:   Input Parameters:
702: . mat      - The grid matrix to reorder
703: . rowStart - The first row in the block
704: . rowEnd   - The last row in the block
705: . rowIS    - The row permutation, usually obtained from GMatOrderConstrained().
706: . colIS    - The column permutation

708:   Level: developer

710: */
711: int GMatReorderForNonzeroDiagonal_Private(GMat mat, int rowStart, int rowEnd, double atol, IS rowIS, IS colIS)
712: {
713:   int         *rowPerm;
714:   int         *colPerm;
715:   int          m, n, nz;
716:   int         *cols;
717:   PetscScalar *vals;
718:   int          replCol; /* Replacement column in the original matrix */
719:   double       replVal; /* Replacement pivot magnitude */
720:   int          prow;    /* Pivot row in the original matrix */
721:   int          newRow;  /* Pivot row in the permuted matrix */
722:   int          temp;
723:   int          colIndex;
724:   int          ierr;

727:   ISGetIndices(rowIS, &rowPerm);
728:   ISGetIndices(colIS, &colPerm);
729:   MatGetSize(mat, &m, &n);

731:   for(prow = 0; prow < m; prow++)
732:   {
733:     newRow = rowPerm[prow]; /* Row in the permuted matrix */

735:     /* Act only on a block in the reordered matrix */
736:     if ((newRow < rowStart) || (newRow >= rowEnd))
737:       continue;
738:     MatGetRow(mat, prow, &nz, &cols, &vals);

740:     /* Find diagonal element */
741:     for(colIndex = 0; colIndex < nz; colIndex++)
742:       if (colPerm[cols[colIndex]] == newRow)
743:         break;

745:     /* Check for zero pivot */
746:     if ((colIndex >= nz) || (PetscAbsScalar(vals[colIndex]) <= atol))
747:     {
748:       /* Find the best candidate in the upper triangular part */
749:       replCol = prow;
750:       if (colIndex >= nz)
751:         replVal = 0.0;
752:       else
753:         replVal = PetscAbsScalar(vals[colIndex]);
754:       for(colIndex = 0; colIndex < nz; colIndex++)
755:       {
756:         /* Stay within block and upper triangle */
757:         if ((colPerm[cols[colIndex]] <= newRow) || (colPerm[cols[colIndex]] >= rowEnd))
758:           continue;

760:         /* Check for acceptable pivot */
761:         if (PetscAbsScalar(vals[colIndex]) > atol)
762:         {
763:           replCol = cols[colIndex];
764:           replVal = PetscAbsScalar(vals[colIndex]);
765:           break;
766:         }
767:       }

769:       /* No candidate was found */
770:       if (prow == replCol)
771:       {
772:         /* Now we need to look for an element that allows us
773:            to pivot with a previous column.  To do this, we need
774:            to be sure that we don't introduce a zero in a previous
775:            diagonal */
776:         if (GMatFindPreviousPivot_Private(mat, prow, rowPerm, colPerm, atol, &replCol, &replVal)) {
777:           SETERRQ(PETSC_ERR_ARG_WRONG, "Can not reorder matrix for nonzero diagonal");
778:         }
779:       }

781:       /* Interchange columns */
782:       temp             = colPerm[prow];
783:       colPerm[prow]    = colPerm[replCol];
784:       colPerm[replCol] = temp;
785:     }
786:     MatRestoreRow(mat, prow, &nz, &cols, &vals);
787:   }

789:   ISRestoreIndices(rowIS, &rowPerm);
790:   ISRestoreIndices(colIS, &colPerm);
791:   return(0);
792: }

794: /*@
795:   GMatReorderForNonzeroDiagonalConstrained - Changes matrix ordering
796:   to remove zeros from diagonal. This may help in the LU factorization
797:   to prevent a zero pivot.

799:   Input Parameters:
800: . mat   - The grid matrix to reorder
801: . atol  - The smallest acceptable pivot
802: . rowIS - The row permutation, usually obtained from GMatOrderConstrained().
803: . colIS - The column permutation

805:   Notes:
806:   This is not intended as a replacement for pivoting for matrices that
807:   have ``bad'' structure. It is only a stop-gap measure. Should be called
808:   after a call to MatGetReordering(), this routine changes the column 
809:   ordering defined in cis.

811:   Options Database Keys: (When using SLES)
812: . -gmat_order_nonzero_diagonal

814:   Algorithm:
815:   Column pivoting is used.  Choice of column is made by looking at the
816:   non-zero elements in the row.  This algorithm is simple and fast but
817:   does NOT guarantee that a non-singular or well conditioned
818:   principle submatrix will be produced.

820:   Level: developer
821: @*/
822: int GMatReorderForNonzeroDiagonalConstrained(GMat mat, double atol, IS rowIS, IS colIS)
823: {
824:   Grid grid;
825:   int  m;
826:   int  mInt;
827:   int  ierr;


834:   GMatGetGrid(mat, &grid);
835:   if (grid->isConstrained == PETSC_FALSE)
836:   {
837:     MatReorderForNonzeroDiagonal(mat, atol, rowIS, colIS);
838:     return(0);
839:   }

841:   /* Get size of matrix blocks */
842:   mInt = grid->constraintOrder->numLocVars - grid->constraintOrder->numLocNewVars;
843:   m    = grid->order->numVars;
844:   /* Reorder interior block    */
845:   GMatReorderForNonzeroDiagonal_Private(mat, 0, mInt, atol, rowIS, colIS);
846:   /* Reorder constrained block */
847:   GMatReorderForNonzeroDiagonal_Private(mat, mInt, m, atol, rowIS, colIS);
848:   return(0);
849: }

851: /*@
852:   GMatReorder - Reorders the matrix based on the ordering type provided.

854:   Collective on GMat

856:   Input Parameters:
857: . mat    - The grid matrix to reorder
858: . rowIS  - The row permutation, usually obtained from MatGetOrdering()
859: . colIS  - The column permutation
860: . sparse - The flag for sparsification
861: . bw     - [Optional] The sparsified bandwidth, PETSC_DECIDE gives the default
862: . frac   - [Optional] The sparsified fractional bandwidth, 0.0 gives the default
863: . tol    - [Optional] The sparsification drop tolerance, 0.0 is the default

865:   Output Parameter:
866: . newmat - The reordered, and possibly sparsified, matrix

868:   Options Database Keys:
869: . -gmat_order_nonzero_diagonal

871:   Level: advanced

873: .keywords: grid matrix, ordering
874: .seealso: MatGetOrdering(), MatPermute(), MatPermuteSparsify()
875: @*/
876: int GMatReorder(GMat mat, IS rowIS, IS colIS, PetscTruth sparse, int bw, double frac, double tol, GMat *newmat)
877: {
878:   Grid grid;
879:   int  ierr;


887:   if (sparse == PETSC_TRUE) {
888:     MatPermuteSparsify(mat, bw, frac, tol, rowIS, colIS, newmat);
889:   } else {
890:     MatPermute(mat, rowIS, colIS, newmat);
891:   }
892:   GMatGetGrid(mat, &grid);
893:   PetscObjectCompose((PetscObject) *newmat, "Grid", (PetscObject) grid);
894:   return(0);
895: }

897: /*@
898:   GMatEvaluateALEOperatorGalerkin - Evaluates the weak form of an operator over
899:   a field on the locations defined by the underlying grid and its discretization.

901:   Collective on GMat

903:   Input Parameters:
904: + M         - The grid matrix
905: . numFields - The number of fields in sFields and tFields
906: . sFields   - The shape function fields
907: . sOrder    - The global variable ordering for the shape functions
908: . sLocOrder - The local variable ordering for the shape functions
909: . tFields   - The test function fields
910: . tOrder    - The global variable ordering for the test functions
911: . tLocOrder - The local variable ordering for the test functions
912: . op        - The operator
913: . alpha     - A scalar multiple for the operator
914: . type      - The matrix assembly type
915: - ctx       - An optional user provided context for the function

917:   Level: intermediate

919: .keywords: grid matrix, evaluate, ALE, operator
920: .seealso: GMatEvaluateSystemMatrix()
921: @*/
922: int GMatEvaluateALEOperatorGalerkin(GMat M, int numFields, int *sFields, VarOrdering sOrder, LocalVarOrdering sLocOrder,
923:                                     int *tFields, VarOrdering tOrder, LocalVarOrdering tLocOrder, int op, PetscScalar alpha,
924:                                     MatAssemblyType type, void *ctx)
925: {
926:   Grid grid;
927:   int  field;
928:   int  ierr;


939:   GMatGetGrid(M, &grid);
941:   for(field = 0; field < numFields; field++)
942:   {
943:     /* Check for valid fields */
944:     if ((sFields[field] < 0) || (sFields[field] > grid->numFields)) {
945:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid field number");
946:     }
947:     if ((tFields[field] < 0) || (tFields[field] > grid->numFields)) {
948:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid field number");
949:     }
950:     /* Check for valid operator */
951:     if ((op < 0) || (op >= grid->fields[sFields[field]].disc->numOps) || (!grid->fields[sFields[field]].disc->operators[op])) {
952:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
953:     }
954:     if ((grid->fields[sFields[field]].disc->operators[op]->precompInt == PETSC_NULL) &&
955:         (grid->fields[sFields[field]].disc->operators[op]->opFunc     == PETSC_NULL) &&
956:         (grid->fields[sFields[field]].disc->operators[op]->ALEOpFunc  == PETSC_NULL)) {
957:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
958:     }
959:     if (grid->fields[sFields[field]].disc->numQuadPoints != grid->fields[tFields[field]].disc->numQuadPoints) {
960:       SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible quadrature sets");
961:     }
962:   }
963:   /* Check for compatible orderings */
964:   if ((tOrder->numVars != M->M) || (tOrder->numLocVars != M->m)) {
965:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible test function ordering");
966:   }
967:   if ((sOrder->numVars != M->N) || (sOrder->numLocVars != M->n)) {
968:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible shape function ordering");
969:   }

971:   PetscLogEventBegin(GMAT_EvaluateOperatorGalerkin, M, grid, sOrder, tOrder);
972:   (*grid->ops->gmatevaluatealeoperatorgalerkin)(grid, M, numFields, sFields, sOrder, sLocOrder,
973:                                                        tFields, tOrder, tLocOrder, op, alpha, type, ctx);
974: 
975:   PetscLogEventEnd(GMAT_EvaluateOperatorGalerkin, M, grid, sOrder, tOrder);
976:   return(0);
977: }

979: /*@
980:   GMatEvaluateOperatorGalerkin - Evaluates the weak form of an operator over
981:   a field on the locations defined by the underlying grid and its discretization.

983:   Collective on GMat

985:   Input Parameter:
986: + M         - The grid matrix
987: . x         - The argument vector
988: . numFields - The number of fields in sFields and tFields
989: . sFields   - The shape function fields
990: . tFields   - The test function fields
991: . op        - The operator
992: . alpha     - The scalar multiple for the operator
993: . type      - The matrix assembly type
994: - ctx       - [Optional] A user provided context for the function

996:   Level: intermediate

998: .keywords: grid matrix, evaluate, operator, galerkin
999: .seealso: GMatEvaluateOperatorGalerkin(), GMatEvaluateSystemMatrix()
1000: @*/
1001: int GMatEvaluateOperatorGalerkin(GMat M, GVec x, int numFields, int *sFields, int *tFields, int op, PetscScalar alpha,
1002:                                  MatAssemblyType type, void *ctx)
1003: {
1004:   Grid             grid;
1005:   VarOrdering      sOldOrder, tOldOrder;
1006:   VarOrdering      sOrder,    tOrder;
1007:   LocalVarOrdering sLocOrder, tLocOrder;
1008:   VarOrdering      xOrder;
1009:   PetscTruth       compat;
1010:   int              numTotalFields;
1011:   int              f;
1012:   int              ierr;


1019:   GMatGetGrid(M, &grid);
1020:   GMatGetOrder(M, &tOldOrder, &sOldOrder);
1021:   if (x != PETSC_NULL) {
1023:     GVecGetOrder(x, &xOrder);
1024:     VarOrderingCompatible(xOrder, tOldOrder, &compat);
1025:     if (compat == PETSC_FALSE) SETERRQ(PETSC_ERR_ARG_INCOMP, "Matrix and vector must have compatible maps");
1026:   }
1027:   GridGetNumFields(grid, &numTotalFields);
1028:   for(f = 0; f < numFields; f++) {
1029:     /* Check for valid fields */
1030:     if ((sFields[f] < 0) || (sFields[f] >= numTotalFields)) SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid field number %d", sFields[f]);
1031:     if ((tFields[f] < 0) || (tFields[f] >= numTotalFields)) SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid field number %d", tFields[f]);
1032:     /* Check for valid operator */
1033:     if ((op < 0) || (op >= grid->fields[sFields[f]].disc->numOps) || (!grid->fields[sFields[f]].disc->operators[op])) {
1034:       SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid operator %d", op);
1035:     }
1036:     if ((grid->fields[sFields[f]].disc->operators[op]->precompInt == PETSC_NULL) &&
1037:         (grid->fields[sFields[f]].disc->operators[op]->opFunc     == PETSC_NULL) &&
1038:         (grid->fields[sFields[f]].disc->operators[op]->ALEOpFunc  == PETSC_NULL)) {
1039:       SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid operator %d", op);
1040:     }
1041:     if (grid->fields[sFields[f]].disc->numQuadPoints != grid->fields[tFields[f]].disc->numQuadPoints) {
1042:       SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible quadrature sets");
1043:     }
1044:   }
1045:   /* Create orderings */
1046:   VarOrderingCreateSubset(sOldOrder, numFields, sFields, PETSC_FALSE, &sOrder);
1047:   LocalVarOrderingCreate(grid, numFields, sFields, &sLocOrder);
1048:   VarOrderingCreateSubset(tOldOrder, numFields, tFields, PETSC_FALSE, &tOrder);
1049:   LocalVarOrderingCreate(grid, numFields, tFields, &tLocOrder);
1050:   /* Check for compatible orderings */
1051:   if ((tOrder->numVars != M->M) || (tOrder->numLocVars != M->m)) {
1052:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible test function ordering");
1053:   }
1054:   if ((sOrder->numVars != M->N) || (sOrder->numLocVars != M->n)) {
1055:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible shape function ordering");
1056:   }
1057:   /* Calculate operator */
1058:   PetscLogEventBegin(GMAT_EvaluateOperatorGalerkin, M, grid, sOrder, tOrder);
1059:   (*grid->ops->gmatevaluateoperatorgalerkin)(grid, M, x, sOrder, sLocOrder, tOrder, tLocOrder, op, alpha, type, ctx);
1060: 
1061:   PetscLogEventEnd(GMAT_EvaluateOperatorGalerkin, M, grid, sOrder, tOrder);
1062:   /* Destroy orderings */
1063:   VarOrderingDestroy(sOrder);
1064:   LocalVarOrderingDestroy(sLocOrder);
1065:   VarOrderingDestroy(tOrder);
1066:   LocalVarOrderingDestroy(tLocOrder);
1067:   return(0);
1068: }

1070: /*@
1071:   GMatEvaluateALEConstrainedOperatorGalerkin - Evaluates the weak form of an operator over
1072:   a field on the locations defined by the underlying grid and its discretization. The
1073:   constrained variable space is used for the shape and test functions.

1075:   Collective on GMat

1077:   Input Parameters:
1078: + M         - The grid matrix
1079: . numFields - The number of fields in sFields and tFields
1080: . sFields   - The shape function fields
1081: . sOrder    - The global variable ordering for the shape functions
1082: . sLocOrder - The local variable ordering for the shape functions
1083: . tFields   - The test function fields
1084: . tOrder    - The global variable ordering for the test functions
1085: . tLocOrder - The local variable ordering for the test functions
1086: . op        - The operator
1087: . alpha     - A scalar multiple for the operator
1088: . type      - The matrix assembly type
1089: - ctx       - An optional user provided context for the function

1091:   Level: intermediate

1093: .keywords: grid matrix, evaluate, ALE, operator, constraint
1094: .seealso: GMatEvaluateALEOperatorGalerkin(), GMatEvaluateSystemMatrix()
1095: @*/
1096: int GMatEvaluateALEConstrainedOperatorGalerkin(GMat M, int numFields, int *sFields, VarOrdering sOrder, LocalVarOrdering sLocOrder,
1097:                                                int *tFields, VarOrdering tOrder, LocalVarOrdering tLocOrder, int op, PetscScalar alpha,
1098:                                                MatAssemblyType type, void *ctx)
1099: {
1100:   Grid grid;
1101:   int  field;
1102:   int  ierr;


1113:   GMatGetGrid(M, &grid);
1115:   if (grid->isConstrained == PETSC_FALSE) {
1116:     GMatEvaluateALEOperatorGalerkin(M, numFields, sFields, sOrder, sLocOrder, tFields, tOrder, tLocOrder, op, alpha, type, ctx);
1117: 
1118:     return(0);
1119:   }
1120:   for(field = 0; field < numFields; field++) {
1121:     /* Check for valid fields */
1122:     if ((sFields[field] < 0) || (sFields[field] > grid->numFields)) {
1123:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid field number");
1124:     }
1125:     if ((tFields[field] < 0) || (tFields[field] > grid->numFields)) {
1126:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid field number");
1127:     }
1128:     /* Check for valid operator */
1129:     if ((op < 0) || (op >= grid->fields[sFields[field]].disc->numOps) || (!grid->fields[sFields[field]].disc->operators[op])) {
1130:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
1131:     }
1132:     if ((grid->fields[sFields[field]].disc->operators[op]->precompInt == PETSC_NULL) &&
1133:         (grid->fields[sFields[field]].disc->operators[op]->opFunc     == PETSC_NULL) &&
1134:         (grid->fields[sFields[field]].disc->operators[op]->ALEOpFunc  == PETSC_NULL)) {
1135:       SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
1136:     }
1137:     if (grid->fields[sFields[field]].disc->numQuadPoints != grid->fields[tFields[field]].disc->numQuadPoints) {
1138:       SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible quadrature sets");
1139:     }
1140:   }
1141:   /* Check for compatible orderings */
1142:   if ((tOrder->numVars != M->M) || (tOrder->numLocVars != M->m)) {
1143:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible test function ordering");
1144:   }
1145:   if ((sOrder->numVars != M->N) || (sOrder->numLocVars != M->n)) {
1146:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible shape function ordering");
1147:   }

1149:   (*grid->ops->gmatevaluatealeconstrainedoperatorgalerkin)(grid, M, numFields, sFields, sOrder, sLocOrder,
1150:                                                                   tFields, tOrder, tLocOrder, op, alpha, type, ctx);
1151: 
1152:   return(0);
1153: }

1155: /*@
1156:   GMatEvaluateBoundaryOperatorGalerkin - Evaluates the weak form of an operator over
1157:   a field on the locations defined by the boundary of the underlying grid and its
1158:   discretization. The test function are defined on the entire grid, but the only nonzeros
1159:   come from functions with support on the boundary.

1161:   Input Parameter:
1162: . M      - The grid matrix
1163: . numFields - The number of fields in sFields and tFields
1164: . sFields   - The shape function fields
1165: . sOrder    - The global variable ordering for the shape functions 
1166: . sLocOrder - The local variable ordering for the shape functions 
1167: . tFields   - The test function fields
1168: . tOrder    - The global variable ordering for the test functions 
1169: . tLocOrder - The local variable ordering for the test functions 
1170: . op        - The operator
1171: . alpha     - A scalar multiple for the operator
1172: . type      - The matrix assembly type
1173: . ctx       - An optional user provided context for the function

1175:   Level: intermediate

1177: .seealso: GMatEvaluateOperatorGalerkin, GMatEvaluateSystemMatrix
1178: @*/
1179: int GMatEvaluateBoundaryOperatorGalerkin(GMat M, int numFields, int *sFields, VarOrdering sOrder, LocalVarOrdering sLocOrder,
1180:                                          int *tFields, VarOrdering tOrder, LocalVarOrdering tLocOrder, int op, PetscScalar alpha,
1181:                                          MatAssemblyType type, void *ctx)
1182: {
1183:   Grid grid;
1184:   int  numTotalFields;
1185:   int  f;
1186:   int  ierr;


1197:   GMatGetGrid(M, &grid);
1198:   GridGetNumFields(grid, &numTotalFields);
1199:   for(f = 0; f < numFields; f++) {
1200:     /* Check for valid fields */
1201:     if ((sFields[f] < 0) || (sFields[f] >= numTotalFields)) SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid field number %d", sFields[f]);
1202:     if ((tFields[f] < 0) || (tFields[f] >= numTotalFields)) SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid field number %d", tFields[f]);
1203:     /* Check for valid operator */
1204:     if ((op < 0) || (op >= grid->fields[sFields[f]].disc->numOps) || (!grid->fields[sFields[f]].disc->operators[op])) {
1205:       SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid operator %d", op);
1206:     }
1207:     if ((grid->fields[sFields[f]].disc->operators[op]->precompInt == PETSC_NULL) &&
1208:         (grid->fields[sFields[f]].disc->operators[op]->opFunc     == PETSC_NULL) &&
1209:         (grid->fields[sFields[f]].disc->operators[op]->ALEOpFunc  == PETSC_NULL)) {
1210:       SETERRQ1(PETSC_ERR_ARG_WRONG, "Invalid operator %d", op);
1211:     }
1212:     if (grid->fields[sFields[f]].disc->numQuadPoints != grid->fields[tFields[f]].disc->numQuadPoints) {
1213:       SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible quadrature sets");
1214:     }
1215:   }
1216:   /* Check for compatible orderings */
1217:   if ((tOrder->numVars != M->M) || (tOrder->numLocVars != M->m)) {
1218:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible test function ordering");
1219:   }
1220:   if ((sOrder->numVars != M->N) || (sOrder->numLocVars != M->n)) {
1221:     SETERRQ(PETSC_ERR_ARG_INCOMP, "Incompatible shape function ordering");
1222:   }

1224:   (*grid->ops->gmatevaluateboundaryoperatorgalerkin)(grid, M, PETSC_NULL, sOrder, sLocOrder, tOrder, tLocOrder,
1225:                                                             op, alpha, type, ctx);
1226: 
1227:   return(0);
1228: }

1230: /*@
1231:   GMatEvaluateNewFields - Evaluates the weak form of the system operators over
1232:   the new fields introduced by constraints. These fields are generally not
1233:   discretized using the computational mesh.

1235:   Collective on GMat

1237:   Input Parameters:
1238: + M     - The grid matrix
1239: - type  - The matrix assembly type

1241:   Level: intermediate

1243: .keywords grid matrix, evaluate, new field
1244: .seealso: GMatEvaluateOperatorGalerkin()
1245: @*/
1246: int GMatEvaluateNewFields(GMat M, int numFields, int *sFields, VarOrdering sOrder, LocalVarOrdering sLocOrder,
1247:                           int *tFields, VarOrdering tOrder, LocalVarOrdering tLocOrder, PetscScalar alpha, MatAssemblyType type)
1248: {
1249:   Grid grid;
1250:   int  ierr;

1254:   GMatGetGrid(M, &grid);
1262:   if (numFields != 1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Only one constrained field allowed currently");
1263:   if (sFields[0] != tFields[0]) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Must form with constrained field currently");
1264:   if (grid->fields[sFields[0]].isConstrained == PETSC_FALSE) {
1265:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Only valid with constrained field currently");
1266:   }
1267: #if 0
1268:   PetscLogEventBegin(GMAT_EvaluateSystemMatrix, M, grid, 0, 0);
1269:   GMatEvaluateNewFields_Triangular_2D(grid, M, numFields, sFields, sOrder, sLocOrder, tFields,
1270:                                              tOrder, tLocOrder, alpha, type, grid->constraintCtx);
1271: 
1272:   PetscLogEventEnd(GMAT_EvaluateSystemMatrix, M, grid, 0, 0);
1273:   return(0);
1274: #else
1275:   SETERRQ(PETSC_ERR_SUP, "Coming soon");
1276: #endif
1277: }

1279: /*@
1280:   GMatMatMultConstrained - This function applies P^T A P to a vector,
1281:   where P is the constraint matrix for the grid.

1283:   Input Parameters:
1284: . A - The grid matrix
1285: . x - The input grid vector

1287:   Output Parameter:
1288: . y - The output grid vector P^T A P x

1290:   Level: intermediate

1292: .seealso: GMatEvaluateOperatorGalerkin
1293: @*/
1294: int GMatMatMultConstrained(GMat mat, GVec x, GVec y)
1295: {
1296:   Grid                  grid;
1297:   Mat                   P;
1298:   PetscConstraintObject ctx;
1299:   GTSContext            GTSctx;
1300:   int                   ierr;

1306:   GMatGetGrid(mat, &grid);
1308:   GridGetConstraintMatrix(grid, &P);
1309:   GridGetConstraintContext(grid, &ctx);
1310:   PetscObjectQuery((PetscObject) ctx, "GTSContext", (PetscObject *) &GTSctx);
1311:   PetscLogEventBegin(GMAT_MatMultConstrained, mat, x, y, 0);
1312:   /* End the current MatMult() timing */
1313:   PetscLogEventEnd(MAT_Mult, mat, x, y, 0);
1314:   MatMult(P, x, GTSctx->work[0]);
1315:   /* Time the multiply with the unconstrained matrix */
1316:   PetscLogEventBegin(MAT_Mult, mat, GTSctx->work[0], GTSctx->work[1], 0);
1317:   MatMultConstrained(mat, GTSctx->work[0], GTSctx->work[1]);
1318:   PetscLogEventEnd(MAT_Mult, mat, GTSctx->work[0], GTSctx->work[1], 0);
1319:   MatMultTranspose(P, GTSctx->work[1], y);
1320:   /* Add in new fields */
1321:   (*grid->constraintCtx->ops->applyjac)(grid, x, y);
1322:   /* Restart the current MatMult() timing */
1323:   PetscLogEventBegin(MAT_Mult, mat, x, y, 0);
1324:   PetscLogEventEnd(GMAT_MatMultConstrained, mat, x, y, 0);
1325:   return(0);
1326: }

1328: /*@
1329:   GMatMatMultMF - This function applies the operator matrix-free to the vector.

1331:   Input Parameters:
1332: + A - The grid matrix
1333: - x - The input grid vector

1335:   Output Parameter:
1336: . y - The output grid vector A x

1338:   Level: intermediate

1340: .seealso: GMatMatMultMFConstrained
1341: @*/
1342: int GMatMatMultMF(GMat mat, GVec x, GVec y)
1343: {
1344:   PetscScalar zero = 0.0;
1345:   Grid        grid;
1346:   int         ierr;

1352:   GMatGetGrid(mat, &grid);
1354:   VecSet(&zero, y);
1355:   GVecEvaluateJacobian(y, grid->matrixFreeArg, x, grid->matrixFreeContext);
1356:   return(0);
1357: }

1359: /*@
1360:   GMatMatMultTransposeConstrained - This function applies P^T A^T P to a vector,
1361:   where P is the constraint matrix for the grid.

1363:   Input Parameters:
1364: . A - The grid matrix
1365: . x - The input grid vector

1367:   Output Parameter:
1368: . y - The output grid vector P^T A^T P x

1370:   Level: intermediate

1372: .seealso: GMatEvaluateOperatorGalerkin
1373: @*/
1374: int GMatMatMultTransposeConstrained(GMat mat, GVec x, GVec y)
1375: {
1376:   Grid                  grid;
1377:   Mat                   P;
1378:   PetscConstraintObject ctx;
1379:   GTSContext            GTSctx;
1380:   int                   ierr;

1386:   GMatGetGrid(mat, &grid);
1388:   GridGetConstraintMatrix(grid, &P);
1389:   GridGetConstraintContext(grid, &ctx);
1390:   PetscObjectQuery((PetscObject) ctx, "GTSContext", (PetscObject *) &GTSctx);
1391:   PetscLogEventBegin(GMAT_MatMultTransposeConstrained, mat, x, y, 0);
1392:   /* End the current MatMult() timing */
1393:   PetscLogEventEnd(MAT_MultTranspose, mat, x, y, 0);
1394:   MatMult(P, x, GTSctx->work[0]);
1395:   /* Time the multiply with the unconstrained matrix */
1396:   PetscLogEventBegin(MAT_MultTranspose, mat, GTSctx->work[0], GTSctx->work[1], 0);
1397:   MatMultTransposeConstrained(mat, GTSctx->work[0], GTSctx->work[1]);
1398:   PetscLogEventEnd(MAT_MultTranspose, mat, GTSctx->work[0], GTSctx->work[1], 0);
1399:   MatMultTranspose(P, GTSctx->work[1], y);
1400:   /* Add in new fields */
1401:   (*grid->constraintCtx->ops->applyjac)(grid, x, y);
1402:   /* Restart the current MatMult() timing */
1403:   PetscLogEventBegin(MAT_MultTranspose, mat, x, y, 0);
1404:   PetscLogEventEnd(GMAT_MatMultTransposeConstrained, mat, x, y, 0);
1405:   return(0);
1406: }

1408: /*@
1409:   GMatSetBoundary - Applies the specified Dirichlet boundary conditions to this matrix.

1411:   Input Parameter:
1412: . M    - The grid matrix
1413: . diag - The scalar to place on the diagonal
1414: . ctx  - An optional user provided context for the function

1416:   Level: intermediate

1418: .seealso: GridSetBC(), GridAddBC()
1419: @*/
1420: int GMatSetBoundary(GMat M, PetscScalar diag, void *ctx)
1421: {
1422:   Grid grid;
1423:   int  bc;
1424:   int  num;
1425:   int *bd;
1426:   int *field;
1427:   int  ierr;

1431:   GMatGetGrid(M, &grid);
1433:   PetscLogEventBegin(GMAT_SetBoundary, M, grid, 0, 0);
1434:   for(bc = 0, num = 0; bc < grid->numBC; bc++) {
1435:     if (grid->bc[bc].reduce == PETSC_FALSE) num++;
1436:   }
1437:   if (num > 0) {
1438:     PetscMalloc(num * sizeof(int), &bd);
1439:     PetscMalloc(num * sizeof(int), &field);
1440:     for(bc = 0, num = 0; bc < grid->numBC; bc++) {
1441:       if (grid->bc[bc].reduce == PETSC_FALSE) {
1442:         bd[num]      = grid->bc[bc].boundary;
1443:         field[num++] = grid->bc[bc].field;
1444:       }
1445:     }
1446:     GridSetMatBoundaryRectangular(num, bd, field, diag, grid->order, M, ctx);
1447:     PetscFree(bd);
1448:     PetscFree(field);
1449:   }
1450:   for(bc = 0; bc < grid->numPointBC; bc++) {
1451:     if (grid->pointBC[bc].reduce == PETSC_FALSE) {
1452:       GridSetMatPointBoundary(grid->pointBC[bc].node, grid->pointBC[bc].field, diag, M, ctx);
1453:     }
1454:   }
1455:   PetscLogEventEnd(GMAT_SetBoundary, M, grid, 0, 0);
1456:   return(0);
1457: }

1459: /*@
1460:    GMatCreate - Creates a sparse matrix with the appropriate preallocation
1461:    of nonzeros for a discretization of an operator on the grid.

1463:    Input Parameter:
1464: .  grid - The grid 

1466:    Output Parameters:
1467: .  gmat - The discrete operator

1469:   Level: beginner

1471: .seealso: GVecCreate()
1472: @*/
1473: int GMatCreate(Grid grid, GMat *gmat)
1474: {

1480:   GMatCreateRectangular(grid, grid->order, grid->order, gmat);
1481:   return(0);
1482: }

1484: /*@
1485:   GMatCreateRectangular - Creates a sparse matrix with the appropriate preallocation
1486:   of nonzeros for a discretization of an operator on the grid. A different
1487:   set of fields may be speicifed for the shape and test discretizations.

1489:   Input Parameter:
1490: . grid   - The grid 
1491: . sOrder - The shape function ordering
1492: . tOrder - The test function ordering

1494:   Output Parameters:
1495: . gmat   - The discrete operator

1497:   Level: beginner

1499: .seealso: GMatCreate()
1500: @*/
1501: int GMatCreateRectangular(Grid grid, VarOrdering sOrder, VarOrdering tOrder, GMat *gmat)
1502: {
1503:   VarOrdering shapeOrder = sOrder;
1504:   VarOrdering testOrder  = tOrder;
1505:   int         ierr;

1508:   if (shapeOrder == PETSC_NULL)
1509:     shapeOrder = grid->order;
1510:   if (testOrder  == PETSC_NULL)
1511:     testOrder  = grid->order;

1517:   GridSetUp(grid);
1518:   PetscLogEventBegin(GMAT_CreateRectangular, grid, shapeOrder, testOrder, 0);
1519:   (*grid->ops->gridcreategmat)(grid, shapeOrder, testOrder, PETSC_FALSE, gmat);
1520:   PetscLogEventEnd(GMAT_CreateRectangular, grid, shapeOrder, testOrder, 0);
1521:   PetscObjectCompose((PetscObject) *gmat, "RowOrder", (PetscObject) tOrder);
1522:   PetscObjectCompose((PetscObject) *gmat, "ColOrder", (PetscObject) sOrder);
1523:   return(0);
1524: }

1526: int GMatDummy0(GMat mat) {
1528:   return(0);
1529: }

1531: /*@
1532:   GMatCreateMF - Creates a matrix-free operator. A different
1533:   set of fields may be speicifed for the shape and test discretizations.

1535:   Input Parameter:
1536: . grid   - The grid 
1537: . sOrder - The shape function ordering
1538: . tOrder - The test function ordering

1540:   Output Parameters:
1541: . gmat   - The discrete operator

1543:   Level: beginner

1545: .seealso: GMatCreateRectangular()
1546: @*/
1547: int GMatCreateMF(Grid grid, VarOrdering sOrder, VarOrdering tOrder, GMat *gmat)
1548: {
1549:   VarOrdering shapeOrder = sOrder;
1550:   VarOrdering testOrder  = tOrder;
1551:   int         ierr;

1554:   if (shapeOrder == PETSC_NULL) shapeOrder = grid->order;
1555:   if (testOrder  == PETSC_NULL) testOrder  = grid->order;

1561:   GridSetUp(grid);
1562:   PetscLogEventBegin(GMAT_CreateRectangular, grid, shapeOrder, testOrder, 0);
1563:   MatCreateShell(grid->comm, tOrder->numLocVars, sOrder->numLocVars, tOrder->numVars, sOrder->numVars, grid, gmat);
1564: 
1565:   if (grid->isConstrained == PETSC_TRUE) {
1566:     if (grid->explicitConstraints == PETSC_FALSE) {
1567:       MatShellSetOperation(*gmat, MATOP_MULT,             (void (*)(void)) GMatMatMultConstrained);
1568:       MatShellSetOperation(*gmat, MATOP_MULT_CONSTRAINED, (void (*)(void)) GMatMatMultMF);
1569:     } else {
1570:       MatShellSetOperation(*gmat, MATOP_MULT,             (void (*)(void)) GMatMatMultMF);
1571:     }
1572:   } else {
1573:     MatShellSetOperation(*gmat, MATOP_MULT,               (void (*)(void)) GMatMatMultMF);
1574:   }
1575:   MatShellSetOperation(*gmat, MATOP_ZERO_ENTRIES,         (void (*)(void)) GMatDummy0);
1576:   MatShellSetOperation(*gmat, MATOP_GET_DIAGONAL,         (void (*)(void)) GMatGetDiagonalMF);
1577:   PetscObjectCompose((PetscObject) *gmat, "Grid", (PetscObject) grid);
1578:   MatSetOption(*gmat, MAT_NEW_NONZERO_ALLOCATION_ERR);
1579:   PetscLogEventEnd(GMAT_CreateRectangular, grid, shapeOrder, testOrder, 0);
1580:   PetscObjectCompose((PetscObject) *gmat, "RowOrder", (PetscObject) tOrder);
1581:   PetscObjectCompose((PetscObject) *gmat, "ColOrder", (PetscObject) sOrder);
1582:   return(0);
1583: }

1585: /*@
1586:   GMatCreateBoundaryRestriction - Creates a sparse matrix with the
1587:   appropriate preallocation of nonzeros for a discretization of an
1588:   operator on the boundary of the grid.

1590:   Collective on Grid

1592:   Input Parameter:
1593: . grid - The grid 

1595:   Output Parameter:
1596: . gmat - The grid matrix

1598:   Level: beginner

1600: .keywords: grid matrix, boundary, create
1601: .seealso: GMatCreate(), GVecCreate()
1602: @*/
1603: int GMatCreateBoundaryRestriction(Grid grid, GMat *gmat)
1604: {

1610:   GridSetUp(grid);
1611:   GridSetupBoundary(grid);
1612:   (*grid->ops->gridcreategmat)(grid, grid->bdOrder, grid->order, PETSC_TRUE, gmat);
1613:   PetscObjectCompose((PetscObject) *gmat, "RowOrder", (PetscObject) grid->order);
1614:   PetscObjectCompose((PetscObject) *gmat, "ColOrder", (PetscObject) grid->bdOrder);
1615:   return(0);
1616: }