/*@ MatFDColoringApply - Given a matrix for which a MatFDColoring context has been created, computes the Jacobian for a function via finite differences. Collective on MatFDColoring Input Parameters: + mat - location to store Jacobian . coloring - coloring context created with MatFDColoringCreate() . x1 - location at which Jacobian is to be computed - sctx - context required by function, if this is being used with the SNES solver then it is SNES object, otherwise it is null Options Database Keys: + -mat_fd_type - "wp" or "ds" (see MATMFFD_WP or MATMFFD_DS) . -mat_fd_coloring_view - Activates basic viewing or coloring . -mat_fd_coloring_view draw - Activates drawing of coloring - -mat_fd_coloring_view ::ascii_info - Activates viewing of coloring info Level: intermediate .seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView(), MatFDColoringSetFunction() .keywords: coloring, Jacobian, finite differences @*/ PetscErrorCode MatFDColoringApply(Mat J,MatFDColoring coloring,Vec x1,void *sctx) { PetscErrorCode ierr; PetscBool flg = PETSC_FALSE; PetscFunctionBegin; PetscValidHeaderSpecific(J,MAT_CLASSID,1); PetscValidHeaderSpecific(coloring,MAT_FDCOLORING_CLASSID,2); PetscValidHeaderSpecific(x1,VEC_CLASSID,3); if (!coloring->f) SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()"); if (!J->ops->fdcoloringapply) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not supported for this matrix type %s",((PetscObject)J)->type_name); if (!coloring->setupcalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetUp()"); ierr = MatSetUnfactored(J);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr); if (flg) { ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr); } else { PetscBool assembled; ierr = MatAssembled(J,&assembled);CHKERRQ(ierr); if (assembled) { ierr = MatZeroEntries(J);CHKERRQ(ierr); } } ierr = PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr); ierr = (*J->ops->fdcoloringapply)(J,coloring,x1,sctx);CHKERRQ(ierr); ierr = PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode TSPrecond_Sundials(realtype tn,N_Vector y,N_Vector fy, booleantype jok,booleantype *jcurPtr, realtype _gamma,void *P_data, N_Vector vtemp1,N_Vector vtemp2,N_Vector vtemp3) { TS ts = (TS) P_data; TS_Sundials *cvode = (TS_Sundials*)ts->data; PC pc = cvode->pc; PetscErrorCode ierr; Mat Jac = ts->B; Vec yy = cvode->w1; PetscScalar one = 1.0,gm; MatStructure str = DIFFERENT_NONZERO_PATTERN; PetscScalar *y_data; PetscFunctionBegin; /* This allows us to construct preconditioners in-place if we like */ ierr = MatSetUnfactored(Jac);CHKERRQ(ierr); /* jok - TRUE means reuse current Jacobian else recompute Jacobian */ if (jok) { ierr = MatCopy(cvode->pmat,Jac,str);CHKERRQ(ierr); *jcurPtr = FALSE; } else { /* make PETSc vector yy point to SUNDIALS vector y */ y_data = (PetscScalar *) N_VGetArrayPointer(y); ierr = VecPlaceArray(yy,y_data); CHKERRQ(ierr); /* compute the Jacobian */ ierr = TSComputeRHSJacobian(ts,ts->ptime,yy,&Jac,&Jac,&str);CHKERRQ(ierr); ierr = VecResetArray(yy); CHKERRQ(ierr); /* copy the Jacobian matrix */ if (!cvode->pmat) { ierr = MatDuplicate(Jac,MAT_COPY_VALUES,&cvode->pmat);CHKERRQ(ierr); ierr = PetscLogObjectParent(ts,cvode->pmat);CHKERRQ(ierr); } else { ierr = MatCopy(Jac,cvode->pmat,str);CHKERRQ(ierr); } *jcurPtr = TRUE; } /* construct I-gamma*Jac */ gm = -_gamma; ierr = MatScale(Jac,gm);CHKERRQ(ierr); ierr = MatShift(Jac,one);CHKERRQ(ierr); ierr = PCSetOperators(pc,Jac,Jac,str);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode DMCoarsen_Plex(DM dm, MPI_Comm comm, DM *dmCoarsened) { DM_Plex *mesh = (DM_Plex*) dm->data; #ifdef PETSC_HAVE_PRAGMATIC DM udm, coordDM; DMLabel bd; Mat A; Vec coordinates, mb, mx; PetscSection coordSection; const PetscScalar *coords; double *coarseCoords; IS bdIS; PetscReal *x, *y, *z, *eqns, *metric; PetscReal coarseRatio = PetscSqr(0.5); const PetscInt *faces; PetscInt *cells, *bdFaces, *bdFaceIds; PetscInt dim, numCorners, cStart, cEnd, numCells, numCoarseCells, c, vStart, vEnd, numVertices, numCoarseVertices, v, numBdFaces, f, maxConeSize, size, bdSize, coff; #endif PetscErrorCode ierr; PetscFunctionBegin; #ifdef PETSC_HAVE_PRAGMATIC if (!mesh->coarseMesh) { ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); ierr = DMGetCoordinateDM(dm, &coordDM);CHKERRQ(ierr); ierr = DMGetDefaultSection(coordDM, &coordSection);CHKERRQ(ierr); ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr); ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); ierr = DMPlexUninterpolate(dm, &udm);CHKERRQ(ierr); ierr = DMPlexGetMaxSizes(udm, &maxConeSize, NULL);CHKERRQ(ierr); numCells = cEnd - cStart; numVertices = vEnd - vStart; ierr = PetscCalloc5(numVertices, &x, numVertices, &y, numVertices, &z, numVertices*PetscSqr(dim), &metric, numCells*maxConeSize, &cells);CHKERRQ(ierr); ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr); for (v = vStart; v < vEnd; ++v) { PetscInt off; ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr); x[v-vStart] = coords[off+0]; y[v-vStart] = coords[off+1]; if (dim > 2) z[v-vStart] = coords[off+2]; } ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr); for (c = 0, coff = 0; c < numCells; ++c) { const PetscInt *cone; PetscInt coneSize, cl; ierr = DMPlexGetConeSize(udm, c, &coneSize);CHKERRQ(ierr); ierr = DMPlexGetCone(udm, c, &cone);CHKERRQ(ierr); for (cl = 0; cl < coneSize; ++cl) cells[coff++] = cone[cl] - vStart; } switch (dim) { case 2: pragmatic_2d_init(&numVertices, &numCells, cells, x, y); break; case 3: pragmatic_3d_init(&numVertices, &numCells, cells, x, y, z); break; default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No Pragmatic coarsening defined for dimension %d", dim); } /* Create boundary mesh */ ierr = DMLabelCreate("boundary", &bd);CHKERRQ(ierr); ierr = DMPlexMarkBoundaryFaces(dm, bd);CHKERRQ(ierr); ierr = DMLabelGetStratumIS(bd, 1, &bdIS);CHKERRQ(ierr); ierr = DMLabelGetStratumSize(bd, 1, &numBdFaces);CHKERRQ(ierr); ierr = ISGetIndices(bdIS, &faces);CHKERRQ(ierr); for (f = 0, bdSize = 0; f < numBdFaces; ++f) { PetscInt *closure = NULL; PetscInt closureSize, cl; ierr = DMPlexGetTransitiveClosure(dm, faces[f], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); for (cl = 0; cl < closureSize*2; cl += 2) { if ((closure[cl] >= vStart) && (closure[cl] < vEnd)) ++bdSize; } ierr = DMPlexRestoreTransitiveClosure(dm, f, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); } ierr = PetscMalloc2(bdSize, &bdFaces, numBdFaces, &bdFaceIds);CHKERRQ(ierr); for (f = 0, bdSize = 0; f < numBdFaces; ++f) { PetscInt *closure = NULL; PetscInt closureSize, cl; ierr = DMPlexGetTransitiveClosure(dm, faces[f], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); for (cl = 0; cl < closureSize*2; cl += 2) { if ((closure[cl] >= vStart) && (closure[cl] < vEnd)) bdFaces[bdSize++] = closure[cl] - vStart; } /* TODO Fix */ bdFaceIds[f] = 1; ierr = DMPlexRestoreTransitiveClosure(dm, f, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); } ierr = ISDestroy(&bdIS);CHKERRQ(ierr); ierr = DMLabelDestroy(&bd);CHKERRQ(ierr); pragmatic_set_boundary(&numBdFaces, bdFaces, bdFaceIds); /* Create metric */ size = (dim*(dim+1))/2; ierr = PetscMalloc1(PetscSqr(size), &eqns);CHKERRQ(ierr); ierr = MatCreateSeqDense(PETSC_COMM_SELF, size, size, eqns, &A);CHKERRQ(ierr); ierr = MatCreateVecs(A, &mx, &mb);CHKERRQ(ierr); ierr = VecSet(mb, 1.0);CHKERRQ(ierr); for (c = 0; c < numCells; ++c) { const PetscScalar *sol; PetscScalar *cellCoords = NULL; PetscReal e[3], vol; const PetscInt *cone; PetscInt coneSize, cl, i, j, d, r; ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, NULL, &cellCoords);CHKERRQ(ierr); /* Only works for simplices */ for (i = 0, r = 0; i < dim+1; ++i) { for (j = 0; j < i; ++j, ++r) { for (d = 0; d < dim; ++d) e[d] = cellCoords[i*dim+d] - cellCoords[j*dim+d]; /* FORTRAN ORDERING */ if (dim == 2) { eqns[0*size+r] = PetscSqr(e[0]); eqns[1*size+r] = 2.0*e[0]*e[1]; eqns[2*size+r] = PetscSqr(e[1]); } else { eqns[0*size+r] = PetscSqr(e[0]); eqns[1*size+r] = 2.0*e[0]*e[1]; eqns[2*size+r] = 2.0*e[0]*e[2]; eqns[3*size+r] = PetscSqr(e[1]); eqns[4*size+r] = 2.0*e[1]*e[2]; eqns[5*size+r] = PetscSqr(e[2]); } } } ierr = MatSetUnfactored(A);CHKERRQ(ierr); ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, NULL, &cellCoords);CHKERRQ(ierr); ierr = MatLUFactor(A, NULL, NULL, NULL);CHKERRQ(ierr); ierr = MatSolve(A, mb, mx);CHKERRQ(ierr); ierr = VecGetArrayRead(mx, &sol);CHKERRQ(ierr); ierr = DMPlexComputeCellGeometryFVM(dm, c, &vol, NULL, NULL);CHKERRQ(ierr); ierr = DMPlexGetCone(udm, c, &cone);CHKERRQ(ierr); ierr = DMPlexGetConeSize(udm, c, &coneSize);CHKERRQ(ierr); for (cl = 0; cl < coneSize; ++cl) { const PetscInt v = cone[cl] - vStart; if (dim == 2) { metric[v*4+0] += vol*coarseRatio*sol[0]; metric[v*4+1] += vol*coarseRatio*sol[1]; metric[v*4+2] += vol*coarseRatio*sol[1]; metric[v*4+3] += vol*coarseRatio*sol[2]; } else { metric[v*9+0] += vol*coarseRatio*sol[0]; metric[v*9+1] += vol*coarseRatio*sol[1]; metric[v*9+3] += vol*coarseRatio*sol[1]; metric[v*9+2] += vol*coarseRatio*sol[2]; metric[v*9+6] += vol*coarseRatio*sol[2]; metric[v*9+4] += vol*coarseRatio*sol[3]; metric[v*9+5] += vol*coarseRatio*sol[4]; metric[v*9+7] += vol*coarseRatio*sol[4]; metric[v*9+8] += vol*coarseRatio*sol[5]; } } ierr = VecRestoreArrayRead(mx, &sol);CHKERRQ(ierr); } for (v = 0; v < numVertices; ++v) { const PetscInt *support; PetscInt supportSize, s; PetscReal vol, totVol = 0.0; ierr = DMPlexGetSupport(udm, v+vStart, &support);CHKERRQ(ierr); ierr = DMPlexGetSupportSize(udm, v+vStart, &supportSize);CHKERRQ(ierr); for (s = 0; s < supportSize; ++s) {ierr = DMPlexComputeCellGeometryFVM(dm, support[s], &vol, NULL, NULL);CHKERRQ(ierr); totVol += vol;} for (s = 0; s < PetscSqr(dim); ++s) metric[v*PetscSqr(dim)+s] /= totVol; } ierr = VecDestroy(&mx);CHKERRQ(ierr); ierr = VecDestroy(&mb);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = DMDestroy(&udm);CHKERRQ(ierr); ierr = PetscFree(eqns);CHKERRQ(ierr); pragmatic_set_metric(metric); pragmatic_adapt(); /* Read out mesh */ pragmatic_get_info(&numCoarseVertices, &numCoarseCells); ierr = PetscMalloc1(numCoarseVertices*dim, &coarseCoords);CHKERRQ(ierr); switch (dim) { case 2: pragmatic_get_coords_2d(x, y); numCorners = 3; for (v = 0; v < numCoarseVertices; ++v) {coarseCoords[v*2+0] = x[v]; coarseCoords[v*2+1] = y[v];} break; case 3: pragmatic_get_coords_3d(x, y, z); numCorners = 4; for (v = 0; v < numCoarseVertices; ++v) {coarseCoords[v*3+0] = x[v]; coarseCoords[v*3+1] = y[v]; coarseCoords[v*3+2] = z[v];} break; default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No Pragmatic coarsening defined for dimension %d", dim); } pragmatic_get_elements(cells); /* TODO Read out markers for boundary */ ierr = DMPlexCreateFromCellList(PetscObjectComm((PetscObject) dm), dim, numCoarseCells, numCoarseVertices, numCorners, PETSC_TRUE, cells, dim, coarseCoords, &mesh->coarseMesh);CHKERRQ(ierr); pragmatic_finalize(); ierr = PetscFree5(x, y, z, metric, cells);CHKERRQ(ierr); ierr = PetscFree2(bdFaces, bdFaceIds);CHKERRQ(ierr); ierr = PetscFree(coarseCoords);CHKERRQ(ierr); } #endif ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr); *dmCoarsened = mesh->coarseMesh; PetscFunctionReturn(0); }
PetscErrorCode MatFDColoringApply_AIJ(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx) { PetscErrorCode (*f)(void*,Vec,Vec,void*) = (PetscErrorCode (*)(void*,Vec,Vec,void *))coloring->f; PetscErrorCode ierr; PetscInt k,start,end,l,row,col,srow,**vscaleforrow; PetscScalar dx,*y,*xx,*w3_array; PetscScalar *vscale_array; PetscReal epsilon = coloring->error_rel,umin = coloring->umin,unorm; Vec w1=coloring->w1,w2=coloring->w2,w3; void *fctx = coloring->fctx; PetscBool flg = PETSC_FALSE; PetscInt ctype=coloring->ctype,N,col_start=0,col_end=0; Vec x1_tmp; PetscFunctionBegin; PetscValidHeaderSpecific(J,MAT_CLASSID,1); PetscValidHeaderSpecific(coloring,MAT_FDCOLORING_CLASSID,2); PetscValidHeaderSpecific(x1,VEC_CLASSID,3); if (!f) SETERRQ(((PetscObject)J)->comm,PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()"); ierr = PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr); ierr = MatSetUnfactored(J);CHKERRQ(ierr); ierr = PetscOptionsGetBool(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg,PETSC_NULL);CHKERRQ(ierr); if (flg) { ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr); } else { PetscBool assembled; ierr = MatAssembled(J,&assembled);CHKERRQ(ierr); if (assembled) { ierr = MatZeroEntries(J);CHKERRQ(ierr); } } x1_tmp = x1; if (!coloring->vscale){ ierr = VecDuplicate(x1_tmp,&coloring->vscale);CHKERRQ(ierr); } if (coloring->htype[0] == 'w') { /* tacky test; need to make systematic if we add other approaches to computing h*/ ierr = VecNorm(x1_tmp,NORM_2,&unorm);CHKERRQ(ierr); } ierr = VecGetOwnershipRange(w1,&start,&end);CHKERRQ(ierr); /* OwnershipRange is used by ghosted x! */ /* Set w1 = F(x1) */ if (!coloring->fset) { ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr); ierr = (*f)(sctx,x1_tmp,w1,fctx);CHKERRQ(ierr); ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr); } else { coloring->fset = PETSC_FALSE; } if (!coloring->w3) { ierr = VecDuplicate(x1_tmp,&coloring->w3);CHKERRQ(ierr); ierr = PetscLogObjectParent(coloring,coloring->w3);CHKERRQ(ierr); } w3 = coloring->w3; /* Compute all the local scale factors, including ghost points */ ierr = VecGetLocalSize(x1_tmp,&N);CHKERRQ(ierr); ierr = VecGetArray(x1_tmp,&xx);CHKERRQ(ierr); ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr); if (ctype == IS_COLORING_GHOSTED){ col_start = 0; col_end = N; } else if (ctype == IS_COLORING_GLOBAL){ xx = xx - start; vscale_array = vscale_array - start; col_start = start; col_end = N + start; } for (col=col_start; col<col_end; col++){ /* Loop over each local column, vscale[col] = 1./(epsilon*dx[col]) */ if (coloring->htype[0] == 'w') { dx = 1.0 + unorm; } else { dx = xx[col]; } if (dx == (PetscScalar)0.0) dx = 1.0; if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0) dx = umin; else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin; dx *= epsilon; vscale_array[col] = (PetscScalar)1.0/dx; } if (ctype == IS_COLORING_GLOBAL) vscale_array = vscale_array + start; ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr); if (ctype == IS_COLORING_GLOBAL){ ierr = VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); } if (coloring->vscaleforrow) { vscaleforrow = coloring->vscaleforrow; } else SETERRQ(((PetscObject)J)->comm,PETSC_ERR_ARG_NULL,"Null Object: coloring->vscaleforrow"); /* Loop over each color */ ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr); for (k=0; k<coloring->ncolors; k++) { coloring->currentcolor = k; ierr = VecCopy(x1_tmp,w3);CHKERRQ(ierr); ierr = VecGetArray(w3,&w3_array);CHKERRQ(ierr); if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array - start; /* Loop over each column associated with color adding the perturbation to the vector w3. */ for (l=0; l<coloring->ncolumns[k]; l++) { col = coloring->columns[k][l]; /* local column of the matrix we are probing for */ if (coloring->htype[0] == 'w') { dx = 1.0 + unorm; } else { dx = xx[col]; } if (dx == (PetscScalar)0.0) dx = 1.0; if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0) dx = umin; else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin; dx *= epsilon; if (!PetscAbsScalar(dx)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed 0 differencing parameter"); w3_array[col] += dx; } if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array + start; ierr = VecRestoreArray(w3,&w3_array);CHKERRQ(ierr); /* Evaluate function at w3 = x1 + dx (here dx is a vector of perturbations) w2 = F(x1 + dx) - F(x1) */ ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr); ierr = (*f)(sctx,w3,w2,fctx);CHKERRQ(ierr); ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr); ierr = VecAXPY(w2,-1.0,w1);CHKERRQ(ierr); /* Loop over rows of vector, putting results into Jacobian matrix */ ierr = VecGetArray(w2,&y);CHKERRQ(ierr); for (l=0; l<coloring->nrows[k]; l++) { row = coloring->rows[k][l]; /* local row index */ col = coloring->columnsforrow[k][l]; /* global column index */ y[row] *= vscale_array[vscaleforrow[k][l]]; srow = row + start; ierr = MatSetValues(J,1,&srow,1,&col,y+row,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecRestoreArray(w2,&y);CHKERRQ(ierr); } /* endof for each color */ if (ctype == IS_COLORING_GLOBAL) xx = xx + start; ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr); ierr = VecRestoreArray(x1_tmp,&xx);CHKERRQ(ierr); coloring->currentcolor = -1; ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr); ierr = MatFDColoringViewFromOptions(coloring,"-mat_fd_coloring_view");CHKERRQ(ierr); PetscFunctionReturn(0); }