/*@ ISPairToList - convert an IS pair encoding an integer map to a list of ISs. Each IS on the output list contains the preimage for each index on the second input IS. The ISs on the output list are constructed on the subcommunicators of the input IS pair. Each subcommunicator corresponds to the preimage of some index j -- this subcomm contains exactly the ranks that assign some indices i to j. This is essentially the inverse of ISListToPair(). Collective on indis. Input arguments: + xis - domain IS - yis - range IS Output arguments: + listlen - length of islist - islist - list of ISs breaking up indis by color Note: + xis and yis must be of the same length and have congruent communicators. - The resulting ISs have subcommunicators in a "deadlock-free" order (see ISListToPair()). Level: advanced .seealso ISListToPair() @*/ PetscErrorCode ISPairToList(IS xis, IS yis, PetscInt *listlen, IS **islist) { PetscErrorCode ierr; IS indis = xis, coloris = yis; PetscInt *inds, *colors, llen, ilen, lstart, lend, lcount,l; PetscMPIInt rank, size, llow, lhigh, low, high,color,subsize; const PetscInt *ccolors, *cinds; MPI_Comm comm, subcomm; PetscFunctionBegin; PetscValidHeaderSpecific(xis, IS_CLASSID, 1); PetscValidHeaderSpecific(yis, IS_CLASSID, 2); PetscCheckSameComm(xis,1,yis,2); PetscValidIntPointer(listlen,3); PetscValidPointer(islist,4); ierr = PetscObjectGetComm((PetscObject)xis,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm, &size);CHKERRQ(ierr); /* Extract, copy and sort the local indices and colors on the color. */ ierr = ISGetLocalSize(coloris, &llen);CHKERRQ(ierr); ierr = ISGetLocalSize(indis, &ilen);CHKERRQ(ierr); if (llen != ilen) SETERRQ2(comm, PETSC_ERR_ARG_SIZ, "Incompatible IS sizes: %D and %D", ilen, llen); ierr = ISGetIndices(coloris, &ccolors);CHKERRQ(ierr); ierr = ISGetIndices(indis, &cinds);CHKERRQ(ierr); ierr = PetscMalloc2(ilen,&inds,llen,&colors);CHKERRQ(ierr); ierr = PetscMemcpy(inds,cinds,ilen*sizeof(PetscInt));CHKERRQ(ierr); ierr = PetscMemcpy(colors,ccolors,llen*sizeof(PetscInt));CHKERRQ(ierr); ierr = PetscSortIntWithArray(llen, colors, inds);CHKERRQ(ierr); /* Determine the global extent of colors. */ llow = 0; lhigh = -1; lstart = 0; lcount = 0; while (lstart < llen) { lend = lstart+1; while (lend < llen && colors[lend] == colors[lstart]) ++lend; llow = PetscMin(llow,colors[lstart]); lhigh = PetscMax(lhigh,colors[lstart]); ++lcount; } ierr = MPIU_Allreduce(&llow,&low,1,MPI_INT,MPI_MIN,comm);CHKERRQ(ierr); ierr = MPIU_Allreduce(&lhigh,&high,1,MPI_INT,MPI_MAX,comm);CHKERRQ(ierr); *listlen = 0; if (low <= high) { if (lcount > 0) { *listlen = lcount; if (!*islist) { ierr = PetscMalloc1(lcount, islist);CHKERRQ(ierr); } } /* Traverse all possible global colors, and participate in the subcommunicators for the locally-supported colors. */ lcount = 0; lstart = 0; lend = 0; for (l = low; l <= high; ++l) { /* Find the range of indices with the same color, which is not smaller than l. Observe that, since colors is sorted, and is a subsequence of [low,high], as soon as we find a new color, it is >= l. */ if (lstart < llen) { /* The start of the next locally-owned color is identified. Now look for the end. */ if (lstart == lend) { lend = lstart+1; while (lend < llen && colors[lend] == colors[lstart]) ++lend; } /* Now check whether the identified color segment matches l. */ if (colors[lstart] < l) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Locally owned color %D at location %D is < than the next global color %D", colors[lstart], lcount, l); } color = (PetscMPIInt)(colors[lstart] == l); /* Check whether a proper subcommunicator exists. */ ierr = MPIU_Allreduce(&color,&subsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); if (subsize == 1) subcomm = PETSC_COMM_SELF; else if (subsize == size) subcomm = comm; else { /* a proper communicator is necessary, so we create it. */ ierr = MPI_Comm_split(comm, color, rank, &subcomm);CHKERRQ(ierr); } if (colors[lstart] == l) { /* If we have l among the local colors, we create an IS to hold the corresponding indices. */ ierr = ISCreateGeneral(subcomm, lend-lstart,inds+lstart,PETSC_COPY_VALUES,*islist+lcount);CHKERRQ(ierr); /* Position lstart at the beginning of the next local color. */ lstart = lend; /* Increment the counter of the local colors split off into an IS. */ ++lcount; } if (subsize > 0 && subsize < size) { /* Irrespective of color, destroy the split off subcomm: a subcomm used in the IS creation above is duplicated into a proper PETSc comm. */ ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr); } } /* for (l = low; l < high; ++l) */ } /* if (low <= high) */ ierr = PetscFree2(inds,colors);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode PCGAMGCreateGraph(const Mat Amat, Mat *a_Gmat) { PetscErrorCode ierr; PetscInt Istart,Iend,Ii,jj,kk,ncols,nloc,NN,MM,bs; PetscMPIInt rank, size; MPI_Comm comm; Mat Gmat; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr); ierr = MatGetSize(Amat, &MM, &NN);CHKERRQ(ierr); ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr); nloc = (Iend-Istart)/bs; #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr); #endif if (bs > 1) { const PetscScalar *vals; const PetscInt *idx; PetscInt *d_nnz, *o_nnz; /* count nnz, there is sparcity in here so this might not be enough */ ierr = PetscMalloc1(nloc, &d_nnz);CHKERRQ(ierr); ierr = PetscMalloc1(nloc, &o_nnz);CHKERRQ(ierr); for (Ii = Istart, jj = 0; Ii < Iend; Ii += bs, jj++) { d_nnz[jj] = 0; for (kk=0; kk<bs; kk++) { ierr = MatGetRow(Amat,Ii+kk,&ncols,0,0);CHKERRQ(ierr); if (ncols > d_nnz[jj]) { d_nnz[jj] = ncols; /* very pessimistic but could be too low in theory */ o_nnz[jj] = ncols; if (d_nnz[jj] > nloc) d_nnz[jj] = nloc; if (o_nnz[jj] > (NN/bs-nloc)) o_nnz[jj] = NN/bs-nloc; } ierr = MatRestoreRow(Amat,Ii+kk,&ncols,0,0);CHKERRQ(ierr); } } /* get scalar copy (norms) of matrix -- AIJ specific!!! */ ierr = MatCreateAIJ(comm, nloc, nloc, PETSC_DETERMINE, PETSC_DETERMINE,0, d_nnz, 0, o_nnz, &Gmat);CHKERRQ(ierr); ierr = PetscFree(d_nnz);CHKERRQ(ierr); ierr = PetscFree(o_nnz);CHKERRQ(ierr); for (Ii = Istart; Ii < Iend; Ii++) { PetscInt dest_row = Ii/bs; ierr = MatGetRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr); for (jj=0; jj<ncols; jj++) { PetscInt dest_col = idx[jj]/bs; PetscScalar sv = PetscAbs(PetscRealPart(vals[jj])); ierr = MatSetValues(Gmat,1,&dest_row,1,&dest_col,&sv,ADD_VALUES);CHKERRQ(ierr); } ierr = MatRestoreRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr); } ierr = MatAssemblyBegin(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } else { /* just copy scalar matrix - abs() not taken here but scaled later */ ierr = MatDuplicate(Amat, MAT_COPY_VALUES, &Gmat);CHKERRQ(ierr); } #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr); #endif *a_Gmat = Gmat; PetscFunctionReturn(0); }
PetscErrorCode DMSetUp_DA_2D(DM da) { DM_DA *dd = (DM_DA*)da->data; const PetscInt M = dd->M; const PetscInt N = dd->N; PetscInt m = dd->m; PetscInt n = dd->n; const PetscInt dof = dd->w; const PetscInt s = dd->s; DMDABoundaryType bx = dd->bx; DMDABoundaryType by = dd->by; DMDAStencilType stencil_type = dd->stencil_type; PetscInt *lx = dd->lx; PetscInt *ly = dd->ly; MPI_Comm comm; PetscMPIInt rank,size; PetscInt xs,xe,ys,ye,x,y,Xs,Xe,Ys,Ye,start,end,IXs,IXe,IYs,IYe; PetscInt up,down,left,right,i,n0,n1,n2,n3,n5,n6,n7,n8,*idx,nn,*idx_cpy; const PetscInt *idx_full; PetscInt xbase,*bases,*ldims,j,x_t,y_t,s_t,base,count; PetscInt s_x,s_y; /* s proportionalized to w */ PetscInt sn0 = 0,sn2 = 0,sn6 = 0,sn8 = 0; Vec local,global; VecScatter ltog,gtol; IS to,from,ltogis; PetscErrorCode ierr; PetscFunctionBegin; if (stencil_type == DMDA_STENCIL_BOX && (bx == DMDA_BOUNDARY_MIRROR || by == DMDA_BOUNDARY_MIRROR)) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Mirror boundary and box stencil"); ierr = PetscObjectGetComm((PetscObject)da,&comm); CHKERRQ(ierr); #if !defined(PETSC_USE_64BIT_INDICES) if (((Petsc64bitInt) M)*((Petsc64bitInt) N)*((Petsc64bitInt) dof) > (Petsc64bitInt) PETSC_MPI_INT_MAX) SETERRQ3(comm,PETSC_ERR_INT_OVERFLOW,"Mesh of %D by %D by %D (dof) is too large for 32 bit indices",M,N,dof); #endif if (dof < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Must have 1 or more degrees of freedom per node: %D",dof); if (s < 0) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Stencil width cannot be negative: %D",s); ierr = MPI_Comm_size(comm,&size); CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank); CHKERRQ(ierr); if (m != PETSC_DECIDE) { if (m < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in X direction: %D",m); else if (m > size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in X direction: %D %d",m,size); } if (n != PETSC_DECIDE) { if (n < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in Y direction: %D",n); else if (n > size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in Y direction: %D %d",n,size); } if (m == PETSC_DECIDE || n == PETSC_DECIDE) { if (n != PETSC_DECIDE) { m = size/n; } else if (m != PETSC_DECIDE) { n = size/m; } else { /* try for squarish distribution */ m = (PetscInt)(0.5 + PetscSqrtReal(((PetscReal)M)*((PetscReal)size)/((PetscReal)N))); if (!m) m = 1; while (m > 0) { n = size/m; if (m*n == size) break; m--; } if (M > N && m < n) { PetscInt _m = m; m = n; n = _m; } } if (m*n != size) SETERRQ(comm,PETSC_ERR_PLIB,"Unable to create partition, check the size of the communicator and input m and n "); } else if (m*n != size) SETERRQ(comm,PETSC_ERR_ARG_OUTOFRANGE,"Given Bad partition"); if (M < m) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Partition in x direction is too fine! %D %D",M,m); if (N < n) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Partition in y direction is too fine! %D %D",N,n); /* Determine locally owned region xs is the first local node number, x is the number of local nodes */ if (!lx) { ierr = PetscMalloc(m*sizeof(PetscInt), &dd->lx); CHKERRQ(ierr); lx = dd->lx; for (i=0; i<m; i++) { lx[i] = M/m + ((M % m) > i); } } x = lx[rank % m]; xs = 0; for (i=0; i<(rank % m); i++) { xs += lx[i]; } #if defined(PETSC_USE_DEBUG) left = xs; for (i=(rank % m); i<m; i++) { left += lx[i]; } if (left != M) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of lx across processors not equal to M: %D %D",left,M); #endif /* Determine locally owned region ys is the first local node number, y is the number of local nodes */ if (!ly) { ierr = PetscMalloc(n*sizeof(PetscInt), &dd->ly); CHKERRQ(ierr); ly = dd->ly; for (i=0; i<n; i++) { ly[i] = N/n + ((N % n) > i); } } y = ly[rank/m]; ys = 0; for (i=0; i<(rank/m); i++) { ys += ly[i]; } #if defined(PETSC_USE_DEBUG) left = ys; for (i=(rank/m); i<n; i++) { left += ly[i]; } if (left != N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of ly across processors not equal to N: %D %D",left,N); #endif /* check if the scatter requires more than one process neighbor or wraps around the domain more than once */ if ((x < s) && ((m > 1) || (bx == DMDA_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local x-width of domain x %D is smaller than stencil width s %D",x,s); if ((y < s) && ((n > 1) || (by == DMDA_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local y-width of domain y %D is smaller than stencil width s %D",y,s); xe = xs + x; ye = ys + y; /* determine ghost region (Xs) and region scattered into (IXs) */ if (xs-s > 0) { Xs = xs - s; IXs = xs - s; } else { if (bx) { Xs = xs - s; } else { Xs = 0; } IXs = 0; } if (xe+s <= M) { Xe = xe + s; IXe = xe + s; } else { if (bx) { Xs = xs - s; Xe = xe + s; } else { Xe = M; } IXe = M; } if (bx == DMDA_BOUNDARY_PERIODIC || bx == DMDA_BOUNDARY_MIRROR) { IXs = xs - s; IXe = xe + s; Xs = xs - s; Xe = xe + s; } if (ys-s > 0) { Ys = ys - s; IYs = ys - s; } else { if (by) { Ys = ys - s; } else { Ys = 0; } IYs = 0; } if (ye+s <= N) { Ye = ye + s; IYe = ye + s; } else { if (by) { Ye = ye + s; } else { Ye = N; } IYe = N; } if (by == DMDA_BOUNDARY_PERIODIC || by == DMDA_BOUNDARY_MIRROR) { IYs = ys - s; IYe = ye + s; Ys = ys - s; Ye = ye + s; } /* stencil length in each direction */ s_x = s; s_y = s; /* determine starting point of each processor */ nn = x*y; ierr = PetscMalloc2(size+1,PetscInt,&bases,size,PetscInt,&ldims); CHKERRQ(ierr); ierr = MPI_Allgather(&nn,1,MPIU_INT,ldims,1,MPIU_INT,comm); CHKERRQ(ierr); bases[0] = 0; for (i=1; i<=size; i++) { bases[i] = ldims[i-1]; } for (i=1; i<=size; i++) { bases[i] += bases[i-1]; } base = bases[rank]*dof; /* allocate the base parallel and sequential vectors */ dd->Nlocal = x*y*dof; ierr = VecCreateMPIWithArray(comm,dof,dd->Nlocal,PETSC_DECIDE,0,&global); CHKERRQ(ierr); dd->nlocal = (Xe-Xs)*(Ye-Ys)*dof; ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,dof,dd->nlocal,0,&local); CHKERRQ(ierr); /* generate appropriate vector scatters */ /* local to global inserts non-ghost point region into global */ ierr = VecGetOwnershipRange(global,&start,&end); CHKERRQ(ierr); ierr = ISCreateStride(comm,x*y*dof,start,1,&to); CHKERRQ(ierr); ierr = PetscMalloc(x*y*sizeof(PetscInt),&idx); CHKERRQ(ierr); left = xs - Xs; right = left + x; down = ys - Ys; up = down + y; count = 0; for (i=down; i<up; i++) { for (j=left; j<right; j++) { idx[count++] = i*(Xe-Xs) + j; } } ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&from); CHKERRQ(ierr); ierr = VecScatterCreate(local,from,global,to,<og); CHKERRQ(ierr); ierr = PetscLogObjectParent(dd,ltog); CHKERRQ(ierr); ierr = ISDestroy(&from); CHKERRQ(ierr); ierr = ISDestroy(&to); CHKERRQ(ierr); /* global to local must include ghost points within the domain, but not ghost points outside the domain that aren't periodic */ if (stencil_type == DMDA_STENCIL_BOX) { count = (IXe-IXs)*(IYe-IYs); ierr = PetscMalloc(count*sizeof(PetscInt),&idx); CHKERRQ(ierr); left = IXs - Xs; right = left + (IXe-IXs); down = IYs - Ys; up = down + (IYe-IYs); count = 0; for (i=down; i<up; i++) { for (j=left; j<right; j++) { idx[count++] = j + i*(Xe-Xs); } } ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&to); CHKERRQ(ierr); } else { /* must drop into cross shape region */ /* ---------| | top | |--- ---| up | middle | | | ---- ---- down | bottom | ----------- Xs xs xe Xe */ count = (ys-IYs)*x + y*(IXe-IXs) + (IYe-ye)*x; ierr = PetscMalloc(count*sizeof(PetscInt),&idx); CHKERRQ(ierr); left = xs - Xs; right = left + x; down = ys - Ys; up = down + y; count = 0; /* bottom */ for (i=(IYs-Ys); i<down; i++) { for (j=left; j<right; j++) { idx[count++] = j + i*(Xe-Xs); } } /* middle */ for (i=down; i<up; i++) { for (j=(IXs-Xs); j<(IXe-Xs); j++) { idx[count++] = j + i*(Xe-Xs); } } /* top */ for (i=up; i<up+IYe-ye; i++) { for (j=left; j<right; j++) { idx[count++] = j + i*(Xe-Xs); } } ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&to); CHKERRQ(ierr); } /* determine who lies on each side of us stored in n6 n7 n8 n3 n5 n0 n1 n2 */ /* Assume the Non-Periodic Case */ n1 = rank - m; if (rank % m) { n0 = n1 - 1; } else { n0 = -1; } if ((rank+1) % m) { n2 = n1 + 1; n5 = rank + 1; n8 = rank + m + 1; if (n8 >= m*n) n8 = -1; } else { n2 = -1; n5 = -1; n8 = -1; } if (rank % m) { n3 = rank - 1; n6 = n3 + m; if (n6 >= m*n) n6 = -1; } else { n3 = -1; n6 = -1; } n7 = rank + m; if (n7 >= m*n) n7 = -1; if (bx == DMDA_BOUNDARY_PERIODIC && by == DMDA_BOUNDARY_PERIODIC) { /* Modify for Periodic Cases */ /* Handle all four corners */ if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1; if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0; if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m; if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1; /* Handle Top and Bottom Sides */ if (n1 < 0) n1 = rank + m * (n-1); if (n7 < 0) n7 = rank - m * (n-1); if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1; if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1; if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1; if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1; /* Handle Left and Right Sides */ if (n3 < 0) n3 = rank + (m-1); if (n5 < 0) n5 = rank - (m-1); if ((n1 >= 0) && (n0 < 0)) n0 = rank-1; if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1; if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1; if ((n7 >= 0) && (n8 < 0)) n8 = rank+1; } else if (by == DMDA_BOUNDARY_PERIODIC) { /* Handle Top and Bottom Sides */ if (n1 < 0) n1 = rank + m * (n-1); if (n7 < 0) n7 = rank - m * (n-1); if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1; if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1; if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1; if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1; } else if (bx == DMDA_BOUNDARY_PERIODIC) { /* Handle Left and Right Sides */ if (n3 < 0) n3 = rank + (m-1); if (n5 < 0) n5 = rank - (m-1); if ((n1 >= 0) && (n0 < 0)) n0 = rank-1; if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1; if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1; if ((n7 >= 0) && (n8 < 0)) n8 = rank+1; } ierr = PetscMalloc(9*sizeof(PetscInt),&dd->neighbors); CHKERRQ(ierr); dd->neighbors[0] = n0; dd->neighbors[1] = n1; dd->neighbors[2] = n2; dd->neighbors[3] = n3; dd->neighbors[4] = rank; dd->neighbors[5] = n5; dd->neighbors[6] = n6; dd->neighbors[7] = n7; dd->neighbors[8] = n8; if (stencil_type == DMDA_STENCIL_STAR) { /* save corner processor numbers */ sn0 = n0; sn2 = n2; sn6 = n6; sn8 = n8; n0 = n2 = n6 = n8 = -1; } ierr = PetscMalloc((Xe-Xs)*(Ye-Ys)*sizeof(PetscInt),&idx); CHKERRQ(ierr); ierr = PetscLogObjectMemory(da,(Xe-Xs)*(Ye-Ys)*sizeof(PetscInt)); CHKERRQ(ierr); nn = 0; xbase = bases[rank]; for (i=1; i<=s_y; i++) { if (n0 >= 0) { /* left below */ x_t = lx[n0 % m]; y_t = ly[(n0/m)]; s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } if (n1 >= 0) { /* directly below */ x_t = x; y_t = ly[(n1/m)]; s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t; for (j=0; j<x_t; j++) idx[nn++] = s_t++; } else if (by == DMDA_BOUNDARY_MIRROR) { for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(s_y - i + 1) + j; } if (n2 >= 0) { /* right below */ x_t = lx[n2 % m]; y_t = ly[(n2/m)]; s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } } for (i=0; i<y; i++) { if (n3 >= 0) { /* directly left */ x_t = lx[n3 % m]; /* y_t = y; */ s_t = bases[n3] + (i+1)*x_t - s_x; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (bx == DMDA_BOUNDARY_MIRROR) { for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*i + s_x - j; } for (j=0; j<x; j++) idx[nn++] = xbase++; /* interior */ if (n5 >= 0) { /* directly right */ x_t = lx[n5 % m]; /* y_t = y; */ s_t = bases[n5] + (i)*x_t; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (bx == DMDA_BOUNDARY_MIRROR) { for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*(i + 1) - 2 - j; } } for (i=1; i<=s_y; i++) { if (n6 >= 0) { /* left above */ x_t = lx[n6 % m]; /* y_t = ly[(n6/m)]; */ s_t = bases[n6] + (i)*x_t - s_x; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } if (n7 >= 0) { /* directly above */ x_t = x; /* y_t = ly[(n7/m)]; */ s_t = bases[n7] + (i-1)*x_t; for (j=0; j<x_t; j++) idx[nn++] = s_t++; } else if (by == DMDA_BOUNDARY_MIRROR) { for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(y - i - 1) + j; } if (n8 >= 0) { /* right above */ x_t = lx[n8 % m]; /* y_t = ly[(n8/m)]; */ s_t = bases[n8] + (i-1)*x_t; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } } ierr = ISCreateBlock(comm,dof,nn,idx,PETSC_COPY_VALUES,&from); CHKERRQ(ierr); ierr = VecScatterCreate(global,from,local,to,>ol); CHKERRQ(ierr); ierr = PetscLogObjectParent(da,gtol); CHKERRQ(ierr); ierr = ISDestroy(&to); CHKERRQ(ierr); ierr = ISDestroy(&from); CHKERRQ(ierr); if (stencil_type == DMDA_STENCIL_STAR) { n0 = sn0; n2 = sn2; n6 = sn6; n8 = sn8; } if (((stencil_type == DMDA_STENCIL_STAR) || (bx && bx != DMDA_BOUNDARY_PERIODIC) || (by && by != DMDA_BOUNDARY_PERIODIC))) { /* Recompute the local to global mappings, this time keeping the information about the cross corner processor numbers and any ghosted but not periodic indices. */ nn = 0; xbase = bases[rank]; for (i=1; i<=s_y; i++) { if (n0 >= 0) { /* left below */ x_t = lx[n0 % m]; y_t = ly[(n0/m)]; s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (xs-Xs > 0 && ys-Ys > 0) { for (j=0; j<s_x; j++) idx[nn++] = -1; } if (n1 >= 0) { /* directly below */ x_t = x; y_t = ly[(n1/m)]; s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t; for (j=0; j<x_t; j++) idx[nn++] = s_t++; } else if (ys-Ys > 0) { if (by == DMDA_BOUNDARY_MIRROR) { for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(s_y - i + 1) + j; } else { for (j=0; j<x; j++) idx[nn++] = -1; } } if (n2 >= 0) { /* right below */ x_t = lx[n2 % m]; y_t = ly[(n2/m)]; s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (Xe-xe> 0 && ys-Ys > 0) { for (j=0; j<s_x; j++) idx[nn++] = -1; } } for (i=0; i<y; i++) { if (n3 >= 0) { /* directly left */ x_t = lx[n3 % m]; /* y_t = y; */ s_t = bases[n3] + (i+1)*x_t - s_x; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (xs-Xs > 0) { if (bx == DMDA_BOUNDARY_MIRROR) { for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*i + s_x - j; } else { for (j=0; j<s_x; j++) idx[nn++] = -1; } } for (j=0; j<x; j++) idx[nn++] = xbase++; /* interior */ if (n5 >= 0) { /* directly right */ x_t = lx[n5 % m]; /* y_t = y; */ s_t = bases[n5] + (i)*x_t; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (Xe-xe > 0) { if (bx == DMDA_BOUNDARY_MIRROR) { for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*(i + 1) - 2 - j; } else { for (j=0; j<s_x; j++) idx[nn++] = -1; } } } for (i=1; i<=s_y; i++) { if (n6 >= 0) { /* left above */ x_t = lx[n6 % m]; /* y_t = ly[(n6/m)]; */ s_t = bases[n6] + (i)*x_t - s_x; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (xs-Xs > 0 && Ye-ye > 0) { for (j=0; j<s_x; j++) idx[nn++] = -1; } if (n7 >= 0) { /* directly above */ x_t = x; /* y_t = ly[(n7/m)]; */ s_t = bases[n7] + (i-1)*x_t; for (j=0; j<x_t; j++) idx[nn++] = s_t++; } else if (Ye-ye > 0) { if (by == DMDA_BOUNDARY_MIRROR) { for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(y - i - 1) + j; } else { for (j=0; j<x; j++) idx[nn++] = -1; } } if (n8 >= 0) { /* right above */ x_t = lx[n8 % m]; /* y_t = ly[(n8/m)]; */ s_t = bases[n8] + (i-1)*x_t; for (j=0; j<s_x; j++) idx[nn++] = s_t++; } else if (Xe-xe > 0 && Ye-ye > 0) { for (j=0; j<s_x; j++) idx[nn++] = -1; } } } /* Set the local to global ordering in the global vector, this allows use of VecSetValuesLocal(). */ ierr = ISCreateBlock(comm,dof,nn,idx,PETSC_OWN_POINTER,<ogis); CHKERRQ(ierr); ierr = PetscMalloc(nn*dof*sizeof(PetscInt),&idx_cpy); CHKERRQ(ierr); ierr = PetscLogObjectMemory(da,nn*dof*sizeof(PetscInt)); CHKERRQ(ierr); ierr = ISGetIndices(ltogis, &idx_full); CHKERRQ(ierr); ierr = PetscMemcpy(idx_cpy,idx_full,nn*dof*sizeof(PetscInt)); CHKERRQ(ierr); ierr = ISRestoreIndices(ltogis, &idx_full); CHKERRQ(ierr); ierr = ISLocalToGlobalMappingCreateIS(ltogis,&da->ltogmap); CHKERRQ(ierr); ierr = PetscLogObjectParent(da,da->ltogmap); CHKERRQ(ierr); ierr = ISDestroy(<ogis); CHKERRQ(ierr); ierr = ISLocalToGlobalMappingBlock(da->ltogmap,dd->w,&da->ltogmapb); CHKERRQ(ierr); ierr = PetscLogObjectParent(da,da->ltogmap); CHKERRQ(ierr); ierr = PetscFree2(bases,ldims); CHKERRQ(ierr); dd->m = m; dd->n = n; /* note petsc expects xs/xe/Xs/Xe to be multiplied by #dofs in many places */ dd->xs = xs*dof; dd->xe = xe*dof; dd->ys = ys; dd->ye = ye; dd->zs = 0; dd->ze = 1; dd->Xs = Xs*dof; dd->Xe = Xe*dof; dd->Ys = Ys; dd->Ye = Ye; dd->Zs = 0; dd->Ze = 1; ierr = VecDestroy(&local); CHKERRQ(ierr); ierr = VecDestroy(&global); CHKERRQ(ierr); dd->gtol = gtol; dd->ltog = ltog; dd->idx = idx_cpy; dd->Nl = nn*dof; dd->base = base; da->ops->view = DMView_DA_2d; dd->ltol = NULL; dd->ao = NULL; PetscFunctionReturn(0); }
/*@C TaoVecGetSubVec - Gets a subvector using the IS Input Parameters: + vfull - the full matrix . is - the index set for the subvector . reduced_type - the method TAO is using for subsetting (TAO_SUBSET_SUBVEC, TAO_SUBSET_MASK, TAO_SUBSET_MATRIXFREE) - maskvalue - the value to set the unused vector elements to (for TAO_SUBSET_MASK or TAO_SUBSET_MATRIXFREE) Output Parameters: . vreduced - the subvector Notes: maskvalue should usually be 0.0, unless a pointwise divide will be used. @*/ PetscErrorCode TaoVecGetSubVec(Vec vfull, IS is, TaoSubsetType reduced_type, PetscReal maskvalue, Vec *vreduced) { PetscErrorCode ierr; PetscInt nfull,nreduced,nreduced_local,rlow,rhigh,flow,fhigh; PetscInt i,nlocal; PetscReal *fv,*rv; const PetscInt *s; IS ident; VecType vtype; VecScatter scatter; MPI_Comm comm; PetscFunctionBegin; PetscValidHeaderSpecific(vfull,VEC_CLASSID,1); PetscValidHeaderSpecific(is,IS_CLASSID,2); ierr = VecGetSize(vfull, &nfull);CHKERRQ(ierr); ierr = ISGetSize(is, &nreduced);CHKERRQ(ierr); if (nreduced == nfull) { ierr = VecDestroy(vreduced);CHKERRQ(ierr); ierr = VecDuplicate(vfull,vreduced);CHKERRQ(ierr); ierr = VecCopy(vfull,*vreduced);CHKERRQ(ierr); } else { switch (reduced_type) { case TAO_SUBSET_SUBVEC: ierr = VecGetType(vfull,&vtype);CHKERRQ(ierr); ierr = VecGetOwnershipRange(vfull,&flow,&fhigh);CHKERRQ(ierr); ierr = ISGetLocalSize(is,&nreduced_local);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)vfull,&comm);CHKERRQ(ierr); if (*vreduced) { ierr = VecDestroy(vreduced);CHKERRQ(ierr); } ierr = VecCreate(comm,vreduced);CHKERRQ(ierr); ierr = VecSetType(*vreduced,vtype);CHKERRQ(ierr); ierr = VecSetSizes(*vreduced,nreduced_local,nreduced);CHKERRQ(ierr); ierr = VecGetOwnershipRange(*vreduced,&rlow,&rhigh);CHKERRQ(ierr); ierr = ISCreateStride(comm,nreduced_local,rlow,1,&ident);CHKERRQ(ierr); ierr = VecScatterCreate(vfull,is,*vreduced,ident,&scatter);CHKERRQ(ierr); ierr = VecScatterBegin(scatter,vfull,*vreduced,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(scatter,vfull,*vreduced,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterDestroy(&scatter);CHKERRQ(ierr); ierr = ISDestroy(&ident);CHKERRQ(ierr); break; case TAO_SUBSET_MASK: case TAO_SUBSET_MATRIXFREE: /* vr[i] = vf[i] if i in is vr[i] = 0 otherwise */ if (!*vreduced) { ierr = VecDuplicate(vfull,vreduced);CHKERRQ(ierr); } ierr = VecSet(*vreduced,maskvalue);CHKERRQ(ierr); ierr = ISGetLocalSize(is,&nlocal);CHKERRQ(ierr); ierr = VecGetOwnershipRange(vfull,&flow,&fhigh);CHKERRQ(ierr); ierr = VecGetArray(vfull,&fv);CHKERRQ(ierr); ierr = VecGetArray(*vreduced,&rv);CHKERRQ(ierr); ierr = ISGetIndices(is,&s);CHKERRQ(ierr); if (nlocal > (fhigh-flow)) SETERRQ2(PETSC_COMM_WORLD,1,"IS local size %d > Vec local size %d",nlocal,fhigh-flow); for (i=0;i<nlocal;i++) { rv[s[i]-flow] = fv[s[i]-flow]; } ierr = ISRestoreIndices(is,&s);CHKERRQ(ierr); ierr = VecRestoreArray(vfull,&fv);CHKERRQ(ierr); ierr = VecRestoreArray(*vreduced,&rv);CHKERRQ(ierr); break; } } PetscFunctionReturn(0); }
/* * Increase overlap for the sub-matrix across sub communicator * sub-matrix could be a graph or numerical matrix * */ PetscErrorCode MatIncreaseOverlapSplit_Single(Mat mat,IS *is,PetscInt ov) { PetscInt i,nindx,*indices_sc,*indices_ov,localsize,*localsizes_sc,localsize_tmp; PetscInt *indices_ov_rd,nroots,nleaves,*localoffsets,*indices_recv,*sources_sc,*sources_sc_rd; const PetscInt *indices; PetscMPIInt srank,ssize,issamecomm,k,grank; IS is_sc,allis_sc,partitioning; MPI_Comm gcomm,dcomm,scomm; PetscSF sf; PetscSFNode *remote; Mat *smat; MatPartitioning part; PetscErrorCode ierr; PetscFunctionBegin; /* get a sub communicator before call individual MatIncreaseOverlap * since the sub communicator may be changed. * */ ierr = PetscObjectGetComm((PetscObject)(*is),&dcomm);CHKERRQ(ierr); /*make a copy before the original one is deleted*/ ierr = PetscCommDuplicate(dcomm,&scomm,NULL);CHKERRQ(ierr); /*get a global communicator, where mat should be a global matrix */ ierr = PetscObjectGetComm((PetscObject)mat,&gcomm);CHKERRQ(ierr); /*increase overlap on each individual subdomain*/ ierr = (*mat->ops->increaseoverlap)(mat,1,is,ov);CHKERRQ(ierr); /*compare communicators */ ierr = MPI_Comm_compare(gcomm,scomm,&issamecomm);CHKERRQ(ierr); /* if the sub-communicator is the same as the global communicator, * user does not want to use a sub-communicator * */ if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT) PetscFunctionReturn(0); /* if the sub-communicator is petsc_comm_self, * user also does not care the sub-communicator * */ ierr = MPI_Comm_compare(scomm,PETSC_COMM_SELF,&issamecomm);CHKERRQ(ierr); if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT){PetscFunctionReturn(0);} /*local rank, size in a sub-communicator */ ierr = MPI_Comm_rank(scomm,&srank);CHKERRQ(ierr); ierr = MPI_Comm_size(scomm,&ssize);CHKERRQ(ierr); ierr = MPI_Comm_rank(gcomm,&grank);CHKERRQ(ierr); /*create a new IS based on sub-communicator * since the old IS is often based on petsc_comm_self * */ ierr = ISGetLocalSize(*is,&nindx);CHKERRQ(ierr); ierr = PetscCalloc1(nindx,&indices_sc);CHKERRQ(ierr); ierr = ISGetIndices(*is,&indices);CHKERRQ(ierr); ierr = PetscMemcpy(indices_sc,indices,sizeof(PetscInt)*nindx);CHKERRQ(ierr); ierr = ISRestoreIndices(*is,&indices);CHKERRQ(ierr); /*we do not need any more*/ ierr = ISDestroy(is);CHKERRQ(ierr); /*create a index set based on the sub communicator */ ierr = ISCreateGeneral(scomm,nindx,indices_sc,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr); /*gather all indices within the sub communicator*/ ierr = ISAllGather(is_sc,&allis_sc);CHKERRQ(ierr); ierr = ISDestroy(&is_sc);CHKERRQ(ierr); /* gather local sizes */ ierr = PetscMalloc1(ssize,&localsizes_sc);CHKERRQ(ierr); /*get individual local sizes for all index sets*/ ierr = MPI_Gather(&nindx,1,MPIU_INT,localsizes_sc,1,MPIU_INT,0,scomm);CHKERRQ(ierr); /*only root does these computations */ if(!srank){ /*get local size for the big index set*/ ierr = ISGetLocalSize(allis_sc,&localsize);CHKERRQ(ierr); ierr = PetscCalloc2(localsize,&indices_ov,localsize,&sources_sc);CHKERRQ(ierr); ierr = PetscCalloc2(localsize,&indices_ov_rd,localsize,&sources_sc_rd);CHKERRQ(ierr); ierr = ISGetIndices(allis_sc,&indices);CHKERRQ(ierr); ierr = PetscMemcpy(indices_ov,indices,sizeof(PetscInt)*localsize);CHKERRQ(ierr); ierr = ISRestoreIndices(allis_sc,&indices);CHKERRQ(ierr); /*we do not need it any more */ ierr = ISDestroy(&allis_sc);CHKERRQ(ierr); /*assign corresponding sources */ localsize_tmp = 0; for(k=0; k<ssize; k++){ for(i=0; i<localsizes_sc[k]; i++){ sources_sc[localsize_tmp++] = k; } } /*record where indices come from */ ierr = PetscSortIntWithArray(localsize,indices_ov,sources_sc);CHKERRQ(ierr); /*count local sizes for reduced indices */ ierr = PetscMemzero(localsizes_sc,sizeof(PetscInt)*ssize);CHKERRQ(ierr); /*initialize the first entity*/ if(localsize){ indices_ov_rd[0] = indices_ov[0]; sources_sc_rd[0] = sources_sc[0]; localsizes_sc[sources_sc[0]]++; } localsize_tmp = 1; /*remove duplicate integers */ for(i=1; i<localsize; i++){ if(indices_ov[i] != indices_ov[i-1]){ indices_ov_rd[localsize_tmp] = indices_ov[i]; sources_sc_rd[localsize_tmp++] = sources_sc[i]; localsizes_sc[sources_sc[i]]++; } } ierr = PetscFree2(indices_ov,sources_sc);CHKERRQ(ierr); ierr = PetscCalloc1(ssize+1,&localoffsets);CHKERRQ(ierr); for(k=0; k<ssize; k++){ localoffsets[k+1] = localoffsets[k] + localsizes_sc[k]; } /*construct a star forest to send data back */ nleaves = localoffsets[ssize]; ierr = PetscMemzero(localoffsets,(ssize+1)*sizeof(PetscInt));CHKERRQ(ierr); nroots = localsizes_sc[srank]; ierr = PetscCalloc1(nleaves,&remote);CHKERRQ(ierr); for(i=0; i<nleaves; i++){ remote[i].rank = sources_sc_rd[i]; remote[i].index = localoffsets[sources_sc_rd[i]]++; } ierr = PetscFree(localoffsets);CHKERRQ(ierr); }else{ ierr = ISDestroy(&allis_sc);CHKERRQ(ierr); /*Allocate a 'zero' pointer */ ierr = PetscCalloc1(0,&remote);CHKERRQ(ierr); nleaves = 0; indices_ov_rd = 0; sources_sc_rd = 0; } /*scatter sizes to everybody */ ierr = MPI_Scatter(localsizes_sc,1, MPIU_INT,&nroots,1, MPIU_INT,0,scomm);CHKERRQ(ierr); /*free memory */ ierr = PetscFree(localsizes_sc);CHKERRQ(ierr); ierr = PetscCalloc1(nroots,&indices_recv);CHKERRQ(ierr); /*ierr = MPI_Comm_dup(scomm,&dcomm);CHKERRQ(ierr);*/ /*set data back to every body */ ierr = PetscSFCreate(scomm,&sf);CHKERRQ(ierr); ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr); ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr); ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);CHKERRQ(ierr); ierr = PetscSFReduceBegin(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr); ierr = PetscSFReduceEnd(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr); ierr = PetscSFDestroy(&sf);CHKERRQ(ierr); /* free memory */ ierr = PetscFree2(indices_ov_rd,sources_sc_rd);CHKERRQ(ierr); /*create a index set*/ ierr = ISCreateGeneral(scomm,nroots,indices_recv,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr); /*construct a parallel submatrix */ ierr = MatGetSubMatricesMPI(mat,1,&is_sc,&is_sc,MAT_INITIAL_MATRIX,&smat);CHKERRQ(ierr); /* we do not need them any more */ ierr = ISDestroy(&allis_sc);CHKERRQ(ierr); /*create a partitioner to repartition the sub-matrix*/ ierr = MatPartitioningCreate(scomm,&part);CHKERRQ(ierr); ierr = MatPartitioningSetAdjacency(part,smat[0]);CHKERRQ(ierr); #if PETSC_HAVE_PARMETIS /* if there exists a ParMETIS installation, we try to use ParMETIS * because a repartition routine possibly work better * */ ierr = MatPartitioningSetType(part,MATPARTITIONINGPARMETIS);CHKERRQ(ierr); /*try to use reparition function, instead of partition function */ ierr = MatPartitioningParmetisSetRepartition(part);CHKERRQ(ierr); #else /*we at least provide a default partitioner to rebalance the computation */ ierr = MatPartitioningSetType(part,MATPARTITIONINGAVERAGE);CHKERRQ(ierr); #endif /*user can pick up any partitioner by using an option*/ ierr = MatPartitioningSetFromOptions(part);CHKERRQ(ierr); /* apply partition */ ierr = MatPartitioningApply(part,&partitioning);CHKERRQ(ierr); ierr = MatPartitioningDestroy(&part);CHKERRQ(ierr); ierr = MatDestroy(&(smat[0]));CHKERRQ(ierr); ierr = PetscFree(smat);CHKERRQ(ierr); /* get local rows including overlap */ ierr = ISBuildTwoSided(partitioning,is_sc,is);CHKERRQ(ierr); /* destroy */ ierr = ISDestroy(&is_sc);CHKERRQ(ierr); ierr = ISDestroy(&partitioning);CHKERRQ(ierr); ierr = PetscCommDestroy(&scomm);CHKERRQ(ierr); PetscFunctionReturn(0); }
static PetscErrorCode PCSetUp_Redistribute(PC pc) { PC_Redistribute *red = (PC_Redistribute*)pc->data; PetscErrorCode ierr; MPI_Comm comm; PetscInt rstart,rend,i,nz,cnt,*rows,ncnt,dcnt,*drows; PetscLayout map,nmap; PetscMPIInt size,imdex,tag,n; PetscInt *source = PETSC_NULL; PetscMPIInt *nprocs = PETSC_NULL,nrecvs; PetscInt j,nsends; PetscInt *owner = PETSC_NULL,*starts = PETSC_NULL,count,slen; PetscInt *rvalues,*svalues,recvtotal; PetscMPIInt *onodes1,*olengths1; MPI_Request *send_waits = PETSC_NULL,*recv_waits = PETSC_NULL; MPI_Status recv_status,*send_status; Vec tvec,diag; Mat tmat; const PetscScalar *d; PetscFunctionBegin; if (pc->setupcalled) { ierr = KSPGetOperators(red->ksp,PETSC_NULL,&tmat,PETSC_NULL);CHKERRQ(ierr); ierr = MatGetSubMatrix(pc->pmat,red->is,red->is,MAT_REUSE_MATRIX,&tmat);CHKERRQ(ierr); ierr = KSPSetOperators(red->ksp,tmat,tmat,SAME_NONZERO_PATTERN);CHKERRQ(ierr); } else { PetscInt NN; ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)pc,&tag);CHKERRQ(ierr); /* count non-diagonal rows on process */ ierr = MatGetOwnershipRange(pc->mat,&rstart,&rend);CHKERRQ(ierr); cnt = 0; for (i=rstart; i<rend; i++) { ierr = MatGetRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); if (nz > 1) cnt++; ierr = MatRestoreRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); } ierr = PetscMalloc(cnt*sizeof(PetscInt),&rows);CHKERRQ(ierr); ierr = PetscMalloc((rend - rstart - cnt)*sizeof(PetscInt),&drows);CHKERRQ(ierr); /* list non-diagonal rows on process */ cnt = 0; dcnt = 0; for (i=rstart; i<rend; i++) { ierr = MatGetRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); if (nz > 1) rows[cnt++] = i; else drows[dcnt++] = i - rstart; ierr = MatRestoreRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); } /* create PetscLayout for non-diagonal rows on each process */ ierr = PetscLayoutCreate(comm,&map);CHKERRQ(ierr); ierr = PetscLayoutSetLocalSize(map,cnt);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(map,1);CHKERRQ(ierr); ierr = PetscLayoutSetUp(map);CHKERRQ(ierr); rstart = map->rstart; rend = map->rend; /* create PetscLayout for load-balanced non-diagonal rows on each process */ ierr = PetscLayoutCreate(comm,&nmap);CHKERRQ(ierr); ierr = MPI_Allreduce(&cnt,&ncnt,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr); ierr = PetscLayoutSetSize(nmap,ncnt);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(nmap,1);CHKERRQ(ierr); ierr = PetscLayoutSetUp(nmap);CHKERRQ(ierr); ierr = MatGetSize(pc->pmat,&NN,PETSC_NULL);CHKERRQ(ierr); ierr = PetscInfo2(pc,"Number of diagonal rows eliminated %d, percentage eliminated %g\n",NN-ncnt,((PetscReal)(NN-ncnt))/((PetscReal)(NN)));CHKERRQ(ierr); /* this code is taken from VecScatterCreate_PtoS() Determines what rows need to be moved where to load balance the non-diagonal rows */ /* count number of contributors to each processor */ ierr = PetscMalloc2(size,PetscMPIInt,&nprocs,cnt,PetscInt,&owner);CHKERRQ(ierr); ierr = PetscMemzero(nprocs,size*sizeof(PetscMPIInt));CHKERRQ(ierr); j = 0; nsends = 0; for (i=rstart; i<rend; i++) { if (i < nmap->range[j]) j = 0; for (; j<size; j++) { if (i < nmap->range[j+1]) { if (!nprocs[j]++) nsends++; owner[i-rstart] = j; break; } } } /* inform other processors of number of messages and max length*/ ierr = PetscGatherNumberOfMessages(comm,PETSC_NULL,nprocs,&nrecvs);CHKERRQ(ierr); ierr = PetscGatherMessageLengths(comm,nsends,nrecvs,nprocs,&onodes1,&olengths1);CHKERRQ(ierr); ierr = PetscSortMPIIntWithArray(nrecvs,onodes1,olengths1);CHKERRQ(ierr); recvtotal = 0; for (i=0; i<nrecvs; i++) recvtotal += olengths1[i]; /* post receives: rvalues - rows I will own; count - nu */ ierr = PetscMalloc3(recvtotal,PetscInt,&rvalues,nrecvs,PetscInt,&source,nrecvs,MPI_Request,&recv_waits);CHKERRQ(ierr); count = 0; for (i=0; i<nrecvs; i++) { ierr = MPI_Irecv((rvalues+count),olengths1[i],MPIU_INT,onodes1[i],tag,comm,recv_waits+i);CHKERRQ(ierr); count += olengths1[i]; } /* do sends: 1) starts[i] gives the starting index in svalues for stuff going to the ith processor */ ierr = PetscMalloc3(cnt,PetscInt,&svalues,nsends,MPI_Request,&send_waits,size,PetscInt,&starts);CHKERRQ(ierr); starts[0] = 0; for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[i-1];} for (i=0; i<cnt; i++) { svalues[starts[owner[i]]++] = rows[i]; } for (i=0; i<cnt; i++) rows[i] = rows[i] - rstart; red->drows = drows; red->dcnt = dcnt; ierr = PetscFree(rows);CHKERRQ(ierr); starts[0] = 0; for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[i-1];} count = 0; for (i=0; i<size; i++) { if (nprocs[i]) { ierr = MPI_Isend(svalues+starts[i],nprocs[i],MPIU_INT,i,tag,comm,send_waits+count++);CHKERRQ(ierr); } } /* wait on receives */ count = nrecvs; slen = 0; while (count) { ierr = MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);CHKERRQ(ierr); /* unpack receives into our local space */ ierr = MPI_Get_count(&recv_status,MPIU_INT,&n);CHKERRQ(ierr); slen += n; count--; } if (slen != recvtotal) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Total message lengths %D not expected %D",slen,recvtotal); ierr = ISCreateGeneral(comm,slen,rvalues,PETSC_COPY_VALUES,&red->is);CHKERRQ(ierr); /* free up all work space */ ierr = PetscFree(olengths1);CHKERRQ(ierr); ierr = PetscFree(onodes1);CHKERRQ(ierr); ierr = PetscFree3(rvalues,source,recv_waits);CHKERRQ(ierr); ierr = PetscFree2(nprocs,owner);CHKERRQ(ierr); if (nsends) { /* wait on sends */ ierr = PetscMalloc(nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr); ierr = MPI_Waitall(nsends,send_waits,send_status);CHKERRQ(ierr); ierr = PetscFree(send_status);CHKERRQ(ierr); } ierr = PetscFree3(svalues,send_waits,starts);CHKERRQ(ierr); ierr = PetscLayoutDestroy(&map);CHKERRQ(ierr); ierr = PetscLayoutDestroy(&nmap);CHKERRQ(ierr); ierr = VecCreateMPI(comm,slen,PETSC_DETERMINE,&red->b);CHKERRQ(ierr); ierr = VecDuplicate(red->b,&red->x);CHKERRQ(ierr); ierr = MatGetVecs(pc->pmat,&tvec,PETSC_NULL);CHKERRQ(ierr); ierr = VecScatterCreate(tvec,red->is,red->b,PETSC_NULL,&red->scatter);CHKERRQ(ierr); ierr = VecDestroy(&tvec);CHKERRQ(ierr); ierr = MatGetSubMatrix(pc->pmat,red->is,red->is,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr); ierr = KSPSetOperators(red->ksp,tmat,tmat,SAME_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatDestroy(&tmat);CHKERRQ(ierr); } /* get diagonal portion of matrix */ ierr = PetscMalloc(red->dcnt*sizeof(PetscScalar),&red->diag);CHKERRQ(ierr); ierr = MatGetVecs(pc->pmat,&diag,PETSC_NULL);CHKERRQ(ierr); ierr = MatGetDiagonal(pc->pmat,diag);CHKERRQ(ierr); ierr = VecGetArrayRead(diag,&d);CHKERRQ(ierr); for (i=0; i<red->dcnt; i++) { red->diag[i] = 1.0/d[red->drows[i]]; } ierr = VecRestoreArrayRead(diag,&d);CHKERRQ(ierr); ierr = VecDestroy(&diag);CHKERRQ(ierr); ierr = KSPSetUp(red->ksp);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode VecView_MPI_Draw_DA1d(Vec xin,PetscViewer v) { DM da; PetscErrorCode ierr; PetscMPIInt rank,size,tag1,tag2; PetscInt i,n,N,step,istart,isize,j,nbounds; MPI_Status status; PetscReal coors[4],ymin,ymax,min,max,xmin,xmax,tmp,xgtmp; const PetscScalar *array,*xg; PetscDraw draw; PetscBool isnull,showpoints = PETSC_FALSE; MPI_Comm comm; PetscDrawAxis axis; Vec xcoor; DMDABoundaryType bx; const PetscReal *bounds; PetscInt *displayfields; PetscInt k,ndisplayfields; PetscBool hold; PetscFunctionBegin; ierr = PetscViewerDrawGetDraw(v,0,&draw);CHKERRQ(ierr); ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0); ierr = PetscViewerDrawGetBounds(v,&nbounds,&bounds);CHKERRQ(ierr); ierr = VecGetDM(xin,&da);CHKERRQ(ierr); if (!da) SETERRQ(PetscObjectComm((PetscObject)xin),PETSC_ERR_ARG_WRONG,"Vector not generated from a DMDA"); ierr = PetscOptionsGetBool(NULL,"-draw_vec_mark_points",&showpoints,NULL);CHKERRQ(ierr); ierr = DMDAGetInfo(da,0,&N,0,0,0,0,0,&step,0,&bx,0,0,0);CHKERRQ(ierr); ierr = DMDAGetCorners(da,&istart,0,0,&isize,0,0);CHKERRQ(ierr); ierr = VecGetArrayRead(xin,&array);CHKERRQ(ierr); ierr = VecGetLocalSize(xin,&n);CHKERRQ(ierr); n = n/step; /* get coordinates of nodes */ ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr); if (!xcoor) { ierr = DMDASetUniformCoordinates(da,0.0,1.0,0.0,0.0,0.0,0.0);CHKERRQ(ierr); ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr); } ierr = VecGetArrayRead(xcoor,&xg);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)xin,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); /* Determine the min and max x coordinate in plot */ if (!rank) { xmin = PetscRealPart(xg[0]); } if (rank == size-1) { xmax = PetscRealPart(xg[n-1]); } ierr = MPI_Bcast(&xmin,1,MPIU_REAL,0,comm);CHKERRQ(ierr); ierr = MPI_Bcast(&xmax,1,MPIU_REAL,size-1,comm);CHKERRQ(ierr); ierr = DMDASelectFields(da,&ndisplayfields,&displayfields);CHKERRQ(ierr); for (k=0; k<ndisplayfields; k++) { j = displayfields[k]; ierr = PetscViewerDrawGetDraw(v,k,&draw);CHKERRQ(ierr); ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr); /* Determine the min and max y coordinate in plot */ min = 1.e20; max = -1.e20; for (i=0; i<n; i++) { if (PetscRealPart(array[j+i*step]) < min) min = PetscRealPart(array[j+i*step]); if (PetscRealPart(array[j+i*step]) > max) max = PetscRealPart(array[j+i*step]); } if (min + 1.e-10 > max) { min -= 1.e-5; max += 1.e-5; } if (j < nbounds) { min = PetscMin(min,bounds[2*j]); max = PetscMax(max,bounds[2*j+1]); } ierr = MPI_Reduce(&min,&ymin,1,MPIU_REAL,MPIU_MIN,0,comm);CHKERRQ(ierr); ierr = MPI_Reduce(&max,&ymax,1,MPIU_REAL,MPIU_MAX,0,comm);CHKERRQ(ierr); ierr = PetscViewerDrawGetHold(v,&hold);CHKERRQ(ierr); if (!hold) { ierr = PetscDrawSynchronizedClear(draw);CHKERRQ(ierr); } ierr = PetscViewerDrawGetDrawAxis(v,k,&axis);CHKERRQ(ierr); ierr = PetscLogObjectParent((PetscObject)draw,(PetscObject)axis);CHKERRQ(ierr); if (!rank) { const char *title; ierr = PetscDrawAxisSetLimits(axis,xmin,xmax,ymin,ymax);CHKERRQ(ierr); ierr = PetscDrawAxisDraw(axis);CHKERRQ(ierr); ierr = PetscDrawGetCoordinates(draw,coors,coors+1,coors+2,coors+3);CHKERRQ(ierr); ierr = DMDAGetFieldName(da,j,&title);CHKERRQ(ierr); if (title) {ierr = PetscDrawSetTitle(draw,title);CHKERRQ(ierr);} } ierr = MPI_Bcast(coors,4,MPIU_REAL,0,comm);CHKERRQ(ierr); if (rank) { ierr = PetscDrawSetCoordinates(draw,coors[0],coors[1],coors[2],coors[3]);CHKERRQ(ierr); } /* draw local part of vector */ ierr = PetscObjectGetNewTag((PetscObject)xin,&tag1);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)xin,&tag2);CHKERRQ(ierr); if (rank < size-1) { /*send value to right */ ierr = MPI_Send((void*)&array[j+(n-1)*step],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr); ierr = MPI_Send((void*)&xg[n-1],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr); } if (!rank && bx == DMDA_BOUNDARY_PERIODIC && size > 1) { /* first processor sends first value to last */ ierr = MPI_Send((void*)&array[j],1,MPIU_REAL,size-1,tag2,comm);CHKERRQ(ierr); } for (i=1; i<n; i++) { ierr = PetscDrawLine(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PetscRealPart(xg[i]),PetscRealPart(array[j+step*i]),PETSC_DRAW_RED);CHKERRQ(ierr); if (showpoints) { ierr = PetscDrawPoint(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr); } } if (rank) { /* receive value from left */ ierr = MPI_Recv(&tmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr); ierr = MPI_Recv(&xgtmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr); ierr = PetscDrawLine(draw,xgtmp,tmp,PetscRealPart(xg[0]),PetscRealPart(array[j]),PETSC_DRAW_RED);CHKERRQ(ierr); if (showpoints) { ierr = PetscDrawPoint(draw,xgtmp,tmp,PETSC_DRAW_BLACK);CHKERRQ(ierr); } } if (rank == size-1 && bx == DMDA_BOUNDARY_PERIODIC && size > 1) { ierr = MPI_Recv(&tmp,1,MPIU_REAL,0,tag2,comm,&status);CHKERRQ(ierr); /* If the mesh is not uniform we do not know the mesh spacing between the last point on the right and the first ghost point */ ierr = PetscDrawLine(draw,PetscRealPart(xg[n-1]),PetscRealPart(array[j+step*(n-1)]),PetscRealPart(xg[n-1]+(xg[n-1]-xg[n-2])),tmp,PETSC_DRAW_RED);CHKERRQ(ierr); if (showpoints) { ierr = PetscDrawPoint(draw,PetscRealPart(xg[n-2]),PetscRealPart(array[j+step*(n-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr); } } ierr = PetscDrawSynchronizedFlush(draw);CHKERRQ(ierr); ierr = PetscDrawPause(draw);CHKERRQ(ierr); } ierr = PetscFree(displayfields);CHKERRQ(ierr); ierr = VecRestoreArrayRead(xcoor,&xg);CHKERRQ(ierr); ierr = VecRestoreArrayRead(xin,&array);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode PCGAMGcoarsen_GEO(PC a_pc,Mat *a_Gmat,PetscCoarsenData **a_llist_parent) { PetscErrorCode ierr; PC_MG *mg = (PC_MG*)a_pc->data; PC_GAMG *pc_gamg = (PC_GAMG*)mg->innerctx; PetscInt Istart,Iend,nloc,kk,Ii,ncols; PetscMPIInt rank,size; IS perm; GAMGNode *gnodes; PetscInt *permute; Mat Gmat = *a_Gmat; MPI_Comm comm; MatCoarsen crs; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)a_pc,&comm);CHKERRQ(ierr); #if defined PETSC_USE_LOG ierr = PetscLogEventBegin(PC_GAMGCoarsen_GEO,0,0,0,0);CHKERRQ(ierr); #endif ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Gmat, &Istart, &Iend);CHKERRQ(ierr); nloc = (Iend-Istart); /* create random permutation with sort for geo-mg */ ierr = PetscMalloc1(nloc, &gnodes);CHKERRQ(ierr); ierr = PetscMalloc1(nloc, &permute);CHKERRQ(ierr); for (Ii=Istart; Ii<Iend; Ii++) { /* locals only? */ ierr = MatGetRow(Gmat,Ii,&ncols,0,0);CHKERRQ(ierr); { PetscInt lid = Ii - Istart; gnodes[lid].lid = lid; gnodes[lid].degree = ncols; } ierr = MatRestoreRow(Gmat,Ii,&ncols,0,0);CHKERRQ(ierr); } /* randomize */ srand(1); /* make deterministic */ if (PETSC_TRUE) { PetscBool *bIndexSet; ierr = PetscMalloc1(nloc, &bIndexSet);CHKERRQ(ierr); for (Ii = 0; Ii < nloc; Ii++) bIndexSet[Ii] = PETSC_FALSE; for (Ii = 0; Ii < nloc; Ii++) { PetscInt iSwapIndex = rand()%nloc; if (!bIndexSet[iSwapIndex] && iSwapIndex != Ii) { GAMGNode iTemp = gnodes[iSwapIndex]; gnodes[iSwapIndex] = gnodes[Ii]; gnodes[Ii] = iTemp; bIndexSet[Ii] = PETSC_TRUE; bIndexSet[iSwapIndex] = PETSC_TRUE; } } ierr = PetscFree(bIndexSet);CHKERRQ(ierr); } /* only sort locals */ qsort(gnodes, nloc, sizeof(GAMGNode), petsc_geo_mg_compare); /* create IS of permutation */ for (kk=0; kk<nloc; kk++) permute[kk] = gnodes[kk].lid; /* locals only */ ierr = ISCreateGeneral(PETSC_COMM_SELF, nloc, permute, PETSC_OWN_POINTER, &perm);CHKERRQ(ierr); ierr = PetscFree(gnodes);CHKERRQ(ierr); /* get MIS aggs */ ierr = MatCoarsenCreate(comm, &crs);CHKERRQ(ierr); ierr = MatCoarsenSetType(crs, MATCOARSENMIS);CHKERRQ(ierr); ierr = MatCoarsenSetGreedyOrdering(crs, perm);CHKERRQ(ierr); ierr = MatCoarsenSetAdjacency(crs, Gmat);CHKERRQ(ierr); ierr = MatCoarsenSetVerbose(crs, pc_gamg->verbose);CHKERRQ(ierr); ierr = MatCoarsenSetStrictAggs(crs, PETSC_FALSE);CHKERRQ(ierr); ierr = MatCoarsenApply(crs);CHKERRQ(ierr); ierr = MatCoarsenGetData(crs, a_llist_parent);CHKERRQ(ierr); ierr = MatCoarsenDestroy(&crs);CHKERRQ(ierr); ierr = ISDestroy(&perm);CHKERRQ(ierr); #if defined PETSC_USE_LOG ierr = PetscLogEventEnd(PC_GAMGCoarsen_GEO,0,0,0,0);CHKERRQ(ierr); #endif PetscFunctionReturn(0); }
PetscErrorCode PCGAMGProlongator_GEO(PC pc,const Mat Amat,const Mat Gmat,PetscCoarsenData *agg_lists,Mat *a_P_out) { PC_MG *mg = (PC_MG*)pc->data; PC_GAMG *pc_gamg = (PC_GAMG*)mg->innerctx; const PetscInt verbose = pc_gamg->verbose; const PetscInt dim = pc_gamg->data_cell_cols, data_cols = pc_gamg->data_cell_cols; PetscErrorCode ierr; PetscInt Istart,Iend,nloc,my0,jj,kk,ncols,nLocalSelected,bs,*clid_flid; Mat Prol; PetscMPIInt rank, size; MPI_Comm comm; IS selected_2,selected_1; const PetscInt *selected_idx; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr); #if defined PETSC_USE_LOG ierr = PetscLogEventBegin(PC_GAMGProlongator_GEO,0,0,0,0);CHKERRQ(ierr); #endif ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr); ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr); nloc = (Iend-Istart)/bs; my0 = Istart/bs; if ((Iend-Istart) % bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"(Iend %D - Istart %D) % bs %D",Iend,Istart,bs); /* get 'nLocalSelected' */ ierr = PetscCDGetMIS(agg_lists, &selected_1);CHKERRQ(ierr); ierr = ISGetSize(selected_1, &jj);CHKERRQ(ierr); ierr = PetscMalloc1(jj, &clid_flid);CHKERRQ(ierr); ierr = ISGetIndices(selected_1, &selected_idx);CHKERRQ(ierr); for (kk=0,nLocalSelected=0; kk<jj; kk++) { PetscInt lid = selected_idx[kk]; if (lid<nloc) { ierr = MatGetRow(Gmat,lid+my0,&ncols,0,0);CHKERRQ(ierr); if (ncols>1) clid_flid[nLocalSelected++] = lid; /* fiter out singletons */ ierr = MatRestoreRow(Gmat,lid+my0,&ncols,0,0);CHKERRQ(ierr); } } ierr = ISRestoreIndices(selected_1, &selected_idx);CHKERRQ(ierr); ierr = ISDestroy(&selected_1);CHKERRQ(ierr); /* this is selected_1 in serial */ /* create prolongator, create P matrix */ ierr = MatCreate(comm, &Prol);CHKERRQ(ierr); ierr = MatSetSizes(Prol,nloc*bs,nLocalSelected*bs,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetBlockSizes(Prol, bs, bs);CHKERRQ(ierr); ierr = MatSetType(Prol, MATAIJ);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(Prol,3*data_cols,NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(Prol,3*data_cols,NULL,3*data_cols,NULL);CHKERRQ(ierr); /* ierr = MatCreateAIJ(comm, */ /* nloc*bs, nLocalSelected*bs, */ /* PETSC_DETERMINE, PETSC_DETERMINE, */ /* 3*data_cols, NULL, */ /* 3*data_cols, NULL, */ /* &Prol); */ /* CHKERRQ(ierr); */ /* can get all points "removed" - but not on geomg */ ierr = MatGetSize(Prol, &kk, &jj);CHKERRQ(ierr); if (jj==0) { if (verbose) PetscPrintf(comm,"[%d]%s ERROE: no selected points on coarse grid\n",rank,__FUNCT__); ierr = PetscFree(clid_flid);CHKERRQ(ierr); ierr = MatDestroy(&Prol);CHKERRQ(ierr); *a_P_out = NULL; /* out */ PetscFunctionReturn(0); } { PetscReal *coords; PetscInt data_stride; PetscInt *crsGID = NULL; Mat Gmat2; if (dim != data_cols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"dim %D != data_cols %D",dim,data_cols); /* grow ghost data for better coarse grid cover of fine grid */ #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET5],0,0,0,0);CHKERRQ(ierr); #endif /* messy method, squares graph and gets some data */ ierr = getGIDsOnSquareGraph(nLocalSelected, clid_flid, Gmat, &selected_2, &Gmat2, &crsGID);CHKERRQ(ierr); /* llist is now not valid wrt squared graph, but will work as iterator in 'triangulateAndFormProl' */ #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET5],0,0,0,0);CHKERRQ(ierr); #endif /* create global vector of coorindates in 'coords' */ if (size > 1) { ierr = PCGAMGGetDataWithGhosts(Gmat2, dim, pc_gamg->data, &data_stride, &coords);CHKERRQ(ierr); } else { coords = (PetscReal*)pc_gamg->data; data_stride = pc_gamg->data_sz/pc_gamg->data_cell_cols; } ierr = MatDestroy(&Gmat2);CHKERRQ(ierr); /* triangulate */ if (dim == 2) { PetscReal metric,tm; #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET6],0,0,0,0);CHKERRQ(ierr); #endif ierr = triangulateAndFormProl(selected_2, data_stride, coords,nLocalSelected, clid_flid, agg_lists, crsGID, bs, Prol, &metric);CHKERRQ(ierr); #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET6],0,0,0,0);CHKERRQ(ierr); #endif ierr = PetscFree(crsGID);CHKERRQ(ierr); /* clean up and create coordinates for coarse grid (output) */ if (size > 1) ierr = PetscFree(coords);CHKERRQ(ierr); ierr = MPI_Allreduce(&metric, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr); if (tm > 1.) { /* needs to be globalized - should not happen */ if (verbose) PetscPrintf(comm,"[%d]%s failed metric for coarse grid %e\n",rank,__FUNCT__,tm); ierr = MatDestroy(&Prol);CHKERRQ(ierr); Prol = NULL; } else if (metric > .0) { if (verbose) PetscPrintf(comm,"[%d]%s worst metric for coarse grid = %e\n",rank,__FUNCT__,metric); } } else SETERRQ(comm,PETSC_ERR_PLIB,"3D not implemented for 'geo' AMG"); { /* create next coords - output */ PetscReal *crs_crds; ierr = PetscMalloc1(dim*nLocalSelected, &crs_crds);CHKERRQ(ierr); for (kk=0; kk<nLocalSelected; kk++) { /* grab local select nodes to promote - output */ PetscInt lid = clid_flid[kk]; for (jj=0; jj<dim; jj++) crs_crds[jj*nLocalSelected + kk] = pc_gamg->data[jj*nloc + lid]; } ierr = PetscFree(pc_gamg->data);CHKERRQ(ierr); pc_gamg->data = crs_crds; /* out */ pc_gamg->data_sz = dim*nLocalSelected; } ierr = ISDestroy(&selected_2);CHKERRQ(ierr); } *a_P_out = Prol; /* out */ ierr = PetscFree(clid_flid);CHKERRQ(ierr); #if defined PETSC_USE_LOG ierr = PetscLogEventEnd(PC_GAMGProlongator_GEO,0,0,0,0);CHKERRQ(ierr); #endif PetscFunctionReturn(0); }
static PetscErrorCode triangulateAndFormProl(IS selected_2, /* list of selected local ID, includes selected ghosts */ const PetscInt data_stride, const PetscReal coords[], /* column vector of local coordinates w/ ghosts */ const PetscInt nselected_1, /* list of selected local ID, includes selected ghosts */ const PetscInt clid_lid_1[], const PetscCoarsenData *agg_lists_1, /* selected_1 vertices of aggregate unselected vertices */ const PetscInt crsGID[], const PetscInt bs, Mat a_Prol, /* prolongation operator (output) */ PetscReal *a_worst_best) /* measure of worst missed fine vertex, 0 is no misses */ { #if defined(PETSC_HAVE_TRIANGLE) PetscErrorCode ierr; PetscInt jj,tid,tt,idx,nselected_2; struct triangulateio in,mid; const PetscInt *selected_idx_2; PetscMPIInt rank,size; PetscInt Istart,Iend,nFineLoc,myFine0; int kk,nPlotPts,sid; MPI_Comm comm; PetscReal tm; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)a_Prol,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = ISGetSize(selected_2, &nselected_2);CHKERRQ(ierr); if (nselected_2 == 1 || nselected_2 == 2) { /* 0 happens on idle processors */ *a_worst_best = 100.0; /* this will cause a stop, but not globalized (should not happen) */ } else *a_worst_best = 0.0; ierr = MPI_Allreduce(a_worst_best, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr); if (tm > 0.0) { *a_worst_best = 100.0; PetscFunctionReturn(0); } ierr = MatGetOwnershipRange(a_Prol, &Istart, &Iend);CHKERRQ(ierr); nFineLoc = (Iend-Istart)/bs; myFine0 = Istart/bs; nPlotPts = nFineLoc; /* locals */ /* traingle */ /* Define input points - in*/ in.numberofpoints = nselected_2; in.numberofpointattributes = 0; /* get nselected points */ ierr = PetscMalloc1(2*(nselected_2), &in.pointlist);CHKERRQ(ierr); ierr = ISGetIndices(selected_2, &selected_idx_2);CHKERRQ(ierr); for (kk=0,sid=0; kk<nselected_2; kk++,sid += 2) { PetscInt lid = selected_idx_2[kk]; in.pointlist[sid] = coords[lid]; in.pointlist[sid+1] = coords[data_stride + lid]; if (lid>=nFineLoc) nPlotPts++; } if (sid != 2*nselected_2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != 2*nselected_2 %D",sid,nselected_2); in.numberofsegments = 0; in.numberofedges = 0; in.numberofholes = 0; in.numberofregions = 0; in.trianglelist = 0; in.segmentmarkerlist = 0; in.pointattributelist = 0; in.pointmarkerlist = 0; in.triangleattributelist = 0; in.trianglearealist = 0; in.segmentlist = 0; in.holelist = 0; in.regionlist = 0; in.edgelist = 0; in.edgemarkerlist = 0; in.normlist = 0; /* triangulate */ mid.pointlist = 0; /* Not needed if -N switch used. */ /* Not needed if -N switch used or number of point attributes is zero: */ mid.pointattributelist = 0; mid.pointmarkerlist = 0; /* Not needed if -N or -B switch used. */ mid.trianglelist = 0; /* Not needed if -E switch used. */ /* Not needed if -E switch used or number of triangle attributes is zero: */ mid.triangleattributelist = 0; mid.neighborlist = 0; /* Needed only if -n switch used. */ /* Needed only if segments are output (-p or -c) and -P not used: */ mid.segmentlist = 0; /* Needed only if segments are output (-p or -c) and -P and -B not used: */ mid.segmentmarkerlist = 0; mid.edgelist = 0; /* Needed only if -e switch used. */ mid.edgemarkerlist = 0; /* Needed if -e used and -B not used. */ mid.numberoftriangles = 0; /* Triangulate the points. Switches are chosen to read and write a */ /* PSLG (p), preserve the convex hull (c), number everything from */ /* zero (z), assign a regional attribute to each element (A), and */ /* produce an edge list (e), a Voronoi diagram (v), and a triangle */ /* neighbor list (n). */ if (nselected_2 != 0) { /* inactive processor */ char args[] = "npczQ"; /* c is needed ? */ triangulate(args, &in, &mid, (struct triangulateio*) NULL); /* output .poly files for 'showme' */ if (!PETSC_TRUE) { static int level = 1; FILE *file; char fname[32]; sprintf(fname,"C%d_%d.poly",level,rank); file = fopen(fname, "w"); /*First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)>*/ fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); /*Following lines: <vertex #> <x> <y> */ for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid += 2) { fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]); } /*One line: <# of segments> <# of boundary markers (0 or 1)> */ fprintf(file, "%d %d\n",0,0); /*Following lines: <segment #> <endpoint> <endpoint> [boundary marker] */ /* One line: <# of holes> */ fprintf(file, "%d\n",0); /* Following lines: <hole #> <x> <y> */ /* Optional line: <# of regional attributes and/or area constraints> */ /* Optional following lines: <region #> <x> <y> <attribute> <maximum area> */ fclose(file); /* elems */ sprintf(fname,"C%d_%d.ele",level,rank); file = fopen(fname, "w"); /* First line: <# of triangles> <nodes per triangle> <# of attributes> */ fprintf(file, "%d %d %d\n",mid.numberoftriangles,3,0); /* Remaining lines: <triangle #> <node> <node> <node> ... [attributes] */ for (kk=0,sid=0; kk<mid.numberoftriangles; kk++,sid += 3) { fprintf(file, "%d %d %d %d\n",kk,mid.trianglelist[sid],mid.trianglelist[sid+1],mid.trianglelist[sid+2]); } fclose(file); sprintf(fname,"C%d_%d.node",level,rank); file = fopen(fname, "w"); /* First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)> */ /* fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); */ fprintf(file, "%d %d %d %d\n",nPlotPts,2,0,0); /*Following lines: <vertex #> <x> <y> */ for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid+=2) { fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]); } sid /= 2; for (jj=0; jj<nFineLoc; jj++) { PetscBool sel = PETSC_TRUE; for (kk=0; kk<nselected_2 && sel; kk++) { PetscInt lid = selected_idx_2[kk]; if (lid == jj) sel = PETSC_FALSE; } if (sel) fprintf(file, "%d %e %e\n",sid++,coords[jj],coords[data_stride + jj]); } fclose(file); if (sid != nPlotPts) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != nPlotPts %D",sid,nPlotPts); level++; } } #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventBegin(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr); #endif { /* form P - setup some maps */ PetscInt clid,mm,*nTri,*node_tri; ierr = PetscMalloc1(nselected_2, &node_tri);CHKERRQ(ierr); ierr = PetscMalloc1(nselected_2, &nTri);CHKERRQ(ierr); /* need list of triangles on node */ for (kk=0; kk<nselected_2; kk++) nTri[kk] = 0; for (tid=0,kk=0; tid<mid.numberoftriangles; tid++) { for (jj=0; jj<3; jj++) { PetscInt cid = mid.trianglelist[kk++]; if (nTri[cid] == 0) node_tri[cid] = tid; nTri[cid]++; } } #define EPS 1.e-12 /* find points and set prolongation */ for (mm = clid = 0; mm < nFineLoc; mm++) { PetscBool ise; ierr = PetscCDEmptyAt(agg_lists_1,mm,&ise);CHKERRQ(ierr); if (!ise) { const PetscInt lid = mm; /* for (clid_iterator=0;clid_iterator<nselected_1;clid_iterator++) { */ PetscScalar AA[3][3]; PetscBLASInt N=3,NRHS=1,LDA=3,IPIV[3],LDB=3,INFO; PetscCDPos pos; ierr = PetscCDGetHeadPos(agg_lists_1,lid,&pos);CHKERRQ(ierr); while (pos) { PetscInt flid; ierr = PetscLLNGetID(pos, &flid);CHKERRQ(ierr); ierr = PetscCDGetNextPos(agg_lists_1,lid,&pos);CHKERRQ(ierr); if (flid < nFineLoc) { /* could be a ghost */ PetscInt bestTID = -1; PetscReal best_alpha = 1.e10; const PetscInt fgid = flid + myFine0; /* compute shape function for gid */ const PetscReal fcoord[3] = {coords[flid],coords[data_stride+flid],1.0}; PetscBool haveit =PETSC_FALSE; PetscScalar alpha[3]; PetscInt clids[3]; /* look for it */ for (tid = node_tri[clid], jj=0; jj < 5 && !haveit && tid != -1; jj++) { for (tt=0; tt<3; tt++) { PetscInt cid2 = mid.trianglelist[3*tid + tt]; PetscInt lid2 = selected_idx_2[cid2]; AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0; clids[tt] = cid2; /* store for interp */ } for (tt=0; tt<3; tt++) alpha[tt] = (PetscScalar)fcoord[tt]; /* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */ PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO)); { PetscBool have=PETSC_TRUE; PetscReal lowest=1.e10; for (tt = 0, idx = 0; tt < 3; tt++) { if (PetscRealPart(alpha[tt]) > (1.0+EPS) || PetscRealPart(alpha[tt]) < -EPS) have = PETSC_FALSE; if (PetscRealPart(alpha[tt]) < lowest) { lowest = PetscRealPart(alpha[tt]); idx = tt; } } haveit = have; } tid = mid.neighborlist[3*tid + idx]; } if (!haveit) { /* brute force */ for (tid=0; tid<mid.numberoftriangles && !haveit; tid++) { for (tt=0; tt<3; tt++) { PetscInt cid2 = mid.trianglelist[3*tid + tt]; PetscInt lid2 = selected_idx_2[cid2]; AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0; clids[tt] = cid2; /* store for interp */ } for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt]; /* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */ PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO)); { PetscBool have=PETSC_TRUE; PetscReal worst=0.0, v; for (tt=0; tt<3 && have; tt++) { if (PetscRealPart(alpha[tt]) > 1.0+EPS || PetscRealPart(alpha[tt]) < -EPS) have=PETSC_FALSE; if ((v=PetscAbs(PetscRealPart(alpha[tt])-0.5)) > worst) worst = v; } if (worst < best_alpha) { best_alpha = worst; bestTID = tid; } haveit = have; } } } if (!haveit) { if (best_alpha > *a_worst_best) *a_worst_best = best_alpha; /* use best one */ for (tt=0; tt<3; tt++) { PetscInt cid2 = mid.trianglelist[3*bestTID + tt]; PetscInt lid2 = selected_idx_2[cid2]; AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0; clids[tt] = cid2; /* store for interp */ } for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt]; /* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */ PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO)); } /* put in row of P */ for (idx=0; idx<3; idx++) { PetscScalar shp = alpha[idx]; if (PetscAbs(PetscRealPart(shp)) > 1.e-6) { PetscInt cgid = crsGID[clids[idx]]; PetscInt jj = cgid*bs, ii = fgid*bs; /* need to gloalize */ for (tt=0; tt < bs; tt++, ii++, jj++) { ierr = MatSetValues(a_Prol,1,&ii,1,&jj,&shp,INSERT_VALUES);CHKERRQ(ierr); } } } } } /* aggregates iterations */ clid++; } /* a coarse agg */ } /* for all fine nodes */ ierr = ISRestoreIndices(selected_2, &selected_idx_2);CHKERRQ(ierr); ierr = MatAssemblyBegin(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscFree(node_tri);CHKERRQ(ierr); ierr = PetscFree(nTri);CHKERRQ(ierr); } #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventEnd(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr); #endif free(mid.trianglelist); free(mid.neighborlist); ierr = PetscFree(in.pointlist);CHKERRQ(ierr); PetscFunctionReturn(0); #else SETERRQ(PetscObjectComm((PetscObject)a_Prol),PETSC_ERR_PLIB,"configure with TRIANGLE to use geometric MG"); #endif }
static PetscErrorCode getGIDsOnSquareGraph(const PetscInt nselected_1,const PetscInt clid_lid_1[],const Mat Gmat1,IS *a_selected_2,Mat *a_Gmat_2,PetscInt **a_crsGID) { PetscErrorCode ierr; PetscMPIInt rank,size; PetscInt *crsGID, kk,my0,Iend,nloc; MPI_Comm comm; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)Gmat1,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Gmat1,&my0,&Iend);CHKERRQ(ierr); /* AIJ */ nloc = Iend - my0; /* this does not change */ if (size == 1) { /* not much to do in serial */ ierr = PetscMalloc1(nselected_1, &crsGID);CHKERRQ(ierr); for (kk=0; kk<nselected_1; kk++) crsGID[kk] = kk; *a_Gmat_2 = 0; ierr = ISCreateGeneral(PETSC_COMM_SELF,nselected_1,clid_lid_1,PETSC_COPY_VALUES,a_selected_2);CHKERRQ(ierr); } else { PetscInt idx,num_fine_ghosts,num_crs_ghost,myCrs0; Mat_MPIAIJ *mpimat2; Mat Gmat2; Vec locState; PetscScalar *cpcol_state; /* scan my coarse zero gid, set 'lid_state' with coarse GID */ kk = nselected_1; MPI_Scan(&kk, &myCrs0, 1, MPIU_INT, MPIU_SUM, comm); myCrs0 -= nselected_1; if (a_Gmat_2) { /* output */ /* grow graph to get wider set of selected vertices to cover fine grid, invalidates 'llist' */ ierr = MatTransposeMatMult(Gmat1, Gmat1, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &Gmat2);CHKERRQ(ierr); *a_Gmat_2 = Gmat2; /* output */ } else Gmat2 = Gmat1; /* use local to get crsGIDs at least */ /* get coarse grid GIDS for selected (locals and ghosts) */ mpimat2 = (Mat_MPIAIJ*)Gmat2->data; ierr = MatGetVecs(Gmat2, &locState, 0);CHKERRQ(ierr); ierr = VecSet(locState, (PetscScalar)(PetscReal)(-1));CHKERRQ(ierr); /* set with UNKNOWN state */ for (kk=0; kk<nselected_1; kk++) { PetscInt fgid = clid_lid_1[kk] + my0; PetscScalar v = (PetscScalar)(kk+myCrs0); ierr = VecSetValues(locState, 1, &fgid, &v, INSERT_VALUES);CHKERRQ(ierr); /* set with PID */ } ierr = VecAssemblyBegin(locState);CHKERRQ(ierr); ierr = VecAssemblyEnd(locState);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat2->Mvctx,locState,mpimat2->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat2->Mvctx,locState,mpimat2->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetLocalSize(mpimat2->lvec, &num_fine_ghosts);CHKERRQ(ierr); ierr = VecGetArray(mpimat2->lvec, &cpcol_state);CHKERRQ(ierr); for (kk=0,num_crs_ghost=0; kk<num_fine_ghosts; kk++) { if ((PetscInt)PetscRealPart(cpcol_state[kk]) != -1) num_crs_ghost++; } ierr = PetscMalloc1((nselected_1+num_crs_ghost), &crsGID);CHKERRQ(ierr); /* output */ { PetscInt *selected_set; ierr = PetscMalloc1((nselected_1+num_crs_ghost), &selected_set);CHKERRQ(ierr); /* do ghost of 'crsGID' */ for (kk=0,idx=nselected_1; kk<num_fine_ghosts; kk++) { if ((PetscInt)PetscRealPart(cpcol_state[kk]) != -1) { PetscInt cgid = (PetscInt)PetscRealPart(cpcol_state[kk]); selected_set[idx] = nloc + kk; crsGID[idx++] = cgid; } } if (idx != (nselected_1+num_crs_ghost)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"idx %D != (nselected_1 %D + num_crs_ghost %D)",idx,nselected_1,num_crs_ghost); ierr = VecRestoreArray(mpimat2->lvec, &cpcol_state);CHKERRQ(ierr); /* do locals in 'crsGID' */ ierr = VecGetArray(locState, &cpcol_state);CHKERRQ(ierr); for (kk=0,idx=0; kk<nloc; kk++) { if ((PetscInt)PetscRealPart(cpcol_state[kk]) != -1) { PetscInt cgid = (PetscInt)PetscRealPart(cpcol_state[kk]); selected_set[idx] = kk; crsGID[idx++] = cgid; } } if (idx != nselected_1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"idx %D != nselected_1 %D",idx,nselected_1); ierr = VecRestoreArray(locState, &cpcol_state);CHKERRQ(ierr); if (a_selected_2 != 0) { /* output */ ierr = ISCreateGeneral(PETSC_COMM_SELF,(nselected_1+num_crs_ghost),selected_set,PETSC_OWN_POINTER,a_selected_2);CHKERRQ(ierr); } else { ierr = PetscFree(selected_set);CHKERRQ(ierr); } } ierr = VecDestroy(&locState);CHKERRQ(ierr); } *a_crsGID = crsGID; /* output */ PetscFunctionReturn(0); }
static PetscErrorCode MatPartitioningApply_Parmetis_Private(MatPartitioning part, PetscBool useND, IS *partitioning) { MatPartitioning_Parmetis *pmetis = (MatPartitioning_Parmetis*)part->data; PetscErrorCode ierr; PetscInt *locals = NULL; Mat mat = part->adj,amat,pmat; PetscBool flg; PetscInt bs = 1; PetscFunctionBegin; ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIADJ,&flg);CHKERRQ(ierr); if (flg) { amat = mat; ierr = PetscObjectReference((PetscObject)amat);CHKERRQ(ierr); } else { /* bs indicates if the converted matrix is "reduced" from the original and hence the resulting partition results need to be stretched to match the original matrix */ ierr = MatConvert(mat,MATMPIADJ,MAT_INITIAL_MATRIX,&amat);CHKERRQ(ierr); if (amat->rmap->n > 0) bs = mat->rmap->n/amat->rmap->n; } ierr = MatMPIAdjCreateNonemptySubcommMat(amat,&pmat);CHKERRQ(ierr); ierr = MPI_Barrier(PetscObjectComm((PetscObject)part));CHKERRQ(ierr); if (pmat) { MPI_Comm pcomm,comm; Mat_MPIAdj *adj = (Mat_MPIAdj*)pmat->data; PetscInt *vtxdist = pmat->rmap->range; PetscInt *xadj = adj->i; PetscInt *adjncy = adj->j; PetscInt *NDorder = NULL; PetscInt itmp = 0,wgtflag=0, numflag=0, ncon=1, nparts=part->n, options[24], i, j; real_t *tpwgts,*ubvec,itr=0.1; int status; ierr = PetscObjectGetComm((PetscObject)pmat,&pcomm);CHKERRQ(ierr); #if defined(PETSC_USE_DEBUG) /* check that matrix has no diagonal entries */ { PetscInt rstart; ierr = MatGetOwnershipRange(pmat,&rstart,NULL);CHKERRQ(ierr); for (i=0; i<pmat->rmap->n; i++) { for (j=xadj[i]; j<xadj[i+1]; j++) { if (adjncy[j] == i+rstart) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Row %d has diagonal entry; Parmetis forbids diagonal entry",i+rstart); } } } #endif ierr = PetscMalloc1(pmat->rmap->n,&locals);CHKERRQ(ierr); if (adj->values && !part->vertex_weights) wgtflag = 1; if (part->vertex_weights && !adj->values) wgtflag = 2; if (part->vertex_weights && adj->values) wgtflag = 3; if (PetscLogPrintInfo) {itmp = pmetis->printout; pmetis->printout = 127;} ierr = PetscMalloc1(ncon*nparts,&tpwgts);CHKERRQ(ierr); for (i=0; i<ncon; i++) { for (j=0; j<nparts; j++) { if (part->part_weights) { tpwgts[i*nparts+j] = part->part_weights[i*nparts+j]; } else { tpwgts[i*nparts+j] = 1./nparts; } } } ierr = PetscMalloc1(ncon,&ubvec);CHKERRQ(ierr); for (i=0; i<ncon; i++) { ubvec[i] = 1.05; } /* This sets the defaults */ options[0] = 0; for (i=1; i<24; i++) { options[i] = -1; } /* Duplicate the communicator to be sure that ParMETIS attribute caching does not interfere with PETSc. */ ierr = MPI_Comm_dup(pcomm,&comm);CHKERRQ(ierr); if (useND) { PetscInt *sizes, *seps, log2size, subd, *level; PetscMPIInt size; idx_t mtype = PARMETIS_MTYPE_GLOBAL, rtype = PARMETIS_SRTYPE_2PHASE, p_nseps = 1, s_nseps = 1; real_t ubfrac = 1.05; ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = PetscMalloc1(pmat->rmap->n,&NDorder);CHKERRQ(ierr); ierr = PetscMalloc3(2*size,&sizes,4*size,&seps,size,&level);CHKERRQ(ierr); PetscStackCallParmetis(ParMETIS_V32_NodeND,((idx_t*)vtxdist,(idx_t*)xadj,(idx_t*)adjncy,(idx_t*)part->vertex_weights,(idx_t*)&numflag,&mtype,&rtype,&p_nseps,&s_nseps,&ubfrac,NULL/* seed */,NULL/* dbglvl */,(idx_t*)NDorder,(idx_t*)(sizes),&comm)); log2size = PetscLog2Real(size); subd = PetscPowInt(2,log2size); ierr = MatPartitioningSizesToSep_Private(subd,sizes,seps,level);CHKERRQ(ierr); for (i=0;i<pmat->rmap->n;i++) { PetscInt loc; ierr = PetscFindInt(NDorder[i],2*subd,seps,&loc);CHKERRQ(ierr); if (loc < 0) { loc = -(loc+1); if (loc%2) { /* part of subdomain */ locals[i] = loc/2; } else { ierr = PetscFindInt(NDorder[i],2*(subd-1),seps+2*subd,&loc);CHKERRQ(ierr); loc = loc < 0 ? -(loc+1)/2 : loc/2; locals[i] = level[loc]; } } else locals[i] = loc/2; } ierr = PetscFree3(sizes,seps,level);CHKERRQ(ierr); } else { if (pmetis->repartition) { PetscStackCallParmetis(ParMETIS_V3_AdaptiveRepart,((idx_t*)vtxdist,(idx_t*)xadj,(idx_t*)adjncy,(idx_t*)part->vertex_weights,(idx_t*)part->vertex_weights,(idx_t*)adj->values,(idx_t*)&wgtflag,(idx_t*)&numflag,(idx_t*)&ncon,(idx_t*)&nparts,tpwgts,ubvec,&itr,(idx_t*)options,(idx_t*)&pmetis->cuts,(idx_t*)locals,&comm)); } else { PetscStackCallParmetis(ParMETIS_V3_PartKway,((idx_t*)vtxdist,(idx_t*)xadj,(idx_t*)adjncy,(idx_t*)part->vertex_weights,(idx_t*)adj->values,(idx_t*)&wgtflag,(idx_t*)&numflag,(idx_t*)&ncon,(idx_t*)&nparts,tpwgts,ubvec,(idx_t*)options,(idx_t*)&pmetis->cuts,(idx_t*)locals,&comm)); } } ierr = MPI_Comm_free(&comm);CHKERRQ(ierr); ierr = PetscFree(tpwgts);CHKERRQ(ierr); ierr = PetscFree(ubvec);CHKERRQ(ierr); if (PetscLogPrintInfo) pmetis->printout = itmp; if (bs > 1) { PetscInt i,j,*newlocals; ierr = PetscMalloc1(bs*pmat->rmap->n,&newlocals);CHKERRQ(ierr); for (i=0; i<pmat->rmap->n; i++) { for (j=0; j<bs; j++) { newlocals[bs*i + j] = locals[i]; } } ierr = PetscFree(locals);CHKERRQ(ierr); ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),bs*pmat->rmap->n,newlocals,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr); } else { ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),pmat->rmap->n,locals,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr); } if (useND) { IS ndis; if (bs > 1) { ierr = ISCreateBlock(PetscObjectComm((PetscObject)part),bs,pmat->rmap->n,NDorder,PETSC_OWN_POINTER,&ndis);CHKERRQ(ierr); } else { ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),pmat->rmap->n,NDorder,PETSC_OWN_POINTER,&ndis);CHKERRQ(ierr); } ierr = ISSetPermutation(ndis);CHKERRQ(ierr); ierr = PetscObjectCompose((PetscObject)(*partitioning),"_petsc_matpartitioning_ndorder",(PetscObject)ndis);CHKERRQ(ierr); ierr = ISDestroy(&ndis);CHKERRQ(ierr); } } else { ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),0,NULL,PETSC_COPY_VALUES,partitioning);CHKERRQ(ierr); if (useND) { IS ndis; if (bs > 1) { ierr = ISCreateBlock(PetscObjectComm((PetscObject)part),bs,0,NULL,PETSC_COPY_VALUES,&ndis);CHKERRQ(ierr); } else { ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),0,NULL,PETSC_COPY_VALUES,&ndis);CHKERRQ(ierr); } ierr = ISSetPermutation(ndis);CHKERRQ(ierr); ierr = PetscObjectCompose((PetscObject)(*partitioning),"_petsc_matpartitioning_ndorder",(PetscObject)ndis);CHKERRQ(ierr); ierr = ISDestroy(&ndis);CHKERRQ(ierr); } } ierr = MatDestroy(&pmat);CHKERRQ(ierr); ierr = MatDestroy(&amat);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **args) { Mat C,Credundant; MatInfo info; PetscMPIInt rank,size,subsize; PetscInt i,j,m = 3,n = 2,low,high,iglobal; PetscInt Ii,J,ldim,nsubcomms; PetscErrorCode ierr; PetscBool flg_info,flg_mat; PetscScalar v,one = 1.0; Vec x,y; MPI_Comm subcomm; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); n = 2*size; ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); ierr = MatSetUp(C);CHKERRQ(ierr); /* Create the matrix for the five point stencil, YET AGAIN */ for (i=0; i<m; i++) { for (j=2*rank; j<2*rank+2; j++) { v = -1.0; Ii = j + n*i; if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr); } } /* Add extra elements (to illustrate variants of MatGetInfo) */ Ii = n; J = n-2; v = 100.0; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); Ii = n-2; J = n; v = 100.0; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Form vectors */ ierr = MatCreateVecs(C,&x,&y);CHKERRQ(ierr); ierr = VecGetLocalSize(x,&ldim);CHKERRQ(ierr); ierr = VecGetOwnershipRange(x,&low,&high);CHKERRQ(ierr); for (i=0; i<ldim; i++) { iglobal = i + low; v = one*((PetscReal)i) + 100.0*rank; ierr = VecSetValues(x,1,&iglobal,&v,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(x);CHKERRQ(ierr); ierr = VecAssemblyEnd(x);CHKERRQ(ierr); ierr = MatMult(C,x,y);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,NULL,"-view_info",&flg_info);CHKERRQ(ierr); if (flg_info) { ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr); ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = MatGetInfo(C,MAT_GLOBAL_SUM,&info);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,"matrix information (global sums):\nnonzeros = %D, allocated nonzeros = %D\n",(PetscInt)info.nz_used,(PetscInt)info.nz_allocated);CHKERRQ(ierr); ierr = MatGetInfo (C,MAT_GLOBAL_MAX,&info);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,"matrix information (global max):\nnonzeros = %D, allocated nonzeros = %D\n",(PetscInt)info.nz_used,(PetscInt)info.nz_allocated);CHKERRQ(ierr); } ierr = PetscOptionsHasName(NULL,NULL,"-view_mat",&flg_mat);CHKERRQ(ierr); if (flg_mat) { ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Test MatCreateRedundantMatrix() */ nsubcomms = size; ierr = PetscOptionsGetInt(NULL,NULL,"-nsubcomms",&nsubcomms,NULL);CHKERRQ(ierr); ierr = MatCreateRedundantMatrix(C,nsubcomms,MPI_COMM_NULL,MAT_INITIAL_MATRIX,&Credundant);CHKERRQ(ierr); ierr = MatCreateRedundantMatrix(C,nsubcomms,MPI_COMM_NULL,MAT_REUSE_MATRIX,&Credundant);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)Credundant,&subcomm);CHKERRQ(ierr); ierr = MPI_Comm_size(subcomm,&subsize);CHKERRQ(ierr); if (subsize==2 && flg_mat) { ierr = PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_(subcomm),"\n[%d] Credundant:\n",rank);CHKERRQ(ierr); ierr = MatView(Credundant,PETSC_VIEWER_STDOUT_(subcomm));CHKERRQ(ierr); } ierr = MatDestroy(&Credundant);CHKERRQ(ierr); /* Test MatCreateRedundantMatrix() with user-provided subcomm */ { PetscSubcomm psubcomm; ierr = PetscSubcommCreate(PETSC_COMM_WORLD,&psubcomm);CHKERRQ(ierr); ierr = PetscSubcommSetNumber(psubcomm,nsubcomms);CHKERRQ(ierr); ierr = PetscSubcommSetType(psubcomm,PETSC_SUBCOMM_CONTIGUOUS);CHKERRQ(ierr); /* enable runtime switch of psubcomm type, e.g., '-psubcomm_type interlaced */ ierr = PetscSubcommSetFromOptions(psubcomm);CHKERRQ(ierr); ierr = MatCreateRedundantMatrix(C,nsubcomms,PetscSubcommChild(psubcomm),MAT_INITIAL_MATRIX,&Credundant);CHKERRQ(ierr); ierr = MatCreateRedundantMatrix(C,nsubcomms,PetscSubcommChild(psubcomm),MAT_REUSE_MATRIX,&Credundant);CHKERRQ(ierr); ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr); ierr = MatDestroy(&Credundant);CHKERRQ(ierr); } ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&y);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
/*@C DMPlexDistribute - Distributes the mesh and any associated sections. Not Collective Input Parameter: + dm - The original DMPlex object . partitioner - The partitioning package, or NULL for the default - overlap - The overlap of partitions, 0 is the default Output Parameter: + sf - The PetscSF used for point distribution - parallelMesh - The distributed DMPlex object, or NULL Note: If the mesh was not distributed, the return value is NULL. The user can control the definition of adjacency for the mesh using DMPlexGetAdjacencyUseCone() and DMPlexSetAdjacencyUseClosure(). They should choose the combination appropriate for the function representation on the mesh. Level: intermediate .keywords: mesh, elements .seealso: DMPlexCreate(), DMPlexDistributeByFace(), DMPlexSetAdjacencyUseCone(), DMPlexSetAdjacencyUseClosure() @*/ PetscErrorCode DMPlexDistribute(DM dm, const char partitioner[], PetscInt overlap, PetscSF *sf, DM *dmParallel) { DM_Plex *mesh = (DM_Plex*) dm->data, *pmesh; MPI_Comm comm; const PetscInt height = 0; PetscInt dim, numRemoteRanks; IS origCellPart, origPart, cellPart, part; PetscSection origCellPartSection, origPartSection, cellPartSection, partSection; PetscSFNode *remoteRanks; PetscSF partSF, pointSF, coneSF; ISLocalToGlobalMapping renumbering; PetscSection originalConeSection, newConeSection; PetscInt *remoteOffsets; PetscInt *cones, *newCones, newConesSize; PetscBool flg; PetscMPIInt rank, numProcs, p; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); if (sf) PetscValidPointer(sf,4); PetscValidPointer(dmParallel,5); ierr = PetscLogEventBegin(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr); *dmParallel = NULL; if (numProcs == 1) PetscFunctionReturn(0); ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr); /* Create cell partition - We need to rewrite to use IS, use the MatPartition stuff */ ierr = PetscLogEventBegin(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr); if (overlap > 1) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Overlap > 1 not yet implemented"); ierr = DMPlexCreatePartition(dm, partitioner, height, overlap > 0 ? PETSC_TRUE : PETSC_FALSE, &cellPartSection, &cellPart, &origCellPartSection, &origCellPart);CHKERRQ(ierr); /* Create SF assuming a serial partition for all processes: Could check for IS length here */ if (!rank) numRemoteRanks = numProcs; else numRemoteRanks = 0; ierr = PetscMalloc1(numRemoteRanks, &remoteRanks);CHKERRQ(ierr); for (p = 0; p < numRemoteRanks; ++p) { remoteRanks[p].rank = p; remoteRanks[p].index = 0; } ierr = PetscSFCreate(comm, &partSF);CHKERRQ(ierr); ierr = PetscSFSetGraph(partSF, 1, numRemoteRanks, NULL, PETSC_OWN_POINTER, remoteRanks, PETSC_OWN_POINTER);CHKERRQ(ierr); ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-partition_view", &flg);CHKERRQ(ierr); if (flg) { ierr = PetscPrintf(comm, "Cell Partition:\n");CHKERRQ(ierr); ierr = PetscSectionView(cellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = ISView(cellPart, NULL);CHKERRQ(ierr); if (origCellPart) { ierr = PetscPrintf(comm, "Original Cell Partition:\n");CHKERRQ(ierr); ierr = PetscSectionView(origCellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = ISView(origCellPart, NULL);CHKERRQ(ierr); } ierr = PetscSFView(partSF, NULL);CHKERRQ(ierr); } /* Close the partition over the mesh */ ierr = DMPlexCreatePartitionClosure(dm, cellPartSection, cellPart, &partSection, &part);CHKERRQ(ierr); ierr = ISDestroy(&cellPart);CHKERRQ(ierr); ierr = PetscSectionDestroy(&cellPartSection);CHKERRQ(ierr); /* Create new mesh */ ierr = DMPlexCreate(comm, dmParallel);CHKERRQ(ierr); ierr = DMPlexSetDimension(*dmParallel, dim);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject) *dmParallel, "Parallel Mesh");CHKERRQ(ierr); pmesh = (DM_Plex*) (*dmParallel)->data; /* Distribute sieve points and the global point numbering (replaces creating remote bases) */ ierr = PetscSFConvertPartition(partSF, partSection, part, &renumbering, &pointSF);CHKERRQ(ierr); if (flg) { ierr = PetscPrintf(comm, "Point Partition:\n");CHKERRQ(ierr); ierr = PetscSectionView(partSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = ISView(part, NULL);CHKERRQ(ierr); ierr = PetscSFView(pointSF, NULL);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Point Renumbering after partition:\n");CHKERRQ(ierr); ierr = ISLocalToGlobalMappingView(renumbering, NULL);CHKERRQ(ierr); } ierr = PetscLogEventEnd(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr); ierr = PetscLogEventBegin(DMPLEX_DistributeCones,dm,0,0,0);CHKERRQ(ierr); /* Distribute cone section */ ierr = DMPlexGetConeSection(dm, &originalConeSection);CHKERRQ(ierr); ierr = DMPlexGetConeSection(*dmParallel, &newConeSection);CHKERRQ(ierr); ierr = PetscSFDistributeSection(pointSF, originalConeSection, &remoteOffsets, newConeSection);CHKERRQ(ierr); ierr = DMSetUp(*dmParallel);CHKERRQ(ierr); { PetscInt pStart, pEnd, p; ierr = PetscSectionGetChart(newConeSection, &pStart, &pEnd);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt coneSize; ierr = PetscSectionGetDof(newConeSection, p, &coneSize);CHKERRQ(ierr); pmesh->maxConeSize = PetscMax(pmesh->maxConeSize, coneSize); } } /* Communicate and renumber cones */ ierr = PetscSFCreateSectionSF(pointSF, originalConeSection, remoteOffsets, newConeSection, &coneSF);CHKERRQ(ierr); ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr); ierr = DMPlexGetCones(*dmParallel, &newCones);CHKERRQ(ierr); ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr); ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(newConeSection, &newConesSize);CHKERRQ(ierr); ierr = ISGlobalToLocalMappingApplyBlock(renumbering, IS_GTOLM_MASK, newConesSize, newCones, NULL, newCones);CHKERRQ(ierr); ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-cones_view", &flg);CHKERRQ(ierr); if (flg) { ierr = PetscPrintf(comm, "Serial Cone Section:\n");CHKERRQ(ierr); ierr = PetscSectionView(originalConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Parallel Cone Section:\n");CHKERRQ(ierr); ierr = PetscSectionView(newConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscSFView(coneSF, NULL);CHKERRQ(ierr); } ierr = DMPlexGetConeOrientations(dm, &cones);CHKERRQ(ierr); ierr = DMPlexGetConeOrientations(*dmParallel, &newCones);CHKERRQ(ierr); ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr); ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr); ierr = PetscSFDestroy(&coneSF);CHKERRQ(ierr); ierr = PetscLogEventEnd(DMPLEX_DistributeCones,dm,0,0,0);CHKERRQ(ierr); /* Create supports and stratify sieve */ { PetscInt pStart, pEnd; ierr = PetscSectionGetChart(pmesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr); ierr = PetscSectionSetChart(pmesh->supportSection, pStart, pEnd);CHKERRQ(ierr); } ierr = DMPlexSymmetrize(*dmParallel);CHKERRQ(ierr); ierr = DMPlexStratify(*dmParallel);CHKERRQ(ierr); /* Distribute Coordinates */ { PetscSection originalCoordSection, newCoordSection; Vec originalCoordinates, newCoordinates; PetscInt bs; const char *name; ierr = DMGetCoordinateSection(dm, &originalCoordSection);CHKERRQ(ierr); ierr = DMGetCoordinateSection(*dmParallel, &newCoordSection);CHKERRQ(ierr); ierr = DMGetCoordinatesLocal(dm, &originalCoordinates);CHKERRQ(ierr); ierr = VecCreate(comm, &newCoordinates);CHKERRQ(ierr); ierr = PetscObjectGetName((PetscObject) originalCoordinates, &name);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject) newCoordinates, name);CHKERRQ(ierr); ierr = DMPlexDistributeField(dm, pointSF, originalCoordSection, originalCoordinates, newCoordSection, newCoordinates);CHKERRQ(ierr); ierr = DMSetCoordinatesLocal(*dmParallel, newCoordinates);CHKERRQ(ierr); ierr = VecGetBlockSize(originalCoordinates, &bs);CHKERRQ(ierr); ierr = VecSetBlockSize(newCoordinates, bs);CHKERRQ(ierr); ierr = VecDestroy(&newCoordinates);CHKERRQ(ierr); } /* Distribute labels */ ierr = PetscLogEventBegin(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr); { DMLabel next = mesh->labels, newNext = pmesh->labels; PetscInt numLabels = 0, l; /* Bcast number of labels */ while (next) {++numLabels; next = next->next;} ierr = MPI_Bcast(&numLabels, 1, MPIU_INT, 0, comm);CHKERRQ(ierr); next = mesh->labels; for (l = 0; l < numLabels; ++l) { DMLabel labelNew; PetscBool isdepth; /* Skip "depth" because it is recreated */ if (!rank) {ierr = PetscStrcmp(next->name, "depth", &isdepth);CHKERRQ(ierr);} ierr = MPI_Bcast(&isdepth, 1, MPIU_BOOL, 0, comm);CHKERRQ(ierr); if (isdepth) {if (!rank) next = next->next; continue;} ierr = DMLabelDistribute(next, partSection, part, renumbering, &labelNew);CHKERRQ(ierr); /* Insert into list */ if (newNext) newNext->next = labelNew; else pmesh->labels = labelNew; newNext = labelNew; if (!rank) next = next->next; } } ierr = PetscLogEventEnd(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr); /* Setup hybrid structure */ { const PetscInt *gpoints; PetscInt depth, n, d; for (d = 0; d <= dim; ++d) {pmesh->hybridPointMax[d] = mesh->hybridPointMax[d];} ierr = MPI_Bcast(pmesh->hybridPointMax, dim+1, MPIU_INT, 0, comm);CHKERRQ(ierr); ierr = ISLocalToGlobalMappingGetSize(renumbering, &n);CHKERRQ(ierr); ierr = ISLocalToGlobalMappingGetIndices(renumbering, &gpoints);CHKERRQ(ierr); ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr); for (d = 0; d <= dim; ++d) { PetscInt pmax = pmesh->hybridPointMax[d], newmax = 0, pEnd, stratum[2], p; if (pmax < 0) continue; ierr = DMPlexGetDepthStratum(dm, d > depth ? depth : d, &stratum[0], &stratum[1]);CHKERRQ(ierr); ierr = DMPlexGetDepthStratum(*dmParallel, d, NULL, &pEnd);CHKERRQ(ierr); ierr = MPI_Bcast(stratum, 2, MPIU_INT, 0, comm);CHKERRQ(ierr); for (p = 0; p < n; ++p) { const PetscInt point = gpoints[p]; if ((point >= stratum[0]) && (point < stratum[1]) && (point >= pmax)) ++newmax; } if (newmax > 0) pmesh->hybridPointMax[d] = pEnd - newmax; else pmesh->hybridPointMax[d] = -1; } ierr = ISLocalToGlobalMappingRestoreIndices(renumbering, &gpoints);CHKERRQ(ierr); } /* Cleanup Partition */ ierr = ISLocalToGlobalMappingDestroy(&renumbering);CHKERRQ(ierr); ierr = PetscSFDestroy(&partSF);CHKERRQ(ierr); ierr = PetscSectionDestroy(&partSection);CHKERRQ(ierr); ierr = ISDestroy(&part);CHKERRQ(ierr); /* Create point SF for parallel mesh */ ierr = PetscLogEventBegin(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr); { const PetscInt *leaves; PetscSFNode *remotePoints, *rowners, *lowners; PetscInt numRoots, numLeaves, numGhostPoints = 0, p, gp, *ghostPoints; PetscInt pStart, pEnd; ierr = DMPlexGetChart(*dmParallel, &pStart, &pEnd);CHKERRQ(ierr); ierr = PetscSFGetGraph(pointSF, &numRoots, &numLeaves, &leaves, NULL);CHKERRQ(ierr); ierr = PetscMalloc2(numRoots,&rowners,numLeaves,&lowners);CHKERRQ(ierr); for (p=0; p<numRoots; p++) { rowners[p].rank = -1; rowners[p].index = -1; } if (origCellPart) { /* Make sure points in the original partition are not assigned to other procs */ const PetscInt *origPoints; ierr = DMPlexCreatePartitionClosure(dm, origCellPartSection, origCellPart, &origPartSection, &origPart);CHKERRQ(ierr); ierr = ISGetIndices(origPart, &origPoints);CHKERRQ(ierr); for (p = 0; p < numProcs; ++p) { PetscInt dof, off, d; ierr = PetscSectionGetDof(origPartSection, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(origPartSection, p, &off);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { rowners[origPoints[d]].rank = p; } } ierr = ISRestoreIndices(origPart, &origPoints);CHKERRQ(ierr); ierr = ISDestroy(&origPart);CHKERRQ(ierr); ierr = PetscSectionDestroy(&origPartSection);CHKERRQ(ierr); } ierr = ISDestroy(&origCellPart);CHKERRQ(ierr); ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr); ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr); ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr); for (p = 0; p < numLeaves; ++p) { if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */ lowners[p].rank = rank; lowners[p].index = leaves ? leaves[p] : p; } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */ lowners[p].rank = -2; lowners[p].index = -2; } } for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */ rowners[p].rank = -3; rowners[p].index = -3; } ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr); ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr); ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr); ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr); for (p = 0; p < numLeaves; ++p) { if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed"); if (lowners[p].rank != rank) ++numGhostPoints; } ierr = PetscMalloc1(numGhostPoints, &ghostPoints);CHKERRQ(ierr); ierr = PetscMalloc1(numGhostPoints, &remotePoints);CHKERRQ(ierr); for (p = 0, gp = 0; p < numLeaves; ++p) { if (lowners[p].rank != rank) { ghostPoints[gp] = leaves ? leaves[p] : p; remotePoints[gp].rank = lowners[p].rank; remotePoints[gp].index = lowners[p].index; ++gp; } } ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr); ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr); ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr); } pmesh->useCone = mesh->useCone; pmesh->useClosure = mesh->useClosure; ierr = PetscLogEventEnd(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr); /* Copy BC */ ierr = DMPlexCopyBoundary(dm, *dmParallel);CHKERRQ(ierr); /* Cleanup */ if (sf) {*sf = pointSF;} else {ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);} ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr); ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode JacMatMultCompare(SNES snes,Vec x,Vec p,double hopt) { Vec yy1, yy2; /* work vectors */ PetscViewer view2; /* viewer */ Mat J; /* analytic Jacobian (set as preconditioner matrix) */ Mat Jmf; /* matrix-free Jacobian (set as true system matrix) */ double h; /* differencing parameter */ Vec f; PetscScalar alpha; PetscReal yy1n,yy2n,enorm; PetscErrorCode ierr; PetscInt i; PetscBool printv = PETSC_FALSE; char filename[32]; MPI_Comm comm; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr); /* Compute function and analytic Jacobian at x */ ierr = SNESGetJacobian(snes,&Jmf,&J,NULL,NULL);CHKERRQ(ierr); ierr = SNESComputeJacobian(snes,x,Jmf,J);CHKERRQ(ierr); ierr = SNESGetFunction(snes,&f,NULL,NULL);CHKERRQ(ierr); ierr = SNESComputeFunction(snes,x,f);CHKERRQ(ierr); /* Duplicate work vectors */ ierr = VecDuplicate(x,&yy2);CHKERRQ(ierr); ierr = VecDuplicate(x,&yy1);CHKERRQ(ierr); /* Compute true matrix-vector product */ ierr = MatMult(J,p,yy1);CHKERRQ(ierr); ierr = VecNorm(yy1,NORM_2,&yy1n);CHKERRQ(ierr); /* View product vector if desired */ ierr = PetscOptionsGetBool(NULL,"-print_vecs",&printv,NULL);CHKERRQ(ierr); if (printv) { ierr = PetscViewerASCIIOpen(comm,"y1.out",&view2);CHKERRQ(ierr); ierr = PetscViewerSetFormat(view2,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr); ierr = VecView(yy1,view2);CHKERRQ(ierr); ierr = PetscViewerDestroy(&view2);CHKERRQ(ierr); } /* Test Jacobian-vector product computation */ alpha = -1.0; h = 0.01 * hopt; for (i=0; i<5; i++) { /* Set differencing parameter for matrix-free multiplication */ ierr = SNESDefaultMatrixFreeSetParameters2(Jmf,PETSC_DEFAULT,PETSC_DEFAULT,h);CHKERRQ(ierr); /* Compute matrix-vector product via differencing approximation */ ierr = MatMult(Jmf,p,yy2);CHKERRQ(ierr); ierr = VecNorm(yy2,NORM_2,&yy2n);CHKERRQ(ierr); /* View product vector if desired */ if (printv) { sprintf(filename,"y2.%d.out",(int)i); ierr = PetscViewerASCIIOpen(comm,filename,&view2);CHKERRQ(ierr); ierr = PetscViewerSetFormat(view2,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr); ierr = VecView(yy2,view2);CHKERRQ(ierr); ierr = PetscViewerDestroy(&view2);CHKERRQ(ierr); } /* Compute relative error */ ierr = VecAXPY(yy2,alpha,yy1);CHKERRQ(ierr); ierr = VecNorm(yy2,NORM_2,&enorm);CHKERRQ(ierr); enorm = enorm/yy1n; ierr = PetscFPrintf(comm,stdout,"h = %g: relative error = %g\n",(double)h,(double)enorm);CHKERRQ(ierr); h *= 10.0; } PetscFunctionReturn(0); }
static PetscErrorCode PCSetUp_Redundant(PC pc) { PC_Redundant *red = (PC_Redundant*)pc->data; PetscErrorCode ierr; PetscInt mstart,mend,mlocal,M; PetscMPIInt size; MPI_Comm comm,subcomm; Vec x; const char *prefix; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr); /* if pmatrix set by user is sequential then we do not need to gather the parallel matrix */ ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); if (size == 1) red->useparallelmat = PETSC_FALSE; if (!pc->setupcalled) { PetscInt mloc_sub; if (!red->psubcomm) { ierr = PetscSubcommCreate(comm,&red->psubcomm);CHKERRQ(ierr); ierr = PetscSubcommSetNumber(red->psubcomm,red->nsubcomm);CHKERRQ(ierr); ierr = PetscSubcommSetType(red->psubcomm,PETSC_SUBCOMM_CONTIGUOUS);CHKERRQ(ierr); /* enable runtime switch of psubcomm type, e.g., '-psubcomm_type interlaced */ ierr = PetscSubcommSetFromOptions(red->psubcomm);CHKERRQ(ierr); ierr = PetscLogObjectMemory((PetscObject)pc,sizeof(PetscSubcomm));CHKERRQ(ierr); /* create a new PC that processors in each subcomm have copy of */ subcomm = PetscSubcommChild(red->psubcomm); ierr = KSPCreate(subcomm,&red->ksp);CHKERRQ(ierr); ierr = KSPSetErrorIfNotConverged(red->ksp,pc->erroriffailure);CHKERRQ(ierr); ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr); ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)red->ksp);CHKERRQ(ierr); ierr = KSPSetType(red->ksp,KSPPREONLY);CHKERRQ(ierr); ierr = KSPGetPC(red->ksp,&red->pc);CHKERRQ(ierr); ierr = PCSetType(red->pc,PCLU);CHKERRQ(ierr); ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr); ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr); ierr = KSPAppendOptionsPrefix(red->ksp,"redundant_");CHKERRQ(ierr); } else { subcomm = PetscSubcommChild(red->psubcomm); } if (red->useparallelmat) { /* grab the parallel matrix and put it into processors of a subcomminicator */ ierr = MatCreateRedundantMatrix(pc->pmat,red->psubcomm->n,subcomm,MAT_INITIAL_MATRIX,&red->pmats);CHKERRQ(ierr); ierr = KSPSetOperators(red->ksp,red->pmats,red->pmats);CHKERRQ(ierr); /* get working vectors xsub and ysub */ ierr = MatCreateVecs(red->pmats,&red->xsub,&red->ysub);CHKERRQ(ierr); /* create working vectors xdup and ydup. xdup concatenates all xsub's contigously to form a mpi vector over dupcomm (see PetscSubcommCreate_interlaced()) ydup concatenates all ysub and has empty local arrays because ysub's arrays will be place into it. Note: we use communicator dupcomm, not PetscObjectComm((PetscObject)pc)! */ ierr = MatGetLocalSize(red->pmats,&mloc_sub,NULL);CHKERRQ(ierr); ierr = VecCreateMPI(PetscSubcommContiguousParent(red->psubcomm),mloc_sub,PETSC_DECIDE,&red->xdup);CHKERRQ(ierr); ierr = VecCreateMPIWithArray(PetscSubcommContiguousParent(red->psubcomm),1,mloc_sub,PETSC_DECIDE,NULL,&red->ydup);CHKERRQ(ierr); /* create vecscatters */ if (!red->scatterin) { /* efficiency of scatterin is independent from psubcomm_type! */ IS is1,is2; PetscInt *idx1,*idx2,i,j,k; ierr = MatCreateVecs(pc->pmat,&x,0);CHKERRQ(ierr); ierr = VecGetSize(x,&M);CHKERRQ(ierr); ierr = VecGetOwnershipRange(x,&mstart,&mend);CHKERRQ(ierr); mlocal = mend - mstart; ierr = PetscMalloc2(red->psubcomm->n*mlocal,&idx1,red->psubcomm->n*mlocal,&idx2);CHKERRQ(ierr); j = 0; for (k=0; k<red->psubcomm->n; k++) { for (i=mstart; i<mend; i++) { idx1[j] = i; idx2[j++] = i + M*k; } } ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx1,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr); ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx2,PETSC_COPY_VALUES,&is2);CHKERRQ(ierr); ierr = VecScatterCreate(x,is1,red->xdup,is2,&red->scatterin);CHKERRQ(ierr); ierr = ISDestroy(&is1);CHKERRQ(ierr); ierr = ISDestroy(&is2);CHKERRQ(ierr); /* Impl below is good for PETSC_SUBCOMM_INTERLACED (no inter-process communication) and PETSC_SUBCOMM_CONTIGUOUS (communication within subcomm) */ ierr = ISCreateStride(comm,mlocal,mstart+ red->psubcomm->color*M,1,&is1);CHKERRQ(ierr); ierr = ISCreateStride(comm,mlocal,mstart,1,&is2);CHKERRQ(ierr); ierr = VecScatterCreate(red->xdup,is1,x,is2,&red->scatterout);CHKERRQ(ierr); ierr = ISDestroy(&is1);CHKERRQ(ierr); ierr = ISDestroy(&is2);CHKERRQ(ierr); ierr = PetscFree2(idx1,idx2);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); } } else { /* !red->useparallelmat */ ierr = KSPSetOperators(red->ksp,pc->mat,pc->pmat);CHKERRQ(ierr); } } else { /* pc->setupcalled */ if (red->useparallelmat) { MatReuse reuse; /* grab the parallel matrix and put it into processors of a subcomminicator */ /*--------------------------------------------------------------------------*/ if (pc->flag == DIFFERENT_NONZERO_PATTERN) { /* destroy old matrices */ ierr = MatDestroy(&red->pmats);CHKERRQ(ierr); reuse = MAT_INITIAL_MATRIX; } else { reuse = MAT_REUSE_MATRIX; } ierr = MatCreateRedundantMatrix(pc->pmat,red->psubcomm->n,PetscSubcommChild(red->psubcomm),reuse,&red->pmats);CHKERRQ(ierr); ierr = KSPSetOperators(red->ksp,red->pmats,red->pmats);CHKERRQ(ierr); } else { /* !red->useparallelmat */ ierr = KSPSetOperators(red->ksp,pc->mat,pc->pmat);CHKERRQ(ierr); } } if (pc->setfromoptionscalled) { ierr = KSPSetFromOptions(red->ksp);CHKERRQ(ierr); } ierr = KSPSetUp(red->ksp);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode SNESDiffParameterCompute_More(SNES snes,void *nePv,Vec x,Vec p,double *fnoise,double *hopt) { DIFFPAR_MORE *neP = (DIFFPAR_MORE*)nePv; Vec w, xp, fvec; /* work vectors to use in computing h */ double zero = 0.0, hl, hu, h, fnoise_s, fder2_s; PetscScalar alpha; PetscScalar fval[7], tab[7][7], eps[7], f = -1; double rerrf = -1., fder2; PetscErrorCode ierr; PetscInt iter, k, i, j, info; PetscInt nf = 7; /* number of function evaluations */ PetscInt fcount; MPI_Comm comm; FILE *fp; PetscBool noise_test = PETSC_FALSE; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr); /* Call to SNESSetUp() just to set data structures in SNES context */ if (!snes->setupcalled) {ierr = SNESSetUp(snes);CHKERRQ(ierr);} w = neP->workv[0]; xp = neP->workv[1]; fvec = neP->workv[2]; fp = neP->fp; /* Initialize parameters */ hl = zero; hu = zero; h = neP->h_first_try; fnoise_s = zero; fder2_s = zero; fcount = neP->function_count; /* We have 5 tries to attempt to compute a good hopt value */ ierr = SNESGetIterationNumber(snes,&i);CHKERRQ(ierr); ierr = PetscFPrintf(comm,fp,"\n ------- SNES iteration %D ---------\n",i);CHKERRQ(ierr); for (iter=0; iter<5; iter++) { neP->h_first_try = h; /* Compute the nf function values needed to estimate the noise from the difference table */ for (k=0; k<nf; k++) { alpha = h * (k+1 - (nf+1)/2); ierr = VecWAXPY(xp,alpha,p,x);CHKERRQ(ierr); ierr = SNESComputeFunction(snes,xp,fvec);CHKERRQ(ierr); neP->function_count++; ierr = VecDot(fvec,w,&fval[k]);CHKERRQ(ierr); } f = fval[(nf+1)/2 - 1]; /* Construct the difference table */ for (i=0; i<nf; i++) tab[i][0] = fval[i]; for (j=0; j<6; j++) { for (i=0; i<nf-j; i++) { tab[i][j+1] = tab[i+1][j] - tab[i][j]; } } /* Print the difference table */ ierr = PetscFPrintf(comm,fp,"Difference Table: iter = %D\n",iter);CHKERRQ(ierr); for (i=0; i<nf; i++) { for (j=0; j<nf-i; j++) { ierr = PetscFPrintf(comm,fp," %10.2e ",tab[i][j]);CHKERRQ(ierr); } ierr = PetscFPrintf(comm,fp,"\n");CHKERRQ(ierr); } /* Call the noise estimator */ ierr = SNESNoise_dnest_(&nf,fval,&h,fnoise,&fder2,hopt,&info,eps);CHKERRQ(ierr); /* Output statements */ rerrf = *fnoise/PetscAbsScalar(f); if (info == 1) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise detected");CHKERRQ(ierr);} if (info == 2) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise not detected; h is too small");CHKERRQ(ierr);} if (info == 3) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise not detected; h is too large");CHKERRQ(ierr);} if (info == 4) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise detected, but unreliable hopt");CHKERRQ(ierr);} ierr = PetscFPrintf(comm,fp,"Approximate epsfcn %g %g %g %g %g %g\n",(double)eps[0],(double)eps[1],(double)eps[2],(double)eps[3],(double)eps[4],(double)eps[5]);CHKERRQ(ierr); ierr = PetscFPrintf(comm,fp,"h = %g, fnoise = %g, fder2 = %g, rerrf = %g, hopt = %g\n\n",(double)h, (double)*fnoise, (double)fder2, (double)rerrf, (double)*hopt);CHKERRQ(ierr); /* Save fnoise and fder2. */ if (*fnoise) fnoise_s = *fnoise; if (fder2) fder2_s = fder2; /* Check for noise detection. */ if (fnoise_s && fder2_s) { *fnoise = fnoise_s; fder2 = fder2_s; *hopt = 1.68*sqrt(*fnoise/PetscAbsScalar(fder2)); goto theend; } else { /* Update hl and hu, and determine new h */ if (info == 2 || info == 4) { hl = h; if (hu == zero) h = 100*h; else h = PetscMin(100*h,0.1*hu); } else if (info == 3) { hu = h; h = PetscMax(1.0e-3,sqrt(hl/hu))*hu; } } } theend: if (*fnoise < neP->fnoise_min) { ierr = PetscFPrintf(comm,fp,"Resetting fnoise: fnoise1 = %g, fnoise_min = %g\n",(double)*fnoise,(double)neP->fnoise_min);CHKERRQ(ierr); *fnoise = neP->fnoise_min; neP->fnoise_resets++; } if (*hopt < neP->hopt_min) { ierr = PetscFPrintf(comm,fp,"Resetting hopt: hopt1 = %g, hopt_min = %g\n",(double)*hopt,(double)neP->hopt_min);CHKERRQ(ierr); *hopt = neP->hopt_min; neP->hopt_resets++; } ierr = PetscFPrintf(comm,fp,"Errors in derivative:\n");CHKERRQ(ierr); ierr = PetscFPrintf(comm,fp,"f = %g, fnoise = %g, fder2 = %g, hopt = %g\n",(double)f,(double)*fnoise,(double)fder2,(double)*hopt);CHKERRQ(ierr); /* For now, compute h **each** MV Mult!! */ /* ierr = PetscOptionsHasName(NULL,"-matrix_free_jorge_each_mvp",&flg);CHKERRQ(ierr); if (!flg) { Mat mat; ierr = SNESGetJacobian(snes,&mat,NULL,NULL);CHKERRQ(ierr); ierr = SNESDefaultMatrixFreeSetParameters2(mat,PETSC_DEFAULT,PETSC_DEFAULT,*hopt);CHKERRQ(ierr); } */ fcount = neP->function_count - fcount; ierr = PetscInfo5(snes,"fct_now = %D, fct_cum = %D, rerrf=%g, sqrt(noise)=%g, h_more=%g\n",fcount,neP->function_count,(double)rerrf,(double)PetscSqrtReal(*fnoise),(double)*hopt);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-noise_test",&noise_test,NULL);CHKERRQ(ierr); if (noise_test) { ierr = JacMatMultCompare(snes,x,p,*hopt);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode SNESSolve_Test(SNES snes) { Mat A = snes->jacobian,B; Vec x = snes->vec_sol,f = snes->vec_func,f1 = snes->vec_sol_update; PetscErrorCode ierr; PetscInt i; PetscReal nrm,gnorm; SNES_Test *neP = (SNES_Test*)snes->data; PetscErrorCode (*objective)(SNES,Vec,PetscReal*,void*); void *ctx; PetscReal fnorm,f1norm,dnorm; PetscFunctionBegin; if (A != snes->jacobian_pre) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Cannot test with alternative preconditioner"); ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Testing hand-coded Jacobian, if the ratio is\n");CHKERRQ(ierr); ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"O(1.e-8), the hand-coded Jacobian is probably correct.\n");CHKERRQ(ierr); if (!neP->complete_print) { ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Run with -snes_test_display to show difference\n");CHKERRQ(ierr); ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"of hand-coded and finite difference Jacobian.\n");CHKERRQ(ierr); } for (i=0; i<3; i++) { void *functx; static const char *const loc[] = {"user-defined state","constant state -1.0","constant state 1.0"}; PetscInt m,n,M,N; if (i == 1) { ierr = VecSet(x,-1.0);CHKERRQ(ierr); } else if (i == 2) { ierr = VecSet(x,1.0);CHKERRQ(ierr); } /* evaluate the function at this point because SNESComputeJacobianDefaultColor() assumes that the function has been evaluated and put into snes->vec_func */ ierr = SNESComputeFunction(snes,x,f);CHKERRQ(ierr); if (snes->domainerror) { ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Domain error at %s\n",loc[i]);CHKERRQ(ierr); snes->domainerror = PETSC_FALSE; continue; } /* compute both versions of Jacobian */ ierr = SNESComputeJacobian(snes,x,A,A);CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)A),&B);CHKERRQ(ierr); ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr); ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr); ierr = MatSetSizes(B,m,n,M,N);CHKERRQ(ierr); ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr); ierr = MatSetUp(B);CHKERRQ(ierr); ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); ierr = SNESGetFunction(snes,NULL,NULL,&functx);CHKERRQ(ierr); ierr = SNESComputeJacobianDefault(snes,x,B,B,functx);CHKERRQ(ierr); if (neP->complete_print) { MPI_Comm comm; PetscViewer viewer; ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Finite difference Jacobian (%s)\n",loc[i]);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)B,&comm);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(comm,&viewer);CHKERRQ(ierr); ierr = MatView(B,viewer);CHKERRQ(ierr); } /* compare */ ierr = MatAYPX(B,-1.0,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatNorm(B,NORM_FROBENIUS,&nrm);CHKERRQ(ierr); ierr = MatNorm(A,NORM_FROBENIUS,&gnorm);CHKERRQ(ierr); if (neP->complete_print) { MPI_Comm comm; PetscViewer viewer; ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Hand-coded Jacobian (%s)\n",loc[i]);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)B,&comm);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(comm,&viewer);CHKERRQ(ierr); ierr = MatView(A,viewer);CHKERRQ(ierr); ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Hand-coded minus finite difference Jacobian (%s)\n",loc[i]);CHKERRQ(ierr); ierr = MatView(B,viewer);CHKERRQ(ierr); } if (!gnorm) gnorm = 1; /* just in case */ ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Norm of matrix ratio %g difference %g (%s)\n",(double)(nrm/gnorm),(double)nrm,loc[i]);CHKERRQ(ierr); ierr = SNESGetObjective(snes,&objective,&ctx);CHKERRQ(ierr); if (objective) { ierr = SNESComputeFunction(snes,x,f);CHKERRQ(ierr); ierr = VecNorm(f,NORM_2,&fnorm);CHKERRQ(ierr); if (neP->complete_print) { PetscViewer viewer; ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Hand-coded Function (%s)\n",loc[i]);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)snes),&viewer);CHKERRQ(ierr); ierr = VecView(f,viewer);CHKERRQ(ierr); } ierr = SNESObjectiveComputeFunctionDefaultFD(snes,x,f1,NULL);CHKERRQ(ierr); ierr = VecNorm(f1,NORM_2,&f1norm);CHKERRQ(ierr); if (neP->complete_print) { PetscViewer viewer; ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Finite-Difference Function (%s)\n",loc[i]);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)snes),&viewer);CHKERRQ(ierr); ierr = VecView(f1,viewer);CHKERRQ(ierr); } /* compare the two */ ierr = VecAXPY(f,-1.0,f1);CHKERRQ(ierr); ierr = VecNorm(f,NORM_2,&dnorm);CHKERRQ(ierr); if (!fnorm) fnorm = 1.; ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Norm of function ratio %g difference %g (%s)\n",dnorm/fnorm,dnorm,loc[i]);CHKERRQ(ierr); if (neP->complete_print) { PetscViewer viewer; ierr = PetscPrintf(PetscObjectComm((PetscObject)snes),"Difference (%s)\n",loc[i]);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)snes),&viewer);CHKERRQ(ierr); ierr = VecView(f,viewer);CHKERRQ(ierr); } } ierr = MatDestroy(&B);CHKERRQ(ierr); } /* Abort after the first iteration due to the jacobian not being valid. */ SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE,"SNESTest aborts after Jacobian test"); PetscFunctionReturn(0); }
PetscErrorCode DMPlexPreallocateOperator(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix) { MPI_Comm comm; MatType mtype; PetscSF sf, sfDof, sfAdj; PetscSection leafSectionAdj, rootSectionAdj, sectionAdj, anchorSectionAdj; PetscInt nroots, nleaves, l, p; const PetscInt *leaves; const PetscSFNode *remotes; PetscInt dim, pStart, pEnd, numDof, globalOffStart, globalOffEnd, numCols; PetscInt *tmpAdj = NULL, *adj, *rootAdj, *anchorAdj = NULL, *cols, *remoteOffsets; PetscInt adjSize; PetscLayout rLayout; PetscInt locRows, rStart, rEnd, r; PetscMPIInt size; PetscBool doCommLocal, doComm, debug = PETSC_FALSE, isSymBlock, isSymSeqBlock, isSymMPIBlock; PetscBool useAnchors; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 3); PetscValidHeaderSpecific(sectionGlobal, PETSC_SECTION_CLASSID, 4); PetscValidHeaderSpecific(A, MAT_CLASSID, 9); if (dnz) PetscValidPointer(dnz,5); if (onz) PetscValidPointer(onz,6); if (dnzu) PetscValidPointer(dnzu,7); if (onzu) PetscValidPointer(onzu,8); ierr = PetscLogEventBegin(DMPLEX_Preallocate,dm,0,0,0);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL, "-dm_view_preallocation", &debug, NULL);CHKERRQ(ierr); ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr); ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr); ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr); doCommLocal = (size > 1) && (nroots >= 0) ? PETSC_TRUE : PETSC_FALSE; ierr = MPI_Allreduce(&doCommLocal, &doComm, 1, MPIU_BOOL, MPI_LAND, comm);CHKERRQ(ierr); /* Create dof SF based on point SF */ if (debug) { ierr = PetscPrintf(comm, "Input Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Input Global Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(sectionGlobal, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Input SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sf, NULL);CHKERRQ(ierr); } ierr = PetscSFCreateRemoteOffsets(sf, section, section, &remoteOffsets);CHKERRQ(ierr); ierr = PetscSFCreateSectionSF(sf, section, remoteOffsets, section, &sfDof);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Dof SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sfDof, NULL);CHKERRQ(ierr); } /* Create section for dof adjacency (dof ==> # adj dof) */ ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(section, &numDof);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, &leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(leafSectionAdj, 0, numDof);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, &rootSectionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(rootSectionAdj, 0, numDof);CHKERRQ(ierr); /* Fill in the ghost dofs on the interface */ ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, &remotes);CHKERRQ(ierr); /* use constraints in finding adjacency in this routine */ ierr = DMPlexGetAdjacencyUseAnchors(dm,&useAnchors);CHKERRQ(ierr); ierr = DMPlexSetAdjacencyUseAnchors(dm,PETSC_TRUE);CHKERRQ(ierr); /* section - maps points to (# dofs, local dofs) sectionGlobal - maps points to (# dofs, global dofs) leafSectionAdj - maps unowned local dofs to # adj dofs rootSectionAdj - maps owned local dofs to # adj dofs adj - adj global dofs indexed by leafSectionAdj rootAdj - adj global dofs indexed by rootSectionAdj sf - describes shared points across procs sfDof - describes shared dofs across procs sfAdj - describes shared adjacent dofs across procs ** The bootstrapping process involves six rounds with similar structure of visiting neighbors of each point. (0). If there are point-to-point constraints, add the adjacencies of constrained points to anchors in anchorAdj (This is done in DMPlexComputeAnchorAdjacencies()) 1. Visit unowned points on interface, count adjacencies placing in leafSectionAdj Reduce those counts to rootSectionAdj (now redundantly counting some interface points) 2. Visit owned points on interface, count adjacencies placing in rootSectionAdj Create sfAdj connecting rootSectionAdj and leafSectionAdj 3. Visit unowned points on interface, write adjacencies to adj Gather adj to rootAdj (note that there is redundancy in rootAdj when multiple procs find the same adjacencies) 4. Visit owned points on interface, write adjacencies to rootAdj Remove redundancy in rootAdj ** The last two traversals use transitive closure 5. Visit all owned points in the subdomain, count dofs for each point (sectionAdj) Allocate memory addressed by sectionAdj (cols) 6. Visit all owned points in the subdomain, insert dof adjacencies into cols ** Knowing all the column adjacencies, check ownership and sum into dnz and onz */ ierr = DMPlexComputeAnchorAdjacencies(dm,section,sectionGlobal,&anchorSectionAdj,&anchorAdj);CHKERRQ(ierr); for (l = 0; l < nleaves; ++l) { PetscInt dof, off, d, q, anDof; PetscInt p = leaves[l], numAdj = PETSC_DETERMINE; if ((p < pStart) || (p >= pEnd)) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(leafSectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(leafSectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency Section for Preallocation on Leaves:\n");CHKERRQ(ierr); ierr = PetscSectionView(leafSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Get maximum remote adjacency sizes for owned dofs on interface (roots) */ if (doComm) { ierr = PetscSFReduceBegin(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr); ierr = PetscSFReduceEnd(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr); } if (debug) { ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Add in local adjacency sizes for owned dofs on interface (roots) */ for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, adof, dof, off, d, q, anDof; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(rootSectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(rootSectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after local additions:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Create adj SF based on dof SF */ ierr = PetscSFCreateRemoteOffsets(sfDof, rootSectionAdj, leafSectionAdj, &remoteOffsets);CHKERRQ(ierr); ierr = PetscSFCreateSectionSF(sfDof, rootSectionAdj, remoteOffsets, leafSectionAdj, &sfAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sfAdj, NULL);CHKERRQ(ierr); } ierr = PetscSFDestroy(&sfDof);CHKERRQ(ierr); /* Create leaf adjacency */ ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(leafSectionAdj, &adjSize);CHKERRQ(ierr); ierr = PetscCalloc1(adjSize, &adj);CHKERRQ(ierr); for (l = 0; l < nleaves; ++l) { PetscInt dof, off, d, q, anDof, anOff; PetscInt p = leaves[l], numAdj = PETSC_DETERMINE; if ((p < pStart) || (p >= pEnd)) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { PetscInt aoff, i = 0; ierr = PetscSectionGetOffset(leafSectionAdj, d, &aoff);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd) { adj[aoff+i] = (ngoff < 0 ? -(ngoff+1) : ngoff) + nd; ++i; } } for (q = 0; q < anDof; q++) { adj[aoff+i] = anchorAdj[anOff+q]; ++i; } } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Leaf adjacency indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, adj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Gather adjacenct indices to root */ ierr = PetscSectionGetStorageSize(rootSectionAdj, &adjSize);CHKERRQ(ierr); ierr = PetscMalloc1(adjSize, &rootAdj);CHKERRQ(ierr); for (r = 0; r < adjSize; ++r) rootAdj[r] = -1; if (doComm) { ierr = PetscSFGatherBegin(sfAdj, MPIU_INT, adj, rootAdj);CHKERRQ(ierr); ierr = PetscSFGatherEnd(sfAdj, MPIU_INT, adj, rootAdj);CHKERRQ(ierr); } ierr = PetscSFDestroy(&sfAdj);CHKERRQ(ierr); ierr = PetscFree(adj);CHKERRQ(ierr); /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Root adjacency indices after gather\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Add in local adjacency indices for owned dofs on interface (roots) */ for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, adof, dof, off, d, q, anDof, anOff; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { PetscInt adof, aoff, i; ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr); i = adof-1; for (q = 0; q < anDof; q++) { rootAdj[aoff+i] = anchorAdj[anOff+q]; --i; } for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd) { rootAdj[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd; --i; } } } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Root adjacency indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Compress indices */ ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt dof, cdof, off, d; PetscInt adof, aoff; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; for (d = off; d < off+dof-cdof; ++d) { ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr); ierr = PetscSortRemoveDupsInt(&adof, &rootAdj[aoff]);CHKERRQ(ierr); ierr = PetscSectionSetDof(rootSectionAdj, d, adof);CHKERRQ(ierr); } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after compression:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Root adjacency indices after compression\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Build adjacency section: Maps global indices to sets of adjacent global indices */ ierr = PetscSectionGetOffsetRange(sectionGlobal, &globalOffStart, &globalOffEnd);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, §ionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(sectionAdj, globalOffStart, globalOffEnd);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, dof, cdof, off, goff, d, q, anDof; PetscBool found = PETSC_TRUE; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); for (d = 0; d < dof-cdof; ++d) { PetscInt ldof, rdof; ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr); ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr); if (ldof > 0) { /* We do not own this point */ } else if (rdof > 0) { ierr = PetscSectionSetDof(sectionAdj, goff+d, rdof);CHKERRQ(ierr); } else { found = PETSC_FALSE; } } if (found) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, noff; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, padj, &noff);CHKERRQ(ierr); for (d = goff; d < goff+dof-cdof; ++d) { ierr = PetscSectionAddDof(sectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = goff; d < goff+dof-cdof; ++d) { ierr = PetscSectionAddDof(sectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(sectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(sectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Get adjacent indices */ ierr = PetscSectionGetStorageSize(sectionAdj, &numCols);CHKERRQ(ierr); ierr = PetscMalloc1(numCols, &cols);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, dof, cdof, off, goff, d, q, anDof, anOff; PetscBool found = PETSC_TRUE; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); for (d = 0; d < dof-cdof; ++d) { PetscInt ldof, rdof; ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr); ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr); if (ldof > 0) { /* We do not own this point */ } else if (rdof > 0) { PetscInt aoff, roff; ierr = PetscSectionGetOffset(sectionAdj, goff+d, &aoff);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, off+d, &roff);CHKERRQ(ierr); ierr = PetscMemcpy(&cols[aoff], &rootAdj[roff], rdof * sizeof(PetscInt));CHKERRQ(ierr); } else { found = PETSC_FALSE; } } if (found) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = goff; d < goff+dof-cdof; ++d) { PetscInt adof, aoff, i = 0; ierr = PetscSectionGetDof(sectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, d, &aoff);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; const PetscInt *ncind; /* Adjacent points may not be in the section chart */ if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintIndices(section, padj, &ncind);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd, ++i) { cols[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd; } } for (q = 0; q < anDof; q++, i++) { cols[aoff+i] = anchorAdj[anOff + q]; } if (i != adof) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of entries %D != %D for dof %D (point %D)", i, adof, d, p); } } ierr = PetscSectionDestroy(&anchorSectionAdj);CHKERRQ(ierr); ierr = PetscSectionDestroy(&leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionDestroy(&rootSectionAdj);CHKERRQ(ierr); ierr = PetscFree(anchorAdj);CHKERRQ(ierr); ierr = PetscFree(rootAdj);CHKERRQ(ierr); ierr = PetscFree(tmpAdj);CHKERRQ(ierr); /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Column indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, numCols, cols, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Create allocation vectors from adjacency graph */ ierr = MatGetLocalSize(A, &locRows, NULL);CHKERRQ(ierr); ierr = PetscLayoutCreate(PetscObjectComm((PetscObject)A), &rLayout);CHKERRQ(ierr); ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); /* Only loop over blocks of rows */ if (rStart%bs || rEnd%bs) SETERRQ3(PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONG, "Invalid layout [%d, %d) for matrix, must be divisible by block size %d", rStart, rEnd, bs); for (r = rStart/bs; r < rEnd/bs; ++r) { const PetscInt row = r*bs; PetscInt numCols, cStart, c; ierr = PetscSectionGetDof(sectionAdj, row, &numCols);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, row, &cStart);CHKERRQ(ierr); for (c = cStart; c < cStart+numCols; ++c) { if ((cols[c] >= rStart*bs) && (cols[c] < rEnd*bs)) { ++dnz[r-rStart]; if (cols[c] >= row) ++dnzu[r-rStart]; } else { ++onz[r-rStart]; if (cols[c] >= row) ++onzu[r-rStart]; } } } if (bs > 1) { for (r = 0; r < locRows/bs; ++r) { dnz[r] /= bs; onz[r] /= bs; dnzu[r] /= bs; onzu[r] /= bs; } } /* Set matrix pattern */ ierr = MatXAIJSetPreallocation(A, bs, dnz, onz, dnzu, onzu);CHKERRQ(ierr); ierr = MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); /* Check for symmetric storage */ ierr = MatGetType(A, &mtype);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr); if (isSymBlock || isSymSeqBlock || isSymMPIBlock) {ierr = MatSetOption(A, MAT_IGNORE_LOWER_TRIANGULAR, PETSC_TRUE);CHKERRQ(ierr);} /* Fill matrix with zeros */ if (fillMatrix) { PetscScalar *values; PetscInt maxRowLen = 0; for (r = rStart; r < rEnd; ++r) { PetscInt len; ierr = PetscSectionGetDof(sectionAdj, r, &len);CHKERRQ(ierr); maxRowLen = PetscMax(maxRowLen, len); } ierr = PetscCalloc1(maxRowLen, &values);CHKERRQ(ierr); for (r = rStart; r < rEnd; ++r) { PetscInt numCols, cStart; ierr = PetscSectionGetDof(sectionAdj, r, &numCols);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, r, &cStart);CHKERRQ(ierr); ierr = MatSetValues(A, 1, &r, numCols, &cols[cStart], values, INSERT_VALUES);CHKERRQ(ierr); } ierr = PetscFree(values);CHKERRQ(ierr); ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } /* restore original useAnchors */ ierr = DMPlexSetAdjacencyUseAnchors(dm,useAnchors);CHKERRQ(ierr); ierr = PetscSectionDestroy(§ionAdj);CHKERRQ(ierr); ierr = PetscFree(cols);CHKERRQ(ierr); ierr = PetscLogEventEnd(DMPLEX_Preallocate,dm,0,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C PetscBagView - Views a bag of values as either ASCII text or a binary file Collective on PetscBag Input Parameter: + bag - the bag of values - viewer - location to view the values Level: beginner Warning: Currently PETSc bags saved in a binary file can only be read back in on a machine of the same architecture. Let us know when this is a problem and we'll fix it. .seealso: PetscBag, PetscBagSetName(), PetscBagDestroy(), PetscBagLoad(), PetscBagGetData() PetscBagRegisterReal(), PetscBagRegisterInt(), PetscBagRegisterBool(), PetscBagRegisterScalar(), PetscBagRegisterEnum() PetscBagSetFromOptions(), PetscBagCreate(), PetscBagGetName() @*/ PetscErrorCode PetscBagView(PetscBag bag,PetscViewer view) { PetscBool isascii,isbinary; PetscErrorCode ierr; PetscBagItem nitem = bag->bagitems; PetscFunctionBegin; ierr = PetscObjectTypeCompare((PetscObject)view,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)view,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); if (isascii) { if (bag->bagprefix) { ierr = PetscViewerASCIIPrintf(view,"PetscBag Object: %s (%s) %s\n",bag->bagname,bag->bagprefix,bag->baghelp);CHKERRQ(ierr); } else { ierr = PetscViewerASCIIPrintf(view,"PetscBag Object: %s %s\n",bag->bagname,bag->baghelp);CHKERRQ(ierr); } while (nitem) { if (nitem->dtype == PETSC_CHAR) { char *value = (char*)(((char*)bag) + nitem->offset); char tmp = value[nitem->msize-1]; /* special handling for fortran chars wihout null terminator */ value[nitem->msize-1] =0; ierr = PetscViewerASCIIPrintf(view," %s = %s; %s\n",nitem->name,value,nitem->help);CHKERRQ(ierr); value[nitem->msize-1] = tmp; } else if (nitem->dtype == PETSC_REAL) { PetscReal *value = (PetscReal*)(((char*)bag) + nitem->offset); PetscInt i; ierr = PetscViewerASCIIPrintf(view," %s = ",nitem->name);CHKERRQ(ierr); for (i=0; i<nitem->msize; i++) { ierr = PetscViewerASCIIPrintf(view,"%g ",(double)value[i]);CHKERRQ(ierr); } ierr = PetscViewerASCIIPrintf(view,"; %s\n",nitem->help);CHKERRQ(ierr); } else if (nitem->dtype == PETSC_SCALAR) { PetscScalar value = *(PetscScalar*)(((char*)bag) + nitem->offset); #if defined(PETSC_USE_COMPLEX) if ((double)PetscImaginaryPart(value)) { ierr = PetscViewerASCIIPrintf(view," %s = %g + %gi; %s\n",nitem->name,(double)PetscRealPart(value),(double)PetscImaginaryPart(value),nitem->help);CHKERRQ(ierr); } else { ierr = PetscViewerASCIIPrintf(view," %s = %g; %s\n",nitem->name,(double)PetscRealPart(value),nitem->help);CHKERRQ(ierr); } #else ierr = PetscViewerASCIIPrintf(view," %s = %g; %s\n",nitem->name,(double)value,nitem->help);CHKERRQ(ierr); #endif } else if (nitem->dtype == PETSC_INT) { PetscInt i,*value = (PetscInt*)(((char*)bag) + nitem->offset); ierr = PetscViewerASCIIPrintf(view," %s = ",nitem->name);CHKERRQ(ierr); for (i=0; i<nitem->msize; i++) { ierr = PetscViewerASCIIPrintf(view,"%D ",value[i]);CHKERRQ(ierr); } ierr = PetscViewerASCIIPrintf(view,"; %s\n",nitem->help);CHKERRQ(ierr); } else if (nitem->dtype == PETSC_BOOL) { PetscBool *value = (PetscBool*)(((char*)bag) + nitem->offset); PetscInt i; /* some Fortran compilers use -1 as boolean */ ierr = PetscViewerASCIIPrintf(view," %s = ",nitem->name);CHKERRQ(ierr); for (i=0; i<nitem->msize; i++) { if (((int) value[i]) == -1) value[i] = PETSC_TRUE; /* the checks here with != PETSC_FALSE and PETSC_TRUE is a special case; here we truly demand that the value be 0 or 1 */ if (value[i] != PETSC_FALSE && value[i] != PETSC_TRUE) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Boolean value for %s %s is corrupt; integer value %d",nitem->name,nitem->help,value); ierr = PetscViewerASCIIPrintf(view," %s",PetscBools[value[i]]);CHKERRQ(ierr); } ierr = PetscViewerASCIIPrintf(view,"; %s\n",nitem->help);CHKERRQ(ierr); } else if (nitem->dtype == PETSC_ENUM) { PetscEnum value = *(PetscEnum*)(((char*)bag) + nitem->offset); PetscInt i = 0; while (nitem->list[i++]) ; ierr = PetscViewerASCIIPrintf(view," %s = %s; (%s) %s\n",nitem->name,nitem->list[value],nitem->list[i-3],nitem->help);CHKERRQ(ierr); } nitem = nitem->next; } } else if (isbinary) { PetscInt classid = PETSC_BAG_FILE_CLASSID, dtype; PetscInt deprecatedbagsize = 0; PetscViewerFormat format; ierr = PetscViewerBinaryWrite(view,&classid,1,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,&deprecatedbagsize,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,&bag->count,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,bag->bagname,PETSC_BAG_NAME_LENGTH,PETSC_CHAR,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,bag->baghelp,PETSC_BAG_HELP_LENGTH,PETSC_CHAR,PETSC_FALSE);CHKERRQ(ierr); while (nitem) { ierr = PetscViewerBinaryWrite(view,&nitem->offset,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); dtype = (PetscInt)nitem->dtype; ierr = PetscViewerBinaryWrite(view,&dtype,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,nitem->name,PETSC_BAG_NAME_LENGTH,PETSC_CHAR,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,nitem->help,PETSC_BAG_HELP_LENGTH,PETSC_CHAR,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerBinaryWrite(view,&nitem->msize,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); /* some Fortran compilers use -1 as boolean */ if (dtype == PETSC_BOOL && ((*(int*) (((char*)bag) + nitem->offset) == -1))) *(int*) (((char*)bag) + nitem->offset) = PETSC_TRUE; ierr = PetscViewerBinaryWrite(view,(((char*)bag) + nitem->offset),nitem->msize,nitem->dtype,PETSC_FALSE);CHKERRQ(ierr); if (dtype == PETSC_ENUM) { ierr = PetscViewerBinaryWriteStringArray(view,(char**)nitem->list);CHKERRQ(ierr); } nitem = nitem->next; } ierr = PetscViewerGetFormat(view,&format);CHKERRQ(ierr); if (format == PETSC_VIEWER_BINARY_MATLAB) { MPI_Comm comm; FILE *info; ierr = PetscObjectGetComm((PetscObject)view,&comm);CHKERRQ(ierr); ierr = PetscViewerBinaryGetInfoPointer(view,&info);CHKERRQ(ierr); ierr = PetscFPrintf(comm,info,"#--- begin code written by PetscViewerBinary for MATLAB format ---#\n");CHKERRQ(ierr); ierr = PetscFPrintf(comm,info,"#$$ Set.%s = PetscBinaryRead(fd);\n",bag->bagname);CHKERRQ(ierr); ierr = PetscFPrintf(comm,info,"#--- end code written by PetscViewerBinary for MATLAB format ---#\n\n");CHKERRQ(ierr); } } PetscFunctionReturn(0); }
/*@ DMDASetUniformCoordinates - Sets a DMDA coordinates to be a uniform grid Collective on DMDA Input Parameters: + da - the distributed array object . xmin,xmax - extremes in the x direction . ymin,ymax - extremes in the y direction (use NULL for 1 dimensional problems) - zmin,zmax - extremes in the z direction (use NULL for 1 or 2 dimensional problems) Level: beginner .seealso: DMSetCoordinates(), DMGetCoordinates(), DMDACreate1d(), DMDACreate2d(), DMDACreate3d() @*/ PetscErrorCode DMDASetUniformCoordinates(DM da,PetscReal xmin,PetscReal xmax,PetscReal ymin,PetscReal ymax,PetscReal zmin,PetscReal zmax) { MPI_Comm comm; PetscSection section; DM cda; DMDABoundaryType bx,by,bz; Vec xcoor; PetscScalar *coors; PetscReal hx,hy,hz_; PetscInt i,j,k,M,N,P,istart,isize,jstart,jsize,kstart,ksize,dim,cnt; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(da,DM_CLASSID,1); ierr = DMDAGetInfo(da,&dim,&M,&N,&P,0,0,0,0,0,&bx,&by,&bz,0);CHKERRQ(ierr); if (xmax <= xmin) SETERRQ2(PetscObjectComm((PetscObject)da),PETSC_ERR_ARG_INCOMP,"xmax must be larger than xmin %G %G",xmin,xmax); if ((ymax <= ymin) && (dim > 1)) SETERRQ2(PetscObjectComm((PetscObject)da),PETSC_ERR_ARG_INCOMP,"ymax must be larger than ymin %G %G",ymin,ymax); if ((zmax <= zmin) && (dim > 2)) SETERRQ2(PetscObjectComm((PetscObject)da),PETSC_ERR_ARG_INCOMP,"zmax must be larger than zmin %G %G",zmin,zmax); ierr = PetscObjectGetComm((PetscObject)da,&comm);CHKERRQ(ierr); ierr = DMGetDefaultSection(da,§ion);CHKERRQ(ierr); ierr = DMDAGetCorners(da,&istart,&jstart,&kstart,&isize,&jsize,&ksize);CHKERRQ(ierr); ierr = DMGetCoordinateDM(da, &cda);CHKERRQ(ierr); if (section) { /* This would be better as a vector, but this is compatible */ PetscInt numComp[3] = {1, 1, 1}; PetscInt numVertexDof[3] = {1, 1, 1}; ierr = DMDASetFieldName(cda, 0, "x");CHKERRQ(ierr); if (dim > 1) {ierr = DMDASetFieldName(cda, 1, "y");CHKERRQ(ierr);} if (dim > 2) {ierr = DMDASetFieldName(cda, 2, "z");CHKERRQ(ierr);} ierr = DMDACreateSection(cda, numComp, numVertexDof, NULL, NULL);CHKERRQ(ierr); } ierr = DMCreateGlobalVector(cda, &xcoor);CHKERRQ(ierr); if (section) { PetscSection csection; PetscInt vStart, vEnd; ierr = DMGetDefaultGlobalSection(cda,&csection);CHKERRQ(ierr); ierr = VecGetArray(xcoor,&coors);CHKERRQ(ierr); ierr = DMDAGetHeightStratum(da, dim, &vStart, &vEnd);CHKERRQ(ierr); if (bx == DMDA_BOUNDARY_PERIODIC) hx = (xmax-xmin)/(M+1); else hx = (xmax-xmin)/(M ? M : 1); if (by == DMDA_BOUNDARY_PERIODIC) hy = (ymax-ymin)/(N+1); else hy = (ymax-ymin)/(N ? N : 1); if (bz == DMDA_BOUNDARY_PERIODIC) hz_ = (zmax-zmin)/(P+1); else hz_ = (zmax-zmin)/(P ? P : 1); switch (dim) { case 1: for (i = 0; i < isize+1; ++i) { PetscInt v = i+vStart, dof, off; ierr = PetscSectionGetDof(csection, v, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(csection, v, &off);CHKERRQ(ierr); if (off >= 0) { coors[off] = xmin + hx*(i+istart); } } break; case 2: for (j = 0; j < jsize+1; ++j) { for (i = 0; i < isize+1; ++i) { PetscInt v = j*(isize+1)+i+vStart, dof, off; ierr = PetscSectionGetDof(csection, v, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(csection, v, &off);CHKERRQ(ierr); if (off >= 0) { coors[off+0] = xmin + hx*(i+istart); coors[off+1] = ymin + hy*(j+jstart); } } } break; case 3: for (k = 0; k < ksize+1; ++k) { for (j = 0; j < jsize+1; ++j) { for (i = 0; i < isize+1; ++i) { PetscInt v = (k*(jsize+1)+j)*(isize+1)+i+vStart, dof, off; ierr = PetscSectionGetDof(csection, v, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(csection, v, &off);CHKERRQ(ierr); if (off >= 0) { coors[off+0] = xmin + hx*(i+istart); coors[off+1] = ymin + hy*(j+jstart); coors[off+2] = zmin + hz_*(k+kstart); } } } } break; default: SETERRQ1(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Cannot create uniform coordinates for this dimension %D\n",dim); } ierr = VecRestoreArray(xcoor,&coors);CHKERRQ(ierr); ierr = DMSetCoordinates(da,xcoor);CHKERRQ(ierr); ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)xcoor);CHKERRQ(ierr); ierr = VecDestroy(&xcoor);CHKERRQ(ierr); PetscFunctionReturn(0); } if (dim == 1) { if (bx == DMDA_BOUNDARY_PERIODIC) hx = (xmax-xmin)/M; else hx = (xmax-xmin)/(M-1); ierr = VecGetArray(xcoor,&coors);CHKERRQ(ierr); for (i=0; i<isize; i++) { coors[i] = xmin + hx*(i+istart); } ierr = VecRestoreArray(xcoor,&coors);CHKERRQ(ierr); } else if (dim == 2) { if (bx == DMDA_BOUNDARY_PERIODIC) hx = (xmax-xmin)/(M); else hx = (xmax-xmin)/(M-1); if (by == DMDA_BOUNDARY_PERIODIC) hy = (ymax-ymin)/(N); else hy = (ymax-ymin)/(N-1); ierr = VecGetArray(xcoor,&coors);CHKERRQ(ierr); cnt = 0; for (j=0; j<jsize; j++) { for (i=0; i<isize; i++) { coors[cnt++] = xmin + hx*(i+istart); coors[cnt++] = ymin + hy*(j+jstart); } } ierr = VecRestoreArray(xcoor,&coors);CHKERRQ(ierr); } else if (dim == 3) { if (bx == DMDA_BOUNDARY_PERIODIC) hx = (xmax-xmin)/(M); else hx = (xmax-xmin)/(M-1); if (by == DMDA_BOUNDARY_PERIODIC) hy = (ymax-ymin)/(N); else hy = (ymax-ymin)/(N-1); if (bz == DMDA_BOUNDARY_PERIODIC) hz_ = (zmax-zmin)/(P); else hz_ = (zmax-zmin)/(P-1); ierr = VecGetArray(xcoor,&coors);CHKERRQ(ierr); cnt = 0; for (k=0; k<ksize; k++) { for (j=0; j<jsize; j++) { for (i=0; i<isize; i++) { coors[cnt++] = xmin + hx*(i+istart); coors[cnt++] = ymin + hy*(j+jstart); coors[cnt++] = zmin + hz_*(k+kstart); } } } ierr = VecRestoreArray(xcoor,&coors);CHKERRQ(ierr); } else SETERRQ1(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Cannot create uniform coordinates for this dimension %D\n",dim); ierr = DMSetCoordinates(da,xcoor);CHKERRQ(ierr); ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)xcoor);CHKERRQ(ierr); ierr = VecDestroy(&xcoor);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode TaoSolve_Test(Tao tao) { Mat A = tao->hessian,B; Vec x = tao->solution,g1,g2; PetscErrorCode ierr; PetscInt i; PetscReal nrm,gnorm,hcnorm,fdnorm; MPI_Comm comm; Tao_Test *fd = (Tao_Test*)tao->data; PetscFunctionBegin; comm = ((PetscObject)tao)->comm; if (fd->check_gradient) { ierr = VecDuplicate(x,&g1);CHKERRQ(ierr); ierr = VecDuplicate(x,&g2);CHKERRQ(ierr); ierr = PetscPrintf(comm,"Testing hand-coded gradient (hc) against finite difference gradient (fd), if the ratio ||fd - hc|| / ||hc|| is\n");CHKERRQ(ierr); ierr = PetscPrintf(comm,"0 (1.e-8), the hand-coded gradient is probably correct.\n");CHKERRQ(ierr); if (!fd->complete_print) { ierr = PetscPrintf(comm,"Run with -tao_test_display to show difference\n");CHKERRQ(ierr); ierr = PetscPrintf(comm,"between hand-coded and finite difference gradient.\n");CHKERRQ(ierr); } for (i=0; i<3; i++) { if (i == 1) {ierr = VecSet(x,-1.0);CHKERRQ(ierr);} else if (i == 2) {ierr = VecSet(x,1.0);CHKERRQ(ierr);} /* Compute both version of gradient */ ierr = TaoComputeGradient(tao,x,g1);CHKERRQ(ierr); ierr = TaoDefaultComputeGradient(tao,x,g2,NULL);CHKERRQ(ierr); if (fd->complete_print) { MPI_Comm gcomm; PetscViewer viewer; ierr = PetscPrintf(comm,"Finite difference gradient\n");CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)g2,&gcomm);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(gcomm,&viewer);CHKERRQ(ierr); ierr = VecView(g2,viewer);CHKERRQ(ierr); ierr = PetscPrintf(comm,"Hand-coded gradient\n");CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)g1,&gcomm);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(gcomm,&viewer);CHKERRQ(ierr); ierr = VecView(g1,viewer);CHKERRQ(ierr); ierr = PetscPrintf(comm,"\n");CHKERRQ(ierr); } ierr = VecAXPY(g2,-1.0,g1);CHKERRQ(ierr); ierr = VecNorm(g1,NORM_2,&hcnorm);CHKERRQ(ierr); ierr = VecNorm(g2,NORM_2,&fdnorm);CHKERRQ(ierr); if (!hcnorm) hcnorm=1.0e-20; ierr = PetscPrintf(comm,"ratio ||fd-hc||/||hc|| = %g, difference ||fd-hc|| = %g\n", (double)(fdnorm/hcnorm), (double)fdnorm);CHKERRQ(ierr); } ierr = VecDestroy(&g1);CHKERRQ(ierr); ierr = VecDestroy(&g2);CHKERRQ(ierr); } if (fd->check_hessian) { if (A != tao->hessian_pre) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Cannot test with alternative preconditioner"); ierr = PetscPrintf(comm,"Testing hand-coded Hessian (hc) against finite difference Hessian (fd). If the ratio is\n");CHKERRQ(ierr); ierr = PetscPrintf(comm,"O (1.e-8), the hand-coded Hessian is probably correct.\n");CHKERRQ(ierr); if (!fd->complete_print) { ierr = PetscPrintf(comm,"Run with -tao_test_display to show difference\n");CHKERRQ(ierr); ierr = PetscPrintf(comm,"of hand-coded and finite difference Hessian.\n");CHKERRQ(ierr); } for (i=0;i<3;i++) { /* compute both versions of Hessian */ ierr = TaoComputeHessian(tao,x,A,A);CHKERRQ(ierr); if (!i) {ierr = MatConvert(A,MATSAME,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);} ierr = TaoDefaultComputeHessian(tao,x,B,B,tao->user_hessP);CHKERRQ(ierr); if (fd->complete_print) { MPI_Comm bcomm; PetscViewer viewer; ierr = PetscPrintf(comm,"Finite difference Hessian\n");CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)B,&bcomm);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(bcomm,&viewer);CHKERRQ(ierr); ierr = MatView(B,viewer);CHKERRQ(ierr); } /* compare */ ierr = MatAYPX(B,-1.0,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatNorm(B,NORM_FROBENIUS,&nrm);CHKERRQ(ierr); ierr = MatNorm(A,NORM_FROBENIUS,&gnorm);CHKERRQ(ierr); if (fd->complete_print) { MPI_Comm hcomm; PetscViewer viewer; ierr = PetscPrintf(comm,"Hand-coded Hessian\n");CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)B,&hcomm);CHKERRQ(ierr); ierr = PetscViewerASCIIGetStdout(hcomm,&viewer);CHKERRQ(ierr); ierr = MatView(A,viewer);CHKERRQ(ierr); ierr = PetscPrintf(comm,"Hand-coded minus finite difference Hessian\n");CHKERRQ(ierr); ierr = MatView(B,viewer);CHKERRQ(ierr); } if (!gnorm) gnorm = 1.0e-20; ierr = PetscPrintf(comm,"ratio ||fd-hc||/||hc|| = %g, difference ||fd-hc|| = %g\n",(double)(nrm/gnorm),(double)nrm);CHKERRQ(ierr); } ierr = MatDestroy(&B);CHKERRQ(ierr); } tao->reason = TAO_CONVERGED_USER; PetscFunctionReturn(0); }
PetscErrorCode VecLoad_Binary(Vec vec, PetscViewer viewer) { PetscMPIInt size,rank,tag; int fd; PetscInt i,rows = 0,n,*range,N,bs; PetscErrorCode ierr; PetscBool flag; PetscScalar *avec,*avecwork; MPI_Comm comm; MPI_Request request; MPI_Status status; #if defined(PETSC_HAVE_MPIIO) PetscBool useMPIIO; #endif PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr); ierr = PetscViewerBinaryReadVecHeader_Private(viewer,&rows);CHKERRQ(ierr); /* Set Vec sizes,blocksize,and type if not already set. Block size first so that local sizes will be compatible. */ ierr = PetscOptionsGetInt(((PetscObject)vec)->prefix, "-vecload_block_size", &bs, &flag);CHKERRQ(ierr); if (flag) { ierr = VecSetBlockSize(vec, bs);CHKERRQ(ierr); } if (vec->map->n < 0 && vec->map->N < 0) { ierr = VecSetSizes(vec,PETSC_DECIDE,rows);CHKERRQ(ierr); } /* If sizes and type already set,check if the vector global size is correct */ ierr = VecGetSize(vec, &N);CHKERRQ(ierr); if (N != rows) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Vector in file different length (%d) then input vector (%d)", rows, N); #if defined(PETSC_HAVE_MPIIO) ierr = PetscViewerBinaryGetMPIIO(viewer,&useMPIIO);CHKERRQ(ierr); if (useMPIIO) { ierr = VecLoad_Binary_MPIIO(vec, viewer);CHKERRQ(ierr); PetscFunctionReturn(0); } #endif ierr = VecGetLocalSize(vec,&n);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)viewer,&tag);CHKERRQ(ierr); ierr = VecGetArray(vec,&avec);CHKERRQ(ierr); if (!rank) { ierr = PetscBinaryRead(fd,avec,n,PETSC_SCALAR);CHKERRQ(ierr); if (size > 1) { /* read in other chuncks and send to other processors */ /* determine maximum chunck owned by other */ range = vec->map->range; n = 1; for (i=1; i<size; i++) n = PetscMax(n,range[i+1] - range[i]); ierr = PetscMalloc(n*sizeof(PetscScalar),&avecwork);CHKERRQ(ierr); for (i=1; i<size; i++) { n = range[i+1] - range[i]; ierr = PetscBinaryRead(fd,avecwork,n,PETSC_SCALAR);CHKERRQ(ierr); ierr = MPI_Isend(avecwork,n,MPIU_SCALAR,i,tag,comm,&request);CHKERRQ(ierr); ierr = MPI_Wait(&request,&status);CHKERRQ(ierr); } ierr = PetscFree(avecwork);CHKERRQ(ierr); } } else { ierr = MPI_Recv(avec,n,MPIU_SCALAR,0,tag,comm,&status);CHKERRQ(ierr); } ierr = VecRestoreArray(vec,&avec);CHKERRQ(ierr); ierr = VecAssemblyBegin(vec);CHKERRQ(ierr); ierr = VecAssemblyEnd(vec);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **args) { Vec x, b, u; /* approx solution, RHS, exact solution */ Mat A; /* linear system matrix */ KSP ksp; /* linear solver context */ PC pc; /* preconditioner context */ PetscReal norm; /* norm of solution error */ PetscErrorCode ierr; PetscInt i,n = 10,col[3],its,rstart,rend,nlocal; PetscScalar neg_one = -1.0,one = 1.0,value[3]; PetscBool TEST_PROCEDURAL=PETSC_FALSE; PetscInitialize(&argc,&args,(char*)0,help); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-procedural",&TEST_PROCEDURAL,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Compute the matrix and right-hand-side vector that define the linear system, Ax = b. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Create vectors. Note that we form 1 vector from scratch and then duplicate as needed. For this simple case let PETSc decide how many elements of the vector are stored on each processor. The second argument to VecSetSizes() below causes PETSc to decide. */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&b);CHKERRQ(ierr); ierr = VecDuplicate(x,&u);CHKERRQ(ierr); /* Identify the starting and ending mesh points on each processor for the interior part of the mesh. We let PETSc decide above. */ ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr); ierr = VecGetLocalSize(x,&nlocal);CHKERRQ(ierr); /* Create a tridiagonal matrix. See ../tutorials/ex23.c */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,nlocal,nlocal,n,n);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); /* Assemble matrix */ if (!rstart) { rstart = 1; i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } if (rend == n) { rend = n-1; i = n-1; col[0] = n-2; col[1] = n-1; value[0] = -1.0; value[1] = 2.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } /* Set entries corresponding to the mesh interior */ value[0] = -1.0; value[1] = 2.0; value[2] = -1.0; for (i=rstart; i<rend; i++) { col[0] = i-1; col[1] = i; col[2] = i+1; ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Set exact solution; then compute right-hand-side vector. */ ierr = VecSet(u,one);CHKERRQ(ierr); ierr = MatMult(A,u,b);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create the linear solver and set various options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr); /* Set linear solver defaults for this problem (optional). - By extracting the KSP and PC contexts from the KSP context, we can then directly call any KSP and PC routines to set various options. - The following statements are optional; all of these parameters could alternatively be specified at runtime via KSPSetFromOptions(); */ if (TEST_PROCEDURAL) { /* Example of runtime options: '-pc_redundant_number 3 -redundant_ksp_type gmres -redundant_pc_type bjacobi' */ PetscMPIInt size,rank,subsize; Mat A_redundant; KSP innerksp; PC innerpc; MPI_Comm subcomm; ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCREDUNDANT);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); if (size < 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ, "Num of processes %d must greater than 2",size); ierr = PCRedundantSetNumber(pc,size-2);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); /* Get subcommunicator and redundant matrix */ ierr = KSPSetUp(ksp);CHKERRQ(ierr); ierr = PCRedundantGetKSP(pc,&innerksp);CHKERRQ(ierr); ierr = KSPGetPC(innerksp,&innerpc);CHKERRQ(ierr); ierr = PCGetOperators(innerpc,NULL,&A_redundant);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)A_redundant,&subcomm);CHKERRQ(ierr); ierr = MPI_Comm_size(subcomm,&subsize);CHKERRQ(ierr); if (subsize==1 && !rank) { printf("A_redundant:\n"); ierr = MatView(A_redundant,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } } else { ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); } /* Solve linear system */ ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr); /* Check the error */ ierr = VecAXPY(x,neg_one,u);CHKERRQ(ierr); ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr); ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr); if (norm > 1.e-14) { ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g, Iterations %D\n",(double)norm,its);CHKERRQ(ierr); } /* Free work space. */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
PetscErrorCode PCGAMGFilterGraph(Mat *a_Gmat,const PetscReal vfilter,const PetscBool symm,const PetscInt verbose) { PetscErrorCode ierr; PetscInt Istart,Iend,Ii,jj,ncols,nnz0,nnz1, NN, MM, nloc; PetscMPIInt rank, size; Mat Gmat = *a_Gmat, tGmat, matTrans; MPI_Comm comm; const PetscScalar *vals; const PetscInt *idx; PetscInt *d_nnz, *o_nnz; Vec diag; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)Gmat,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Gmat, &Istart, &Iend);CHKERRQ(ierr); nloc = Iend - Istart; ierr = MatGetSize(Gmat, &MM, &NN);CHKERRQ(ierr); #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr); #endif /* scale Gmat so filter works */ ierr = MatGetVecs(Gmat, &diag, 0);CHKERRQ(ierr); ierr = MatGetDiagonal(Gmat, diag);CHKERRQ(ierr); ierr = VecReciprocal(diag);CHKERRQ(ierr); ierr = VecSqrtAbs(diag);CHKERRQ(ierr); ierr = MatDiagonalScale(Gmat, diag, diag);CHKERRQ(ierr); ierr = VecDestroy(&diag);CHKERRQ(ierr); if (symm) { ierr = MatTranspose(Gmat, MAT_INITIAL_MATRIX, &matTrans);CHKERRQ(ierr); } /* filter - dup zeros out matrix */ ierr = PetscMalloc1(nloc, &d_nnz);CHKERRQ(ierr); ierr = PetscMalloc1(nloc, &o_nnz);CHKERRQ(ierr); for (Ii = Istart, jj = 0; Ii < Iend; Ii++, jj++) { ierr = MatGetRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr); d_nnz[jj] = ncols; o_nnz[jj] = ncols; ierr = MatRestoreRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr); if (symm) { ierr = MatGetRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr); d_nnz[jj] += ncols; o_nnz[jj] += ncols; ierr = MatRestoreRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr); } if (d_nnz[jj] > nloc) d_nnz[jj] = nloc; if (o_nnz[jj] > (MM-nloc)) o_nnz[jj] = MM - nloc; } ierr = MatCreateAIJ(comm, nloc, nloc, MM, MM, 0, d_nnz, 0, o_nnz, &tGmat);CHKERRQ(ierr); ierr = PetscFree(d_nnz);CHKERRQ(ierr); ierr = PetscFree(o_nnz);CHKERRQ(ierr); if (symm) { ierr = MatDestroy(&matTrans);CHKERRQ(ierr); } for (Ii = Istart, nnz0 = nnz1 = 0; Ii < Iend; Ii++) { ierr = MatGetRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr); for (jj=0; jj<ncols; jj++,nnz0++) { PetscScalar sv = PetscAbs(PetscRealPart(vals[jj])); if (PetscRealPart(sv) > vfilter) { nnz1++; if (symm) { sv *= 0.5; ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValues(tGmat,1,&idx[jj],1,&Ii,&sv,ADD_VALUES);CHKERRQ(ierr); } else { ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr); } } } ierr = MatRestoreRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr); } ierr = MatAssemblyBegin(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr); #endif if (verbose) { if (verbose == 1) { ierr = PetscPrintf(comm,"\t[%d]%s %g%% nnz after filtering, with threshold %g, %g nnz ave. (N=%d)\n",rank,__FUNCT__, 100.*(double)nnz1/(double)nnz0,vfilter,(double)nnz0/(double)nloc,MM);CHKERRQ(ierr); } else { PetscInt nnz[2],out[2]; nnz[0] = nnz0; nnz[1] = nnz1; ierr = MPI_Allreduce(nnz, out, 2, MPIU_INT, MPI_SUM, comm);CHKERRQ(ierr); ierr = PetscPrintf(comm,"\t[%d]%s %g%% nnz after filtering, with threshold %g, %g nnz ave. (N=%d)\n",rank,__FUNCT__, 100.*(double)out[1]/(double)out[0],vfilter,(double)out[0]/(double)MM,MM);CHKERRQ(ierr); } } ierr = MatDestroy(&Gmat);CHKERRQ(ierr); *a_Gmat = tGmat; PetscFunctionReturn(0); }
PetscErrorCode SNESView_NASM(SNES snes, PetscViewer viewer) { SNES_NASM *nasm = (SNES_NASM*)snes->data; PetscErrorCode ierr; PetscMPIInt rank,size; PetscInt i,j,N,bsz; PetscBool iascii,isstring; PetscViewer sviewer; MPI_Comm comm; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERSTRING,&isstring);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Allreduce(&nasm->n,&N,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr); if (iascii) { ierr = PetscViewerASCIIPrintf(viewer, " Nonlinear Additive Schwarz: total subdomain blocks = %D\n",N);CHKERRQ(ierr); if (nasm->same_local_solves) { if (nasm->subsnes) { ierr = PetscViewerASCIIPrintf(viewer," Local solve is the same for all blocks:\n");CHKERRQ(ierr); ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); ierr = PetscViewerGetSingleton(viewer,&sviewer);CHKERRQ(ierr); if (!rank) { ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); ierr = SNESView(nasm->subsnes[0],sviewer);CHKERRQ(ierr); ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); } ierr = PetscViewerRestoreSingleton(viewer,&sviewer);CHKERRQ(ierr); ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); } } else { /* print the solver on each block */ ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); ierr = PetscViewerASCIISynchronizedPrintf(viewer," [%d] number of local blocks = %D\n",(int)rank,nasm->n);CHKERRQ(ierr); ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(viewer," Local solve info for each block is in the following SNES objects:\n");CHKERRQ(ierr); ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(viewer,"- - - - - - - - - - - - - - - - - -\n");CHKERRQ(ierr); for (j=0; j<size; j++) { ierr = PetscViewerGetSingleton(viewer,&sviewer);CHKERRQ(ierr); if (rank == j) { for (i=0; i<nasm->n; i++) { ierr = VecGetLocalSize(nasm->x[i],&bsz);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(sviewer,"[%d] local block number %D, size = %D\n",(int)rank,i,bsz);CHKERRQ(ierr); ierr = SNESView(nasm->subsnes[i],sviewer);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(sviewer,"- - - - - - - - - - - - - - - - - -\n");CHKERRQ(ierr); } } ierr = PetscViewerRestoreSingleton(viewer,&sviewer);CHKERRQ(ierr); ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); } ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); } } else if (isstring) { ierr = PetscViewerStringSPrintf(viewer," blocks=%D,type=%s",N,SNESNASMTypes[nasm->type]);CHKERRQ(ierr); ierr = PetscViewerGetSingleton(viewer,&sviewer);CHKERRQ(ierr); if (nasm->subsnes && !rank) {ierr = SNESView(nasm->subsnes[0],sviewer);CHKERRQ(ierr);} ierr = PetscViewerRestoreSingleton(viewer,&sviewer);CHKERRQ(ierr); } PetscFunctionReturn(0); }
/*@C PetscDrawTensorContour - PetscDraws a contour plot for a two-dimensional array that is stored as a PETSc vector. Collective on PetscDraw, but PetscDraw must be sequential Input Parameters: + win - the window to draw in . m,n - the global number of mesh points in the x and y directions . xi,yi - the locations of the global mesh points (optional, use PETSC_NULL to indicate uniform spacing on [0,1]) - V - the values Options Database Keys: + -draw_x_shared_colormap - Indicates use of private colormap - -draw_contour_grid - PetscDraws grid contour Level: intermediate Concepts: contour plot Concepts: drawing^contour plot .seealso: PetscDrawTensorContourPatch() @*/ PetscErrorCode PetscDrawTensorContour(PetscDraw win,int m,int n,const PetscReal xi[],const PetscReal yi[],PetscReal *v) { PetscErrorCode ierr; int N = m*n; PetscBool isnull; PetscDraw popup; MPI_Comm comm; int xin=1,yin=1,i; PetscMPIInt size; PetscReal h; ZoomCtx ctx; PetscFunctionBegin; ierr = PetscDrawIsNull(win,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0); ierr = PetscObjectGetComm((PetscObject)win,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"May only be used with single processor PetscDraw"); if (N <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"n %d and m %d must be positive",m,n); /* create scale window */ ierr = PetscDrawGetPopup(win,&popup);CHKERRQ(ierr); ierr = PetscDrawCheckResizedWindow(win);CHKERRQ(ierr); ctx.v = v; ctx.m = m; ctx.n = n; ctx.max = ctx.min = v[0]; for (i=0; i<N; i++) { if (ctx.max < ctx.v[i]) ctx.max = ctx.v[i]; if (ctx.min > ctx.v[i]) ctx.min = ctx.v[i]; } if (ctx.max - ctx.min < 1.e-7) {ctx.min -= 5.e-8; ctx.max += 5.e-8;} /* PetscDraw the scale window */ if (popup) {ierr = PetscDrawScalePopup(popup,ctx.min,ctx.max);CHKERRQ(ierr);} ctx.showgrid = PETSC_FALSE; ierr = PetscOptionsGetBool(PETSC_NULL,"-draw_contour_grid",&ctx.showgrid,PETSC_NULL);CHKERRQ(ierr); /* fill up x and y coordinates */ if (!xi) { xin = 0; ierr = PetscMalloc(ctx.m*sizeof(PetscReal),&ctx.x);CHKERRQ(ierr); h = 1.0/(ctx.m-1); ctx.x[0] = 0.0; for (i=1; i<ctx.m; i++) ctx.x[i] = ctx.x[i-1] + h; } else { ctx.x = (PetscReal*)xi; } if (!yi) { yin = 0; ierr = PetscMalloc(ctx.n*sizeof(PetscReal),&ctx.y);CHKERRQ(ierr); h = 1.0/(ctx.n-1); ctx.y[0] = 0.0; for (i=1; i<ctx.n; i++) ctx.y[i] = ctx.y[i-1] + h; } else { ctx.y = (PetscReal *)yi; } ierr = PetscDrawZoom(win,(PetscErrorCode (*)(PetscDraw,void *))PetscDrawTensorContour_Zoom,&ctx);CHKERRQ(ierr); if (!xin) {ierr = PetscFree(ctx.x);CHKERRQ(ierr);} if (!yin) {ierr = PetscFree(ctx.y);CHKERRQ(ierr);} PetscFunctionReturn(0); }
/*@C SNESComputeJacobianDefault - Computes the Jacobian using finite differences. Collective on SNES Input Parameters: + x1 - compute Jacobian at this point - ctx - application's function context, as set with SNESSetFunction() Output Parameters: + J - Jacobian matrix (not altered in this routine) - B - newly computed Jacobian matrix to use with preconditioner (generally the same as J) Options Database Key: + -snes_fd - Activates SNESComputeJacobianDefault() . -snes_test_err - Square root of function error tolerance, default square root of machine epsilon (1.e-8 in double, 3.e-4 in single) - -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS) Notes: This routine is slow and expensive, and is not currently optimized to take advantage of sparsity in the problem. Although SNESComputeJacobianDefault() is not recommended for general use in large-scale applications, It can be useful in checking the correctness of a user-provided Jacobian. An alternative routine that uses coloring to exploit matrix sparsity is SNESComputeJacobianDefaultColor(). Level: intermediate .keywords: SNES, finite differences, Jacobian .seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF() @*/ PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx) { Vec j1a,j2a,x2; PetscErrorCode ierr; PetscInt i,N,start,end,j,value,root; PetscScalar dx,*y,*xx,wscale; PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON; PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm; MPI_Comm comm; PetscErrorCode (*eval_fct)(SNES,Vec,Vec)=0; PetscBool assembled,use_wp = PETSC_TRUE,flg; const char *list[2] = {"ds","wp"}; PetscMPIInt size; const PetscInt *ranges; PetscFunctionBegin; ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr); eval_fct = SNESComputeFunction; ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MatAssembled(B,&assembled);CHKERRQ(ierr); if (assembled) { ierr = MatZeroEntries(B);CHKERRQ(ierr); } if (!snes->nvwork) { snes->nvwork = 3; ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr); ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr); } j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2]; ierr = VecGetSize(x1,&N);CHKERRQ(ierr); ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr); ierr = (*eval_fct)(snes,x1,j1a);CHKERRQ(ierr); ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr); if (flg && !value) use_wp = PETSC_FALSE; if (use_wp) { ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr); } /* Compute Jacobian approximation, 1 column at a time. x1 = current iterate, j1a = F(x1) x2 = perturbed iterate, j2a = F(x2) */ for (i=0; i<N; i++) { ierr = VecCopy(x1,x2);CHKERRQ(ierr); if (i>= start && i<end) { ierr = VecGetArray(x1,&xx);CHKERRQ(ierr); if (use_wp) dx = 1.0 + unorm; else dx = xx[i-start]; ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr); if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par; dx *= epsilon; wscale = 1.0/dx; ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr); } else { wscale = 0.0; } ierr = VecAssemblyBegin(x2);CHKERRQ(ierr); ierr = VecAssemblyEnd(x2);CHKERRQ(ierr); ierr = (*eval_fct)(snes,x2,j2a);CHKERRQ(ierr); ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr); /* Communicate scale=1/dx_i to all processors */ ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr); root = size; for (j=size-1; j>-1; j--) { root--; if (i>=ranges[j]) break; } ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr); ierr = VecScale(j2a,wscale);CHKERRQ(ierr); ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14; ierr = VecGetArray(j2a,&y);CHKERRQ(ierr); for (j=start; j<end; j++) { if (PetscAbsScalar(y[j-start]) > amax || j == i) { ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr); } } ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr); } ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); if (B != J) { ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } PetscFunctionReturn(0); }
/* The element stiffness matrix for the identity in linear elements is 1 /2 1 1\ - |1 2 1| 12 \1 1 2/ no matter what the shape of the triangle. */ PetscErrorCode TaylorGalerkinStepIIMomentum(DM da, UserContext *user) { MPI_Comm comm; KSP ksp; Mat mat; Vec rhs_u, rhs_v; PetscScalar identity[9] = {0.16666666667, 0.08333333333, 0.08333333333, 0.08333333333, 0.16666666667, 0.08333333333, 0.08333333333, 0.08333333333, 0.16666666667}; PetscScalar *u_n, *v_n, *mu_n; PetscScalar *u_phi, *v_phi; PetscScalar *rho_u_phi, *rho_v_phi; PetscInt idx[3]; PetscScalar values_u[3]; PetscScalar values_v[3]; PetscScalar psi_x[3], psi_y[3]; PetscScalar mu, tau_xx, tau_xy, tau_yy; PetscReal hx, hy, area; const PetscInt *necon; PetscInt j, k, e, ne, nc, mx, my; PetscErrorCode ierr; PetscFunctionBeginUser; ierr = PetscObjectGetComm((PetscObject) da, &comm);CHKERRQ(ierr); ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(da, &mat);CHKERRQ(ierr); ierr = MatSetOption(mat,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); ierr = DMGetGlobalVector(da, &rhs_u);CHKERRQ(ierr); ierr = DMGetGlobalVector(da, &rhs_v);CHKERRQ(ierr); ierr = KSPCreate(comm, &ksp);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = DMDAGetInfo(da, 0, &mx, &my, 0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr); hx = 1.0 / (PetscReal)(mx-1); hy = 1.0 / (PetscReal)(my-1); area = 0.5*hx*hy; ierr = VecGetArray(user->sol_n.u, &u_n);CHKERRQ(ierr); ierr = VecGetArray(user->sol_n.v, &v_n);CHKERRQ(ierr); ierr = VecGetArray(user->mu, &mu_n);CHKERRQ(ierr); ierr = VecGetArray(user->sol_phi.u, &u_phi);CHKERRQ(ierr); ierr = VecGetArray(user->sol_phi.v, &v_phi);CHKERRQ(ierr); ierr = VecGetArray(user->sol_phi.rho_u, &rho_u_phi);CHKERRQ(ierr); ierr = VecGetArray(user->sol_phi.rho_v, &rho_v_phi);CHKERRQ(ierr); ierr = DMDAGetElements(da, &ne, &nc, &necon);CHKERRQ(ierr); for (e = 0; e < ne; e++) { for (j = 0; j < 3; j++) { idx[j] = necon[3*e+j]; values_u[j] = 0.0; values_v[j] = 0.0; } /* Get basis function deriatives (we need the orientation of the element here) */ if (idx[1] > idx[0]) { psi_x[0] = -hy; psi_x[1] = hy; psi_x[2] = 0.0; psi_y[0] = -hx; psi_y[1] = 0.0; psi_y[2] = hx; } else { psi_x[0] = hy; psi_x[1] = -hy; psi_x[2] = 0.0; psi_y[0] = hx; psi_y[1] = 0.0; psi_y[2] = -hx; } /* <\nabla\psi, F^{n+\phi}_e>: Divergence of the element-averaged convective fluxes */ for (j = 0; j < 3; j++) { values_u[j] += psi_x[j]*rho_u_phi[e]*u_phi[e] + psi_y[j]*rho_u_phi[e]*v_phi[e]; values_v[j] += psi_x[j]*rho_v_phi[e]*u_phi[e] + psi_y[j]*rho_v_phi[e]*v_phi[e]; } /* -<\nabla\psi, F^n_v>: Divergence of the viscous fluxes */ for (j = 0; j < 3; j++) { /* \tau_{xx} = 2/3 \mu(T) (2 {\partial u\over\partial x} - {\partial v\over\partial y}) */ /* \tau_{xy} = \mu(T) ( {\partial u\over\partial y} + {\partial v\over\partial x}) */ /* \tau_{yy} = 2/3 \mu(T) (2 {\partial v\over\partial y} - {\partial u\over\partial x}) */ mu = 0.0; tau_xx = 0.0; tau_xy = 0.0; tau_yy = 0.0; for (k = 0; k < 3; k++) { mu += mu_n[idx[k]]; tau_xx += 2.0*psi_x[k]*u_n[idx[k]] - psi_y[k]*v_n[idx[k]]; tau_xy += psi_y[k]*u_n[idx[k]] + psi_x[k]*v_n[idx[k]]; tau_yy += 2.0*psi_y[k]*v_n[idx[k]] - psi_x[k]*u_n[idx[k]]; } mu /= 3.0; tau_xx *= (2.0/3.0)*mu; tau_xy *= mu; tau_yy *= (2.0/3.0)*mu; values_u[j] -= area*(psi_x[j]*tau_xx + psi_y[j]*tau_xy); values_v[j] -= area*(psi_x[j]*tau_xy + psi_y[j]*tau_yy); } /* Accumulate to global structures */ ierr = VecSetValuesLocal(rhs_u, 3, idx, values_u, ADD_VALUES);CHKERRQ(ierr); ierr = VecSetValuesLocal(rhs_v, 3, idx, values_v, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesLocal(mat, 3, idx, 3, idx, identity, ADD_VALUES);CHKERRQ(ierr); } ierr = DMDARestoreElements(da, &ne, &nc, &necon);CHKERRQ(ierr); ierr = VecRestoreArray(user->sol_n.u, &u_n);CHKERRQ(ierr); ierr = VecRestoreArray(user->sol_n.v, &v_n);CHKERRQ(ierr); ierr = VecRestoreArray(user->mu, &mu_n);CHKERRQ(ierr); ierr = VecRestoreArray(user->sol_phi.u, &u_phi);CHKERRQ(ierr); ierr = VecRestoreArray(user->sol_phi.v, &v_phi);CHKERRQ(ierr); ierr = VecRestoreArray(user->sol_phi.rho_u, &rho_u_phi);CHKERRQ(ierr); ierr = VecRestoreArray(user->sol_phi.rho_v, &rho_v_phi);CHKERRQ(ierr); ierr = VecAssemblyBegin(rhs_u);CHKERRQ(ierr); ierr = VecAssemblyBegin(rhs_v);CHKERRQ(ierr); ierr = MatAssemblyBegin(mat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = VecAssemblyEnd(rhs_u);CHKERRQ(ierr); ierr = VecAssemblyEnd(rhs_v);CHKERRQ(ierr); ierr = MatAssemblyEnd(mat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = VecScale(rhs_u,user->dt);CHKERRQ(ierr); ierr = VecScale(rhs_v,user->dt);CHKERRQ(ierr); ierr = KSPSetOperators(ksp, mat, mat, DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = KSPSolve(ksp, rhs_u, user->sol_np1.rho_u);CHKERRQ(ierr); ierr = KSPSolve(ksp, rhs_v, user->sol_np1.rho_v);CHKERRQ(ierr); ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = MatDestroy(&mat);CHKERRQ(ierr); ierr = DMRestoreGlobalVector(da, &rhs_u);CHKERRQ(ierr); ierr = DMRestoreGlobalVector(da, &rhs_v);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@ ISDifference - Computes the difference between two index sets. Collective on IS Input Parameter: + is1 - first index, to have items removed from it - is2 - index values to be removed Output Parameters: . isout - is1 - is2 Notes: Negative values are removed from the lists. is2 may have values that are not in is1. This requires O(imax-imin) memory and O(imax-imin) work, where imin and imax are the bounds on the indices in is1. Level: intermediate Concepts: index sets^difference Concepts: IS^difference .seealso: ISDestroy(), ISView(), ISSum(), ISExpand() @*/ PetscErrorCode ISDifference(IS is1,IS is2,IS *isout) { PetscErrorCode ierr; PetscInt i,n1,n2,imin,imax,nout,*iout; const PetscInt *i1,*i2; PetscBT mask; MPI_Comm comm; PetscFunctionBegin; PetscValidHeaderSpecific(is1,IS_CLASSID,1); PetscValidHeaderSpecific(is2,IS_CLASSID,2); PetscValidPointer(isout,3); ierr = ISGetIndices(is1,&i1);CHKERRQ(ierr); ierr = ISGetLocalSize(is1,&n1);CHKERRQ(ierr); /* Create a bit mask array to contain required values */ if (n1) { imin = PETSC_MAX_INT; imax = 0; for (i=0; i<n1; i++) { if (i1[i] < 0) continue; imin = PetscMin(imin,i1[i]); imax = PetscMax(imax,i1[i]); } } else imin = imax = 0; ierr = PetscBTCreate(imax-imin,&mask);CHKERRQ(ierr); /* Put the values from is1 */ for (i=0; i<n1; i++) { if (i1[i] < 0) continue; ierr = PetscBTSet(mask,i1[i] - imin);CHKERRQ(ierr); } ierr = ISRestoreIndices(is1,&i1);CHKERRQ(ierr); /* Remove the values from is2 */ ierr = ISGetIndices(is2,&i2);CHKERRQ(ierr); ierr = ISGetLocalSize(is2,&n2);CHKERRQ(ierr); for (i=0; i<n2; i++) { if (i2[i] < imin || i2[i] > imax) continue; ierr = PetscBTClear(mask,i2[i] - imin);CHKERRQ(ierr); } ierr = ISRestoreIndices(is2,&i2);CHKERRQ(ierr); /* Count the number in the difference */ nout = 0; for (i=0; i<imax-imin+1; i++) { if (PetscBTLookup(mask,i)) nout++; } /* create the new IS containing the difference */ ierr = PetscMalloc1(nout,&iout);CHKERRQ(ierr); nout = 0; for (i=0; i<imax-imin+1; i++) { if (PetscBTLookup(mask,i)) iout[nout++] = i + imin; } ierr = PetscObjectGetComm((PetscObject)is1,&comm);CHKERRQ(ierr); ierr = ISCreateGeneral(comm,nout,iout,PETSC_OWN_POINTER,isout);CHKERRQ(ierr); ierr = PetscBTDestroy(&mask);CHKERRQ(ierr); PetscFunctionReturn(0); }