1 #include <../src/mat/impls/aij/seq/aij.h> 2 #include <../src/ksp/pc/impls/bddc/bddc.h> 3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h> 4 #include <../src/mat/impls/dense/seq/dense.h> 5 #include <petscdmplex.h> 6 #include <petscblaslapack.h> 7 #include <petsc/private/sfimpl.h> 8 #include <petsc/private/dmpleximpl.h> 9 #include <petscdmda.h> 10 11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*); 12 13 /* if range is true, it returns B s.t. span{B} = range(A) 14 if range is false, it returns B s.t. range(B) _|_ range(A) */ 15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B) 16 { 17 #if !defined(PETSC_USE_COMPLEX) 18 PetscScalar *uwork,*data,*U, ds = 0.; 19 PetscReal *sing; 20 PetscBLASInt bM,bN,lwork,lierr,di = 1; 21 PetscInt ulw,i,nr,nc,n; 22 PetscErrorCode ierr; 23 24 PetscFunctionBegin; 25 #if defined(PETSC_MISSING_LAPACK_GESVD) 26 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available"); 27 #else 28 ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr); 29 if (!nr || !nc) PetscFunctionReturn(0); 30 31 /* workspace */ 32 if (!work) { 33 ulw = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc)); 34 ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr); 35 } else { 36 ulw = lw; 37 uwork = work; 38 } 39 n = PetscMin(nr,nc); 40 if (!rwork) { 41 ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr); 42 } else { 43 sing = rwork; 44 } 45 46 /* SVD */ 47 ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr); 48 ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr); 49 ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr); 50 ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr); 51 ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr); 52 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 53 PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr)); 54 ierr = PetscFPTrapPop();CHKERRQ(ierr); 55 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr); 56 ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr); 57 for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break; 58 if (!rwork) { 59 ierr = PetscFree(sing);CHKERRQ(ierr); 60 } 61 if (!work) { 62 ierr = PetscFree(uwork);CHKERRQ(ierr); 63 } 64 /* create B */ 65 if (!range) { 66 ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr); 67 ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr); 68 ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr); 69 } else { 70 ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr); 71 ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr); 72 ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr); 73 } 74 ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr); 75 ierr = PetscFree(U);CHKERRQ(ierr); 76 #endif 77 #else /* PETSC_USE_COMPLEX */ 78 PetscFunctionBegin; 79 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes"); 80 #endif 81 PetscFunctionReturn(0); 82 } 83 84 /* TODO REMOVE */ 85 #if defined(PRINT_GDET) 86 static int inc = 0; 87 static int lev = 0; 88 #endif 89 90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork) 91 { 92 PetscErrorCode ierr; 93 Mat GE,GEd; 94 PetscInt rsize,csize,esize; 95 PetscScalar *ptr; 96 97 PetscFunctionBegin; 98 ierr = ISGetSize(edge,&esize);CHKERRQ(ierr); 99 if (!esize) PetscFunctionReturn(0); 100 ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr); 101 ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr); 102 103 /* gradients */ 104 ptr = work + 5*esize; 105 ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr); 106 ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr); 107 ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr); 108 ierr = MatDestroy(&GE);CHKERRQ(ierr); 109 110 /* constants */ 111 ptr += rsize*csize; 112 ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr); 113 ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr); 114 ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr); 115 ierr = MatDestroy(&GE);CHKERRQ(ierr); 116 ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr); 117 ierr = MatDestroy(&GEd);CHKERRQ(ierr); 118 119 if (corners) { 120 Mat GEc; 121 PetscScalar *vals,v; 122 123 ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr); 124 ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr); 125 ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr); 126 /* v = PetscAbsScalar(vals[0]) */; 127 v = 1.; 128 cvals[0] = vals[0]/v; 129 cvals[1] = vals[1]/v; 130 ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr); 131 ierr = MatScale(*GKins,1./v);CHKERRQ(ierr); 132 #if defined(PRINT_GDET) 133 { 134 PetscViewer viewer; 135 char filename[256]; 136 sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++); 137 ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr); 138 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 139 ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr); 140 ierr = MatView(GEc,viewer);CHKERRQ(ierr); 141 ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr); 142 ierr = MatView(*GKins,viewer);CHKERRQ(ierr); 143 ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr); 144 ierr = MatView(GEd,viewer);CHKERRQ(ierr); 145 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 146 } 147 #endif 148 ierr = MatDestroy(&GEd);CHKERRQ(ierr); 149 ierr = MatDestroy(&GEc);CHKERRQ(ierr); 150 } 151 152 PetscFunctionReturn(0); 153 } 154 155 PetscErrorCode PCBDDCNedelecSupport(PC pc) 156 { 157 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 158 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 159 Mat G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit; 160 Vec tvec; 161 PetscSF sfv; 162 ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g; 163 MPI_Comm comm; 164 IS lned,primals,allprimals,nedfieldlocal; 165 IS *eedges,*extrows,*extcols,*alleedges; 166 PetscBT btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter; 167 PetscScalar *vals,*work; 168 PetscReal *rwork; 169 const PetscInt *idxs,*ii,*jj,*iit,*jjt; 170 PetscInt ne,nv,Lv,order,n,field; 171 PetscInt n_neigh,*neigh,*n_shared,**shared; 172 PetscInt i,j,extmem,cum,maxsize,nee; 173 PetscInt *extrow,*extrowcum,*marks,*vmarks,*gidxs; 174 PetscInt *sfvleaves,*sfvroots; 175 PetscInt *corners,*cedges; 176 PetscInt *ecount,**eneighs,*vcount,**vneighs; 177 #if defined(PETSC_USE_DEBUG) 178 PetscInt *emarks; 179 #endif 180 PetscBool print,eerr,done,lrc[2],conforming,global,singular,setprimal; 181 PetscErrorCode ierr; 182 183 PetscFunctionBegin; 184 /* If the discrete gradient is defined for a subset of dofs and global is true, 185 it assumes G is given in global ordering for all the dofs. 186 Otherwise, the ordering is global for the Nedelec field */ 187 order = pcbddc->nedorder; 188 conforming = pcbddc->conforming; 189 field = pcbddc->nedfield; 190 global = pcbddc->nedglobal; 191 setprimal = PETSC_FALSE; 192 print = PETSC_FALSE; 193 singular = PETSC_FALSE; 194 195 /* Command line customization */ 196 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr); 197 ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr); 198 ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr); 199 ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr); 200 /* print debug info TODO: to be removed */ 201 ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr); 202 ierr = PetscOptionsEnd();CHKERRQ(ierr); 203 204 /* Return if there are no edges in the decomposition and the problem is not singular */ 205 ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr); 206 ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr); 207 ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr); 208 if (!singular) { 209 ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 210 lrc[0] = PETSC_FALSE; 211 for (i=0;i<n;i++) { 212 if (PetscRealPart(vals[i]) > 2.) { 213 lrc[0] = PETSC_TRUE; 214 break; 215 } 216 } 217 ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 218 ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr); 219 if (!lrc[1]) PetscFunctionReturn(0); 220 } 221 222 /* Get Nedelec field */ 223 if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %D: number of fields is %D",field,pcbddc->n_ISForDofsLocal); 224 if (pcbddc->n_ISForDofsLocal && field >= 0) { 225 ierr = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr); 226 nedfieldlocal = pcbddc->ISForDofsLocal[field]; 227 ierr = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr); 228 } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) { 229 ne = n; 230 nedfieldlocal = NULL; 231 global = PETSC_TRUE; 232 } else if (field == PETSC_DECIDE) { 233 PetscInt rst,ren,*idx; 234 235 ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr); 236 ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr); 237 ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr); 238 for (i=rst;i<ren;i++) { 239 PetscInt nc; 240 241 ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr); 242 if (nc > 1) matis->sf_rootdata[i-rst] = 1; 243 ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr); 244 } 245 ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 246 ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 247 ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr); 248 for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i; 249 ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr); 250 } else { 251 SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified"); 252 } 253 254 /* Sanity checks */ 255 if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time"); 256 if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis"); 257 if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %D it's not a multiple of the order %D",ne,order); 258 259 /* Just set primal dofs and return */ 260 if (setprimal) { 261 IS enedfieldlocal; 262 PetscInt *eidxs; 263 264 ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr); 265 ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 266 if (nedfieldlocal) { 267 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 268 for (i=0,cum=0;i<ne;i++) { 269 if (PetscRealPart(vals[idxs[i]]) > 2.) { 270 eidxs[cum++] = idxs[i]; 271 } 272 } 273 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 274 } else { 275 for (i=0,cum=0;i<ne;i++) { 276 if (PetscRealPart(vals[i]) > 2.) { 277 eidxs[cum++] = i; 278 } 279 } 280 } 281 ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 282 ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr); 283 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr); 284 ierr = PetscFree(eidxs);CHKERRQ(ierr); 285 ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr); 286 ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr); 287 PetscFunctionReturn(0); 288 } 289 290 /* Compute some l2g maps */ 291 if (nedfieldlocal) { 292 IS is; 293 294 /* need to map from the local Nedelec field to local numbering */ 295 ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr); 296 /* need to map from the local Nedelec field to global numbering for the whole dofs*/ 297 ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr); 298 ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr); 299 /* need to map from the local Nedelec field to global numbering (for Nedelec only) */ 300 if (global) { 301 ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr); 302 el2g = al2g; 303 } else { 304 IS gis; 305 306 ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr); 307 ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr); 308 ierr = ISDestroy(&gis);CHKERRQ(ierr); 309 } 310 ierr = ISDestroy(&is);CHKERRQ(ierr); 311 } else { 312 /* restore default */ 313 pcbddc->nedfield = -1; 314 /* one ref for the destruction of al2g, one for el2g */ 315 ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr); 316 ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr); 317 el2g = al2g; 318 fl2g = NULL; 319 } 320 321 /* Start communication to drop connections for interior edges (for cc analysis only) */ 322 ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr); 323 ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr); 324 if (nedfieldlocal) { 325 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 326 for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1; 327 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 328 } else { 329 for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1; 330 } 331 ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr); 332 ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr); 333 334 if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */ 335 ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr); 336 ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr); 337 if (global) { 338 PetscInt rst; 339 340 ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr); 341 for (i=0,cum=0;i<pc->pmat->rmap->n;i++) { 342 if (matis->sf_rootdata[i] < 2) { 343 matis->sf_rootdata[cum++] = i + rst; 344 } 345 } 346 ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr); 347 ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr); 348 } else { 349 PetscInt *tbz; 350 351 ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr); 352 ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 353 ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 354 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 355 for (i=0,cum=0;i<ne;i++) 356 if (matis->sf_leafdata[idxs[i]] == 1) 357 tbz[cum++] = i; 358 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 359 ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr); 360 ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr); 361 ierr = PetscFree(tbz);CHKERRQ(ierr); 362 } 363 } else { /* we need the entire G to infer the nullspace */ 364 ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr); 365 G = pcbddc->discretegradient; 366 } 367 368 /* Extract subdomain relevant rows of G */ 369 ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr); 370 ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr); 371 ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr); 372 ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr); 373 ierr = ISDestroy(&lned);CHKERRQ(ierr); 374 ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr); 375 ierr = MatDestroy(&lGall);CHKERRQ(ierr); 376 ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr); 377 378 /* SF for nodal dofs communications */ 379 ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr); 380 ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr); 381 ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr); 382 ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr); 383 ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr); 384 ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr); 385 ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr); 386 ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr); 387 i = singular ? 2 : 1; 388 ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr); 389 390 /* Destroy temporary G created in MATIS format and modified G */ 391 ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr); 392 ierr = MatDestroy(&lGis);CHKERRQ(ierr); 393 ierr = MatDestroy(&G);CHKERRQ(ierr); 394 395 if (print) { 396 ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr); 397 ierr = MatView(lG,NULL);CHKERRQ(ierr); 398 } 399 400 /* Save lG for values insertion in change of basis */ 401 ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr); 402 403 /* Analyze the edge-nodes connections (duplicate lG) */ 404 ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr); 405 ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr); 406 ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr); 407 ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr); 408 ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr); 409 ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr); 410 ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr); 411 /* need to import the boundary specification to ensure the 412 proper detection of coarse edges' endpoints */ 413 if (pcbddc->DirichletBoundariesLocal) { 414 IS is; 415 416 if (fl2g) { 417 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr); 418 } else { 419 is = pcbddc->DirichletBoundariesLocal; 420 } 421 ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr); 422 ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr); 423 for (i=0;i<cum;i++) { 424 if (idxs[i] >= 0) { 425 ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr); 426 ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr); 427 } 428 } 429 ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr); 430 if (fl2g) { 431 ierr = ISDestroy(&is);CHKERRQ(ierr); 432 } 433 } 434 if (pcbddc->NeumannBoundariesLocal) { 435 IS is; 436 437 if (fl2g) { 438 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr); 439 } else { 440 is = pcbddc->NeumannBoundariesLocal; 441 } 442 ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr); 443 ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr); 444 for (i=0;i<cum;i++) { 445 if (idxs[i] >= 0) { 446 ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr); 447 } 448 } 449 ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr); 450 if (fl2g) { 451 ierr = ISDestroy(&is);CHKERRQ(ierr); 452 } 453 } 454 455 /* Count neighs per dof */ 456 ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr); 457 ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr); 458 459 /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs 460 for proper detection of coarse edges' endpoints */ 461 ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr); 462 for (i=0;i<ne;i++) { 463 if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) { 464 ierr = PetscBTSet(btee,i);CHKERRQ(ierr); 465 } 466 } 467 ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr); 468 if (!conforming) { 469 ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 470 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 471 } 472 ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 473 ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr); 474 cum = 0; 475 for (i=0;i<ne;i++) { 476 /* eliminate rows corresponding to edge dofs belonging to coarse faces */ 477 if (!PetscBTLookup(btee,i)) { 478 marks[cum++] = i; 479 continue; 480 } 481 /* set badly connected edge dofs as primal */ 482 if (!conforming) { 483 if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */ 484 marks[cum++] = i; 485 ierr = PetscBTSet(bte,i);CHKERRQ(ierr); 486 for (j=ii[i];j<ii[i+1];j++) { 487 ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr); 488 } 489 } else { 490 /* every edge dofs should be connected trough a certain number of nodal dofs 491 to other edge dofs belonging to coarse edges 492 - at most 2 endpoints 493 - order-1 interior nodal dofs 494 - no undefined nodal dofs (nconn < order) 495 */ 496 PetscInt ends = 0,ints = 0, undef = 0; 497 for (j=ii[i];j<ii[i+1];j++) { 498 PetscInt v = jj[j],k; 499 PetscInt nconn = iit[v+1]-iit[v]; 500 for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--; 501 if (nconn > order) ends++; 502 else if (nconn == order) ints++; 503 else undef++; 504 } 505 if (undef || ends > 2 || ints != order -1) { 506 marks[cum++] = i; 507 ierr = PetscBTSet(bte,i);CHKERRQ(ierr); 508 for (j=ii[i];j<ii[i+1];j++) { 509 ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr); 510 } 511 } 512 } 513 } 514 /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */ 515 if (!order && ii[i+1] != ii[i]) { 516 PetscScalar val = 1./(ii[i+1]-ii[i]-1); 517 for (j=ii[i];j<ii[i+1];j++) vals[j] = val; 518 } 519 } 520 ierr = PetscBTDestroy(&btee);CHKERRQ(ierr); 521 ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr); 522 ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 523 if (!conforming) { 524 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 525 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 526 } 527 ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr); 528 529 /* identify splitpoints and corner candidates */ 530 ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 531 if (print) { 532 ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr); 533 ierr = MatView(lGe,NULL);CHKERRQ(ierr); 534 ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr); 535 ierr = MatView(lGt,NULL);CHKERRQ(ierr); 536 } 537 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 538 ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr); 539 for (i=0;i<nv;i++) { 540 PetscInt ord = order, test = ii[i+1]-ii[i], vc = vcount[i]; 541 PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE; 542 if (!order) { /* variable order */ 543 PetscReal vorder = 0.; 544 545 for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]); 546 test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON); 547 if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test); 548 ord = 1; 549 } 550 #if defined(PETSC_USE_DEBUG) 551 if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %D connected with nodal dof %D with order %D",test,i,ord); 552 #endif 553 for (j=ii[i];j<ii[i+1] && sneighs;j++) { 554 if (PetscBTLookup(btbd,jj[j])) { 555 bdir = PETSC_TRUE; 556 break; 557 } 558 if (vc != ecount[jj[j]]) { 559 sneighs = PETSC_FALSE; 560 } else { 561 PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]]; 562 for (k=0;k<vc;k++) { 563 if (vn[k] != en[k]) { 564 sneighs = PETSC_FALSE; 565 break; 566 } 567 } 568 } 569 } 570 if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */ 571 if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir); 572 ierr = PetscBTSet(btv,i);CHKERRQ(ierr); 573 } else if (test == ord) { 574 if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) { 575 if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i); 576 ierr = PetscBTSet(btv,i);CHKERRQ(ierr); 577 } else { 578 if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i); 579 ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr); 580 } 581 } 582 } 583 ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr); 584 ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr); 585 ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr); 586 587 /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */ 588 if (order != 1) { 589 if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n"); 590 ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 591 for (i=0;i<nv;i++) { 592 if (PetscBTLookup(btvcand,i)) { 593 PetscBool found = PETSC_FALSE; 594 for (j=ii[i];j<ii[i+1] && !found;j++) { 595 PetscInt k,e = jj[j]; 596 if (PetscBTLookup(bte,e)) continue; 597 for (k=iit[e];k<iit[e+1];k++) { 598 PetscInt v = jjt[k]; 599 if (v != i && PetscBTLookup(btvcand,v)) { 600 found = PETSC_TRUE; 601 break; 602 } 603 } 604 } 605 if (!found) { 606 if (print) PetscPrintf(PETSC_COMM_SELF," CANDIDATE %D CLEARED\n",i); 607 ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr); 608 } else { 609 if (print) PetscPrintf(PETSC_COMM_SELF," CANDIDATE %D ACCEPTED\n",i); 610 } 611 } 612 } 613 ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 614 } 615 ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr); 616 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 617 ierr = MatDestroy(&lGe);CHKERRQ(ierr); 618 619 /* Get the local G^T explicitly */ 620 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 621 ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 622 ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr); 623 624 /* Mark interior nodal dofs */ 625 ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 626 ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr); 627 for (i=1;i<n_neigh;i++) { 628 for (j=0;j<n_shared[i];j++) { 629 ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr); 630 } 631 } 632 ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 633 634 /* communicate corners and splitpoints */ 635 ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr); 636 ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr); 637 ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr); 638 for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1; 639 640 if (print) { 641 IS tbz; 642 643 cum = 0; 644 for (i=0;i<nv;i++) 645 if (sfvleaves[i]) 646 vmarks[cum++] = i; 647 648 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr); 649 ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr); 650 ierr = ISView(tbz,NULL);CHKERRQ(ierr); 651 ierr = ISDestroy(&tbz);CHKERRQ(ierr); 652 } 653 654 ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr); 655 ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr); 656 ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr); 657 ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr); 658 659 /* Zero rows of lGt corresponding to identified corners 660 and interior nodal dofs */ 661 cum = 0; 662 for (i=0;i<nv;i++) { 663 if (sfvleaves[i]) { 664 vmarks[cum++] = i; 665 ierr = PetscBTSet(btv,i);CHKERRQ(ierr); 666 } 667 if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i; 668 } 669 ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr); 670 if (print) { 671 IS tbz; 672 673 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr); 674 ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr); 675 ierr = ISView(tbz,NULL);CHKERRQ(ierr); 676 ierr = ISDestroy(&tbz);CHKERRQ(ierr); 677 } 678 ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr); 679 ierr = PetscFree(vmarks);CHKERRQ(ierr); 680 ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr); 681 ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr); 682 683 /* Recompute G */ 684 ierr = MatDestroy(&lG);CHKERRQ(ierr); 685 ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr); 686 if (print) { 687 ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr); 688 ierr = MatView(lG,NULL);CHKERRQ(ierr); 689 ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr); 690 ierr = MatView(lGt,NULL);CHKERRQ(ierr); 691 } 692 693 /* Get primal dofs (if any) */ 694 cum = 0; 695 for (i=0;i<ne;i++) { 696 if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i; 697 } 698 if (fl2g) { 699 ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr); 700 } 701 ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr); 702 if (print) { 703 ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr); 704 ierr = ISView(primals,NULL);CHKERRQ(ierr); 705 } 706 ierr = PetscBTDestroy(&bte);CHKERRQ(ierr); 707 /* TODO: what if the user passed in some of them ? */ 708 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr); 709 ierr = ISDestroy(&primals);CHKERRQ(ierr); 710 711 /* Compute edge connectivity */ 712 ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr); 713 ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr); 714 ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 715 if (fl2g) { 716 PetscBT btf; 717 PetscInt *iia,*jja,*iiu,*jju; 718 PetscBool rest = PETSC_FALSE,free = PETSC_FALSE; 719 720 /* create CSR for all local dofs */ 721 ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr); 722 if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */ 723 if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n); 724 iiu = pcbddc->mat_graph->xadj; 725 jju = pcbddc->mat_graph->adjncy; 726 } else if (pcbddc->use_local_adj) { 727 rest = PETSC_TRUE; 728 ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr); 729 } else { 730 free = PETSC_TRUE; 731 ierr = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr); 732 iiu[0] = 0; 733 for (i=0;i<n;i++) { 734 iiu[i+1] = i+1; 735 jju[i] = -1; 736 } 737 } 738 739 /* import sizes of CSR */ 740 iia[0] = 0; 741 for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i]; 742 743 /* overwrite entries corresponding to the Nedelec field */ 744 ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr); 745 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 746 for (i=0;i<ne;i++) { 747 ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr); 748 iia[idxs[i]+1] = ii[i+1]-ii[i]; 749 } 750 751 /* iia in CSR */ 752 for (i=0;i<n;i++) iia[i+1] += iia[i]; 753 754 /* jja in CSR */ 755 ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr); 756 for (i=0;i<n;i++) 757 if (!PetscBTLookup(btf,i)) 758 for (j=0;j<iiu[i+1]-iiu[i];j++) 759 jja[iia[i]+j] = jju[iiu[i]+j]; 760 761 /* map edge dofs connectivity */ 762 if (jj) { 763 ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr); 764 for (i=0;i<ne;i++) { 765 PetscInt e = idxs[i]; 766 for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j]; 767 } 768 } 769 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 770 ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr); 771 if (rest) { 772 ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr); 773 } 774 if (free) { 775 ierr = PetscFree2(iiu,jju);CHKERRQ(ierr); 776 } 777 ierr = PetscBTDestroy(&btf);CHKERRQ(ierr); 778 } else { 779 ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr); 780 } 781 782 /* Analyze interface for edge dofs */ 783 ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr); 784 pcbddc->mat_graph->twodim = PETSC_FALSE; 785 786 /* Get coarse edges in the edge space */ 787 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 788 ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 789 790 if (fl2g) { 791 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr); 792 ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr); 793 for (i=0;i<nee;i++) { 794 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr); 795 } 796 } else { 797 eedges = alleedges; 798 primals = allprimals; 799 } 800 801 /* Mark fine edge dofs with their coarse edge id */ 802 ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr); 803 ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr); 804 ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr); 805 for (i=0;i<cum;i++) marks[idxs[i]] = nee+1; 806 ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr); 807 if (print) { 808 ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr); 809 ierr = ISView(primals,NULL);CHKERRQ(ierr); 810 } 811 812 maxsize = 0; 813 for (i=0;i<nee;i++) { 814 PetscInt size,mark = i+1; 815 816 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 817 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 818 for (j=0;j<size;j++) marks[idxs[j]] = mark; 819 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 820 maxsize = PetscMax(maxsize,size); 821 } 822 823 /* Find coarse edge endpoints */ 824 ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 825 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 826 for (i=0;i<nee;i++) { 827 PetscInt mark = i+1,size; 828 829 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 830 if (!size && nedfieldlocal) continue; 831 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 832 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 833 if (print) { 834 ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr); 835 ierr = ISView(eedges[i],NULL);CHKERRQ(ierr); 836 } 837 for (j=0;j<size;j++) { 838 PetscInt k, ee = idxs[j]; 839 if (print) PetscPrintf(PETSC_COMM_SELF," idx %D\n",ee); 840 for (k=ii[ee];k<ii[ee+1];k++) { 841 if (print) PetscPrintf(PETSC_COMM_SELF," inspect %D\n",jj[k]); 842 if (PetscBTLookup(btv,jj[k])) { 843 if (print) PetscPrintf(PETSC_COMM_SELF," corner found (already set) %D\n",jj[k]); 844 } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */ 845 PetscInt k2; 846 PetscBool corner = PETSC_FALSE; 847 for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) { 848 if (print) PetscPrintf(PETSC_COMM_SELF," INSPECTING %D: mark %D (ref mark %D), boundary %D\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2])); 849 /* it's a corner if either is connected with an edge dof belonging to a different cc or 850 if the edge dof lie on the natural part of the boundary */ 851 if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) { 852 corner = PETSC_TRUE; 853 break; 854 } 855 } 856 if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */ 857 if (print) PetscPrintf(PETSC_COMM_SELF," corner found %D\n",jj[k]); 858 ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr); 859 } else { 860 if (print) PetscPrintf(PETSC_COMM_SELF," no corners found\n"); 861 } 862 } 863 } 864 } 865 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 866 } 867 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 868 ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 869 ierr = PetscBTDestroy(&btb);CHKERRQ(ierr); 870 871 /* Reset marked primal dofs */ 872 ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr); 873 ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr); 874 for (i=0;i<cum;i++) marks[idxs[i]] = 0; 875 ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr); 876 877 /* Now use the initial lG */ 878 ierr = MatDestroy(&lG);CHKERRQ(ierr); 879 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 880 lG = lGinit; 881 ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 882 883 /* Compute extended cols indices */ 884 ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr); 885 ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr); 886 ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 887 ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr); 888 i *= maxsize; 889 ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr); 890 ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr); 891 eerr = PETSC_FALSE; 892 for (i=0;i<nee;i++) { 893 PetscInt size,found = 0; 894 895 cum = 0; 896 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 897 if (!size && nedfieldlocal) continue; 898 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 899 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 900 ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr); 901 for (j=0;j<size;j++) { 902 PetscInt k,ee = idxs[j]; 903 for (k=ii[ee];k<ii[ee+1];k++) { 904 PetscInt vv = jj[k]; 905 if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv; 906 else if (!PetscBTLookupSet(btvc,vv)) found++; 907 } 908 } 909 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 910 ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr); 911 ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr); 912 ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr); 913 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr); 914 /* it may happen that endpoints are not defined at this point 915 if it is the case, mark this edge for a second pass */ 916 if (cum != size -1 || found != 2) { 917 ierr = PetscBTSet(bter,i);CHKERRQ(ierr); 918 if (print) { 919 ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr); 920 ierr = ISView(eedges[i],NULL);CHKERRQ(ierr); 921 ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr); 922 ierr = ISView(extcols[i],NULL);CHKERRQ(ierr); 923 } 924 eerr = PETSC_TRUE; 925 } 926 } 927 /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */ 928 ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr); 929 if (done) { 930 PetscInt *newprimals; 931 932 ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr); 933 ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr); 934 ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr); 935 ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr); 936 ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr); 937 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 938 if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr); 939 for (i=0;i<nee;i++) { 940 PetscBool has_candidates = PETSC_FALSE; 941 if (PetscBTLookup(bter,i)) { 942 PetscInt size,mark = i+1; 943 944 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 945 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 946 /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */ 947 for (j=0;j<size;j++) { 948 PetscInt k,ee = idxs[j]; 949 if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]); 950 for (k=ii[ee];k<ii[ee+1];k++) { 951 /* set all candidates located on the edge as corners */ 952 if (PetscBTLookup(btvcand,jj[k])) { 953 PetscInt k2,vv = jj[k]; 954 has_candidates = PETSC_TRUE; 955 if (print) PetscPrintf(PETSC_COMM_SELF," Candidate set to vertex %D\n",vv); 956 ierr = PetscBTSet(btv,vv);CHKERRQ(ierr); 957 /* set all edge dofs connected to candidate as primals */ 958 for (k2=iit[vv];k2<iit[vv+1];k2++) { 959 if (marks[jjt[k2]] == mark) { 960 PetscInt k3,ee2 = jjt[k2]; 961 if (print) PetscPrintf(PETSC_COMM_SELF," Connected edge dof set to primal %D\n",ee2); 962 newprimals[cum++] = ee2; 963 /* finally set the new corners */ 964 for (k3=ii[ee2];k3<ii[ee2+1];k3++) { 965 if (print) PetscPrintf(PETSC_COMM_SELF," Connected nodal dof set to vertex %D\n",jj[k3]); 966 ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr); 967 } 968 } 969 } 970 } else { 971 if (print) PetscPrintf(PETSC_COMM_SELF," Not a candidate vertex %D\n",jj[k]); 972 } 973 } 974 } 975 if (!has_candidates) { /* circular edge */ 976 PetscInt k, ee = idxs[0],*tmarks; 977 978 ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr); 979 if (print) PetscPrintf(PETSC_COMM_SELF," Circular edge %D\n",i); 980 for (k=ii[ee];k<ii[ee+1];k++) { 981 PetscInt k2; 982 if (print) PetscPrintf(PETSC_COMM_SELF," Set to corner %D\n",jj[k]); 983 ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr); 984 for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++; 985 } 986 for (j=0;j<size;j++) { 987 if (tmarks[idxs[j]] > 1) { 988 if (print) PetscPrintf(PETSC_COMM_SELF," Edge dof set to primal %D\n",idxs[j]); 989 newprimals[cum++] = idxs[j]; 990 } 991 } 992 ierr = PetscFree(tmarks);CHKERRQ(ierr); 993 } 994 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 995 } 996 ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr); 997 } 998 ierr = PetscFree(extcols);CHKERRQ(ierr); 999 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 1000 ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr); 1001 if (fl2g) { 1002 ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr); 1003 ierr = ISDestroy(&primals);CHKERRQ(ierr); 1004 for (i=0;i<nee;i++) { 1005 ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr); 1006 } 1007 ierr = PetscFree(eedges);CHKERRQ(ierr); 1008 } 1009 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 1010 ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr); 1011 ierr = PetscFree(newprimals);CHKERRQ(ierr); 1012 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr); 1013 ierr = ISDestroy(&primals);CHKERRQ(ierr); 1014 ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr); 1015 pcbddc->mat_graph->twodim = PETSC_FALSE; 1016 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 1017 if (fl2g) { 1018 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr); 1019 ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr); 1020 for (i=0;i<nee;i++) { 1021 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr); 1022 } 1023 } else { 1024 eedges = alleedges; 1025 primals = allprimals; 1026 } 1027 ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr); 1028 1029 /* Mark again */ 1030 ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr); 1031 for (i=0;i<nee;i++) { 1032 PetscInt size,mark = i+1; 1033 1034 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 1035 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 1036 for (j=0;j<size;j++) marks[idxs[j]] = mark; 1037 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 1038 } 1039 if (print) { 1040 ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr); 1041 ierr = ISView(primals,NULL);CHKERRQ(ierr); 1042 } 1043 1044 /* Recompute extended cols */ 1045 eerr = PETSC_FALSE; 1046 for (i=0;i<nee;i++) { 1047 PetscInt size; 1048 1049 cum = 0; 1050 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 1051 if (!size && nedfieldlocal) continue; 1052 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 1053 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 1054 for (j=0;j<size;j++) { 1055 PetscInt k,ee = idxs[j]; 1056 for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k]; 1057 } 1058 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 1059 ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr); 1060 ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr); 1061 ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr); 1062 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr); 1063 if (cum != size -1) { 1064 if (print) { 1065 ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr); 1066 ierr = ISView(eedges[i],NULL);CHKERRQ(ierr); 1067 ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr); 1068 ierr = ISView(extcols[i],NULL);CHKERRQ(ierr); 1069 } 1070 eerr = PETSC_TRUE; 1071 } 1072 } 1073 } 1074 ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1075 ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr); 1076 ierr = PetscBTDestroy(&bter);CHKERRQ(ierr); 1077 if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } 1078 /* an error should not occur at this point */ 1079 if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS"); 1080 1081 /* Check the number of endpoints */ 1082 ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1083 ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr); 1084 ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr); 1085 for (i=0;i<nee;i++) { 1086 PetscInt size, found = 0, gc[2]; 1087 1088 /* init with defaults */ 1089 cedges[i] = corners[i*2] = corners[i*2+1] = -1; 1090 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 1091 if (!size && nedfieldlocal) continue; 1092 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 1093 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 1094 ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr); 1095 for (j=0;j<size;j++) { 1096 PetscInt k,ee = idxs[j]; 1097 for (k=ii[ee];k<ii[ee+1];k++) { 1098 PetscInt vv = jj[k]; 1099 if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) { 1100 if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i); 1101 corners[i*2+found++] = vv; 1102 } 1103 } 1104 } 1105 if (found != 2) { 1106 PetscInt e; 1107 if (fl2g) { 1108 ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr); 1109 } else { 1110 e = idxs[0]; 1111 } 1112 SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]); 1113 } 1114 1115 /* get primal dof index on this coarse edge */ 1116 ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr); 1117 if (gc[0] > gc[1]) { 1118 PetscInt swap = corners[2*i]; 1119 corners[2*i] = corners[2*i+1]; 1120 corners[2*i+1] = swap; 1121 } 1122 cedges[i] = idxs[size-1]; 1123 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 1124 if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]); 1125 } 1126 ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1127 ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr); 1128 1129 #if defined(PETSC_USE_DEBUG) 1130 /* Inspects columns of lG (rows of lGt) and make sure the change of basis will 1131 not interfere with neighbouring coarse edges */ 1132 ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr); 1133 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1134 for (i=0;i<nv;i++) { 1135 PetscInt emax = 0,eemax = 0; 1136 1137 if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue; 1138 ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr); 1139 for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++; 1140 for (j=1;j<nee+1;j++) { 1141 if (emax < emarks[j]) { 1142 emax = emarks[j]; 1143 eemax = j; 1144 } 1145 } 1146 /* not relevant for edges */ 1147 if (!eemax) continue; 1148 1149 for (j=ii[i];j<ii[i+1];j++) { 1150 if (marks[jj[j]] && marks[jj[j]] != eemax) { 1151 SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %D and %D) connected through the %D nodal dof at edge dof %D",marks[jj[j]]-1,eemax,i,jj[j]); 1152 } 1153 } 1154 } 1155 ierr = PetscFree(emarks);CHKERRQ(ierr); 1156 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1157 #endif 1158 1159 /* Compute extended rows indices for edge blocks of the change of basis */ 1160 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1161 ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr); 1162 extmem *= maxsize; 1163 ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr); 1164 ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr); 1165 ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr); 1166 for (i=0;i<nv;i++) { 1167 PetscInt mark = 0,size,start; 1168 1169 if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue; 1170 for (j=ii[i];j<ii[i+1];j++) 1171 if (marks[jj[j]] && !mark) 1172 mark = marks[jj[j]]; 1173 1174 /* not relevant */ 1175 if (!mark) continue; 1176 1177 /* import extended row */ 1178 mark--; 1179 start = mark*extmem+extrowcum[mark]; 1180 size = ii[i+1]-ii[i]; 1181 if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem); 1182 ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr); 1183 extrowcum[mark] += size; 1184 } 1185 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1186 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 1187 ierr = PetscFree(marks);CHKERRQ(ierr); 1188 1189 /* Compress extrows */ 1190 cum = 0; 1191 for (i=0;i<nee;i++) { 1192 PetscInt size = extrowcum[i],*start = extrow + i*extmem; 1193 ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr); 1194 ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr); 1195 cum = PetscMax(cum,size); 1196 } 1197 ierr = PetscFree(extrowcum);CHKERRQ(ierr); 1198 ierr = PetscBTDestroy(&btv);CHKERRQ(ierr); 1199 ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr); 1200 1201 /* Workspace for lapack inner calls and VecSetValues */ 1202 ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr); 1203 1204 /* Create change of basis matrix (preallocation can be improved) */ 1205 ierr = MatCreate(comm,&T);CHKERRQ(ierr); 1206 ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n, 1207 pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr); 1208 ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr); 1209 ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr); 1210 ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr); 1211 ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr); 1212 ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 1213 ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); 1214 ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr); 1215 1216 /* Defaults to identity */ 1217 ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr); 1218 ierr = VecSet(tvec,1.0);CHKERRQ(ierr); 1219 ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr); 1220 ierr = VecDestroy(&tvec);CHKERRQ(ierr); 1221 1222 /* Create discrete gradient for the coarser level if needed */ 1223 ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr); 1224 ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr); 1225 if (pcbddc->current_level < pcbddc->max_levels) { 1226 ISLocalToGlobalMapping cel2g,cvl2g; 1227 IS wis,gwis; 1228 PetscInt cnv,cne; 1229 1230 ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr); 1231 if (fl2g) { 1232 ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr); 1233 } else { 1234 ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr); 1235 pcbddc->nedclocal = wis; 1236 } 1237 ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr); 1238 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1239 ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr); 1240 ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr); 1241 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1242 ierr = ISDestroy(&gwis);CHKERRQ(ierr); 1243 1244 ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr); 1245 ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr); 1246 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1247 ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr); 1248 ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr); 1249 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1250 ierr = ISDestroy(&gwis);CHKERRQ(ierr); 1251 1252 ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr); 1253 ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr); 1254 ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr); 1255 ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr); 1256 ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr); 1257 ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr); 1258 ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr); 1259 ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr); 1260 } 1261 ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr); 1262 1263 #if defined(PRINT_GDET) 1264 inc = 0; 1265 lev = pcbddc->current_level; 1266 #endif 1267 1268 /* Insert values in the change of basis matrix */ 1269 for (i=0;i<nee;i++) { 1270 Mat Gins = NULL, GKins = NULL; 1271 IS cornersis = NULL; 1272 PetscScalar cvals[2]; 1273 1274 if (pcbddc->nedcG) { 1275 ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr); 1276 } 1277 ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr); 1278 if (Gins && GKins) { 1279 PetscScalar *data; 1280 const PetscInt *rows,*cols; 1281 PetscInt nrh,nch,nrc,ncc; 1282 1283 ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr); 1284 /* H1 */ 1285 ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr); 1286 ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr); 1287 ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr); 1288 ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr); 1289 ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr); 1290 ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr); 1291 /* complement */ 1292 ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr); 1293 if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i); 1294 if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %D and Gins %D does not match %D for coarse edge %D",ncc,nch,nrc,i); 1295 if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %D with ncc %D",i,ncc); 1296 ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr); 1297 ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr); 1298 ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr); 1299 1300 /* coarse discrete gradient */ 1301 if (pcbddc->nedcG) { 1302 PetscInt cols[2]; 1303 1304 cols[0] = 2*i; 1305 cols[1] = 2*i+1; 1306 ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr); 1307 } 1308 ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr); 1309 } 1310 ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr); 1311 ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr); 1312 ierr = ISDestroy(&cornersis);CHKERRQ(ierr); 1313 ierr = MatDestroy(&Gins);CHKERRQ(ierr); 1314 ierr = MatDestroy(&GKins);CHKERRQ(ierr); 1315 } 1316 ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr); 1317 1318 /* Start assembling */ 1319 ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1320 if (pcbddc->nedcG) { 1321 ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1322 } 1323 1324 /* Free */ 1325 if (fl2g) { 1326 ierr = ISDestroy(&primals);CHKERRQ(ierr); 1327 for (i=0;i<nee;i++) { 1328 ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr); 1329 } 1330 ierr = PetscFree(eedges);CHKERRQ(ierr); 1331 } 1332 1333 /* hack mat_graph with primal dofs on the coarse edges */ 1334 { 1335 PCBDDCGraph graph = pcbddc->mat_graph; 1336 PetscInt *oqueue = graph->queue; 1337 PetscInt *ocptr = graph->cptr; 1338 PetscInt ncc,*idxs; 1339 1340 /* find first primal edge */ 1341 if (pcbddc->nedclocal) { 1342 ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr); 1343 } else { 1344 if (fl2g) { 1345 ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr); 1346 } 1347 idxs = cedges; 1348 } 1349 cum = 0; 1350 while (cum < nee && cedges[cum] < 0) cum++; 1351 1352 /* adapt connected components */ 1353 ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr); 1354 graph->cptr[0] = 0; 1355 for (i=0,ncc=0;i<graph->ncc;i++) { 1356 PetscInt lc = ocptr[i+1]-ocptr[i]; 1357 if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */ 1358 graph->cptr[ncc+1] = graph->cptr[ncc]+1; 1359 graph->queue[graph->cptr[ncc]] = cedges[cum]; 1360 ncc++; 1361 lc--; 1362 cum++; 1363 while (cum < nee && cedges[cum] < 0) cum++; 1364 } 1365 graph->cptr[ncc+1] = graph->cptr[ncc] + lc; 1366 for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j]; 1367 ncc++; 1368 } 1369 graph->ncc = ncc; 1370 if (pcbddc->nedclocal) { 1371 ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr); 1372 } 1373 ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr); 1374 } 1375 ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr); 1376 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 1377 ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr); 1378 ierr = MatDestroy(&conn);CHKERRQ(ierr); 1379 1380 ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr); 1381 ierr = PetscFree(extrow);CHKERRQ(ierr); 1382 ierr = PetscFree2(work,rwork);CHKERRQ(ierr); 1383 ierr = PetscFree(corners);CHKERRQ(ierr); 1384 ierr = PetscFree(cedges);CHKERRQ(ierr); 1385 ierr = PetscFree(extrows);CHKERRQ(ierr); 1386 ierr = PetscFree(extcols);CHKERRQ(ierr); 1387 ierr = MatDestroy(&lG);CHKERRQ(ierr); 1388 1389 /* Complete assembling */ 1390 ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1391 if (pcbddc->nedcG) { 1392 ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1393 #if 0 1394 ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr); 1395 ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr); 1396 #endif 1397 } 1398 1399 /* set change of basis */ 1400 ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr); 1401 ierr = MatDestroy(&T);CHKERRQ(ierr); 1402 1403 PetscFunctionReturn(0); 1404 } 1405 1406 /* the near-null space of BDDC carries information on quadrature weights, 1407 and these can be collinear -> so cheat with MatNullSpaceCreate 1408 and create a suitable set of basis vectors first */ 1409 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp) 1410 { 1411 PetscErrorCode ierr; 1412 PetscInt i; 1413 1414 PetscFunctionBegin; 1415 for (i=0;i<nvecs;i++) { 1416 PetscInt first,last; 1417 1418 ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr); 1419 if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented"); 1420 if (i>=first && i < last) { 1421 PetscScalar *data; 1422 ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr); 1423 if (!has_const) { 1424 data[i-first] = 1.; 1425 } else { 1426 data[2*i-first] = 1./PetscSqrtReal(2.); 1427 data[2*i-first+1] = -1./PetscSqrtReal(2.); 1428 } 1429 ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr); 1430 } 1431 ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr); 1432 } 1433 ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr); 1434 for (i=0;i<nvecs;i++) { /* reset vectors */ 1435 PetscInt first,last; 1436 ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr); 1437 ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr); 1438 if (i>=first && i < last) { 1439 PetscScalar *data; 1440 ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr); 1441 if (!has_const) { 1442 data[i-first] = 0.; 1443 } else { 1444 data[2*i-first] = 0.; 1445 data[2*i-first+1] = 0.; 1446 } 1447 ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr); 1448 } 1449 ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr); 1450 ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr); 1451 } 1452 PetscFunctionReturn(0); 1453 } 1454 1455 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp) 1456 { 1457 Mat loc_divudotp; 1458 Vec p,v,vins,quad_vec,*quad_vecs; 1459 ISLocalToGlobalMapping map; 1460 PetscScalar *vals; 1461 const PetscScalar *array; 1462 PetscInt i,maxneighs,maxsize,*gidxs; 1463 PetscInt n_neigh,*neigh,*n_shared,**shared; 1464 PetscMPIInt rank; 1465 PetscErrorCode ierr; 1466 1467 PetscFunctionBegin; 1468 ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 1469 ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr); 1470 if (!maxneighs) { 1471 ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 1472 *nnsp = NULL; 1473 PetscFunctionReturn(0); 1474 } 1475 maxsize = 0; 1476 for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize); 1477 ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr); 1478 /* create vectors to hold quadrature weights */ 1479 ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr); 1480 if (!transpose) { 1481 ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr); 1482 } else { 1483 ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr); 1484 } 1485 ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr); 1486 ierr = VecDestroy(&quad_vec);CHKERRQ(ierr); 1487 ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr); 1488 for (i=0;i<maxneighs;i++) { 1489 ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr); 1490 } 1491 1492 /* compute local quad vec */ 1493 ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr); 1494 if (!transpose) { 1495 ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr); 1496 } else { 1497 ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr); 1498 } 1499 ierr = VecSet(p,1.);CHKERRQ(ierr); 1500 if (!transpose) { 1501 ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr); 1502 } else { 1503 ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr); 1504 } 1505 if (vl2l) { 1506 Mat lA; 1507 VecScatter sc; 1508 1509 ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr); 1510 ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr); 1511 ierr = VecScatterCreateWithData(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr); 1512 ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1513 ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1514 ierr = VecScatterDestroy(&sc);CHKERRQ(ierr); 1515 } else { 1516 vins = v; 1517 } 1518 ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr); 1519 ierr = VecDestroy(&p);CHKERRQ(ierr); 1520 1521 /* insert in global quadrature vecs */ 1522 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr); 1523 for (i=0;i<n_neigh;i++) { 1524 const PetscInt *idxs; 1525 PetscInt idx,nn,j; 1526 1527 idxs = shared[i]; 1528 nn = n_shared[i]; 1529 for (j=0;j<nn;j++) vals[j] = array[idxs[j]]; 1530 ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr); 1531 idx = -(idx+1); 1532 ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr); 1533 ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr); 1534 } 1535 ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 1536 ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr); 1537 if (vl2l) { 1538 ierr = VecDestroy(&vins);CHKERRQ(ierr); 1539 } 1540 ierr = VecDestroy(&v);CHKERRQ(ierr); 1541 ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr); 1542 1543 /* assemble near null space */ 1544 for (i=0;i<maxneighs;i++) { 1545 ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr); 1546 } 1547 for (i=0;i<maxneighs;i++) { 1548 ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr); 1549 ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr); 1550 ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr); 1551 } 1552 ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr); 1553 PetscFunctionReturn(0); 1554 } 1555 1556 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv) 1557 { 1558 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1559 PetscErrorCode ierr; 1560 1561 PetscFunctionBegin; 1562 if (primalv) { 1563 if (pcbddc->user_primal_vertices_local) { 1564 IS list[2], newp; 1565 1566 list[0] = primalv; 1567 list[1] = pcbddc->user_primal_vertices_local; 1568 ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr); 1569 ierr = ISSortRemoveDups(newp);CHKERRQ(ierr); 1570 ierr = ISDestroy(&list[1]);CHKERRQ(ierr); 1571 pcbddc->user_primal_vertices_local = newp; 1572 } else { 1573 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr); 1574 } 1575 } 1576 PetscFunctionReturn(0); 1577 } 1578 1579 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx) 1580 { 1581 PetscInt f, *comp = (PetscInt *)ctx; 1582 1583 PetscFunctionBegin; 1584 for (f=0;f<Nf;f++) out[f] = X[*comp]; 1585 PetscFunctionReturn(0); 1586 } 1587 1588 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc) 1589 { 1590 PetscErrorCode ierr; 1591 Vec local,global; 1592 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1593 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 1594 PetscBool monolithic = PETSC_FALSE; 1595 1596 PetscFunctionBegin; 1597 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr); 1598 ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr); 1599 ierr = PetscOptionsEnd();CHKERRQ(ierr); 1600 /* need to convert from global to local topology information and remove references to information in global ordering */ 1601 ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr); 1602 ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr); 1603 if (monolithic) { /* just get block size to properly compute vertices */ 1604 if (pcbddc->vertex_size == 1) { 1605 ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr); 1606 } 1607 goto boundary; 1608 } 1609 1610 if (pcbddc->user_provided_isfordofs) { 1611 if (pcbddc->n_ISForDofs) { 1612 PetscInt i; 1613 1614 ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr); 1615 for (i=0;i<pcbddc->n_ISForDofs;i++) { 1616 PetscInt bs; 1617 1618 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1619 ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr); 1620 ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr); 1621 ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); 1622 } 1623 pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs; 1624 pcbddc->n_ISForDofs = 0; 1625 ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 1626 } 1627 } else { 1628 if (!pcbddc->n_ISForDofsLocal) { /* field split not present */ 1629 DM dm; 1630 1631 ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr); 1632 if (!dm) { 1633 ierr = PCGetDM(pc, &dm);CHKERRQ(ierr); 1634 } 1635 if (dm) { 1636 IS *fields; 1637 PetscInt nf,i; 1638 1639 ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr); 1640 ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr); 1641 for (i=0;i<nf;i++) { 1642 PetscInt bs; 1643 1644 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1645 ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr); 1646 ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr); 1647 ierr = ISDestroy(&fields[i]);CHKERRQ(ierr); 1648 } 1649 ierr = PetscFree(fields);CHKERRQ(ierr); 1650 pcbddc->n_ISForDofsLocal = nf; 1651 } else { /* See if MATIS has fields attached by the conversion from MatNest */ 1652 PetscContainer c; 1653 1654 ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr); 1655 if (c) { 1656 MatISLocalFields lf; 1657 ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr); 1658 ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr); 1659 } else { /* fallback, create the default fields if bs > 1 */ 1660 PetscInt i, n = matis->A->rmap->n; 1661 ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr); 1662 if (i > 1) { 1663 pcbddc->n_ISForDofsLocal = i; 1664 ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr); 1665 for (i=0;i<pcbddc->n_ISForDofsLocal;i++) { 1666 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1667 } 1668 } 1669 } 1670 } 1671 } else { 1672 PetscInt i; 1673 for (i=0;i<pcbddc->n_ISForDofsLocal;i++) { 1674 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1675 } 1676 } 1677 } 1678 1679 boundary: 1680 if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { 1681 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr); 1682 } else if (pcbddc->DirichletBoundariesLocal) { 1683 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr); 1684 } 1685 if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { 1686 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr); 1687 } else if (pcbddc->NeumannBoundariesLocal) { 1688 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr); 1689 } 1690 if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) { 1691 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 1692 } 1693 ierr = VecDestroy(&global);CHKERRQ(ierr); 1694 ierr = VecDestroy(&local);CHKERRQ(ierr); 1695 /* detect local disconnected subdomains if requested (use matis->A) */ 1696 if (pcbddc->detect_disconnected) { 1697 IS primalv = NULL; 1698 PetscInt i; 1699 PetscBool filter = pcbddc->detect_disconnected_filter; 1700 1701 for (i=0;i<pcbddc->n_local_subs;i++) { 1702 ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr); 1703 } 1704 ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr); 1705 ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr); 1706 ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr); 1707 ierr = ISDestroy(&primalv);CHKERRQ(ierr); 1708 } 1709 /* early stage corner detection */ 1710 { 1711 DM dm; 1712 1713 ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr); 1714 if (!dm) { 1715 ierr = PCGetDM(pc,&dm);CHKERRQ(ierr); 1716 } 1717 if (dm) { 1718 PetscBool isda; 1719 1720 ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr); 1721 if (isda) { 1722 ISLocalToGlobalMapping l2l; 1723 IS corners; 1724 Mat lA; 1725 PetscBool gl,lo; 1726 1727 { 1728 Vec cvec; 1729 const PetscScalar *coords; 1730 PetscInt dof,n,cdim; 1731 PetscBool memc = PETSC_TRUE; 1732 1733 ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr); 1734 ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr); 1735 ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr); 1736 ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr); 1737 n /= cdim; 1738 ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr); 1739 ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr); 1740 ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr); 1741 #if defined(PETSC_USE_COMPLEX) 1742 memc = PETSC_FALSE; 1743 #endif 1744 if (dof != 1) memc = PETSC_FALSE; 1745 if (memc) { 1746 ierr = PetscMemcpy(pcbddc->mat_graph->coords,coords,cdim*n*dof*sizeof(PetscReal));CHKERRQ(ierr); 1747 } else { /* BDDC graph does not use any blocked information, we need to replicate the data */ 1748 PetscReal *bcoords = pcbddc->mat_graph->coords; 1749 PetscInt i, b, d; 1750 1751 for (i=0;i<n;i++) { 1752 for (b=0;b<dof;b++) { 1753 for (d=0;d<cdim;d++) { 1754 bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]); 1755 } 1756 } 1757 } 1758 } 1759 ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr); 1760 pcbddc->mat_graph->cdim = cdim; 1761 pcbddc->mat_graph->cnloc = dof*n; 1762 pcbddc->mat_graph->cloc = PETSC_FALSE; 1763 } 1764 ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr); 1765 ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr); 1766 ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr); 1767 ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr); 1768 lo = (PetscBool)(l2l && corners); 1769 ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 1770 if (gl) { /* From PETSc's DMDA */ 1771 const PetscInt *idx; 1772 PetscInt dof,bs,*idxout,n; 1773 1774 ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr); 1775 ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr); 1776 ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr); 1777 ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr); 1778 if (bs == dof) { 1779 ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr); 1780 ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr); 1781 } else { /* the original DMDA local-to-local map have been modified */ 1782 PetscInt i,d; 1783 1784 ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr); 1785 for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d; 1786 ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr); 1787 1788 bs = 1; 1789 n *= dof; 1790 } 1791 ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr); 1792 ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr); 1793 ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr); 1794 ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr); 1795 ierr = ISDestroy(&corners);CHKERRQ(ierr); 1796 pcbddc->corner_selected = PETSC_TRUE; 1797 pcbddc->corner_selection = PETSC_TRUE; 1798 } 1799 if (corners) { 1800 ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr); 1801 } 1802 } 1803 } 1804 } 1805 if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) { 1806 DM dm; 1807 1808 ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr); 1809 if (!dm) { 1810 ierr = PCGetDM(pc,&dm);CHKERRQ(ierr); 1811 } 1812 if (dm) { /* this can get very expensive, I need to find a faster alternative */ 1813 Vec vcoords; 1814 PetscSection section; 1815 PetscReal *coords; 1816 PetscInt d,cdim,nl,nf,**ctxs; 1817 PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *); 1818 1819 ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr); 1820 ierr = DMGetSection(dm,§ion);CHKERRQ(ierr); 1821 ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr); 1822 ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr); 1823 ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr); 1824 ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr); 1825 ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr); 1826 ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr); 1827 for (d=0;d<nf;d++) funcs[d] = func_coords_private; 1828 for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1; 1829 for (d=0;d<cdim;d++) { 1830 PetscInt i; 1831 const PetscScalar *v; 1832 1833 for (i=0;i<nf;i++) ctxs[i][0] = d; 1834 ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr); 1835 ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr); 1836 for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]); 1837 ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr); 1838 } 1839 ierr = VecDestroy(&vcoords);CHKERRQ(ierr); 1840 ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr); 1841 ierr = PetscFree(coords);CHKERRQ(ierr); 1842 ierr = PetscFree(ctxs[0]);CHKERRQ(ierr); 1843 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 1844 } 1845 } 1846 PetscFunctionReturn(0); 1847 } 1848 1849 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is) 1850 { 1851 Mat_IS *matis = (Mat_IS*)(pc->pmat->data); 1852 PetscErrorCode ierr; 1853 IS nis; 1854 const PetscInt *idxs; 1855 PetscInt i,nd,n = matis->A->rmap->n,*nidxs,nnd; 1856 PetscBool *ld; 1857 1858 PetscFunctionBegin; 1859 if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR"); 1860 if (mop == MPI_LAND) { 1861 /* init rootdata with true */ 1862 ld = (PetscBool*) matis->sf_rootdata; 1863 for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE; 1864 } else { 1865 ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr); 1866 } 1867 ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr); 1868 ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr); 1869 ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr); 1870 ld = (PetscBool*) matis->sf_leafdata; 1871 for (i=0;i<nd;i++) 1872 if (-1 < idxs[i] && idxs[i] < n) 1873 ld[idxs[i]] = PETSC_TRUE; 1874 ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr); 1875 ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr); 1876 ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr); 1877 ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 1878 ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 1879 if (mop == MPI_LAND) { 1880 ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr); 1881 } else { 1882 ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr); 1883 } 1884 for (i=0,nnd=0;i<n;i++) 1885 if (ld[i]) 1886 nidxs[nnd++] = i; 1887 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr); 1888 ierr = ISDestroy(is);CHKERRQ(ierr); 1889 *is = nis; 1890 PetscFunctionReturn(0); 1891 } 1892 1893 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z) 1894 { 1895 PC_IS *pcis = (PC_IS*)(pc->data); 1896 PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 1897 PetscErrorCode ierr; 1898 1899 PetscFunctionBegin; 1900 if (!pcbddc->benign_have_null) { 1901 PetscFunctionReturn(0); 1902 } 1903 if (pcbddc->ChangeOfBasisMatrix) { 1904 Vec swap; 1905 1906 ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr); 1907 swap = pcbddc->work_change; 1908 pcbddc->work_change = r; 1909 r = swap; 1910 } 1911 ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1912 ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1913 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 1914 ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr); 1915 ierr = VecSet(z,0.);CHKERRQ(ierr); 1916 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1917 ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1918 if (pcbddc->ChangeOfBasisMatrix) { 1919 pcbddc->work_change = r; 1920 ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr); 1921 ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr); 1922 } 1923 PetscFunctionReturn(0); 1924 } 1925 1926 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose) 1927 { 1928 PCBDDCBenignMatMult_ctx ctx; 1929 PetscErrorCode ierr; 1930 PetscBool apply_right,apply_left,reset_x; 1931 1932 PetscFunctionBegin; 1933 ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr); 1934 if (transpose) { 1935 apply_right = ctx->apply_left; 1936 apply_left = ctx->apply_right; 1937 } else { 1938 apply_right = ctx->apply_right; 1939 apply_left = ctx->apply_left; 1940 } 1941 reset_x = PETSC_FALSE; 1942 if (apply_right) { 1943 const PetscScalar *ax; 1944 PetscInt nl,i; 1945 1946 ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr); 1947 ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr); 1948 ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr); 1949 ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr); 1950 for (i=0;i<ctx->benign_n;i++) { 1951 PetscScalar sum,val; 1952 const PetscInt *idxs; 1953 PetscInt nz,j; 1954 ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 1955 ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 1956 sum = 0.; 1957 if (ctx->apply_p0) { 1958 val = ctx->work[idxs[nz-1]]; 1959 for (j=0;j<nz-1;j++) { 1960 sum += ctx->work[idxs[j]]; 1961 ctx->work[idxs[j]] += val; 1962 } 1963 } else { 1964 for (j=0;j<nz-1;j++) { 1965 sum += ctx->work[idxs[j]]; 1966 } 1967 } 1968 ctx->work[idxs[nz-1]] -= sum; 1969 ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 1970 } 1971 ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr); 1972 reset_x = PETSC_TRUE; 1973 } 1974 if (transpose) { 1975 ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr); 1976 } else { 1977 ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr); 1978 } 1979 if (reset_x) { 1980 ierr = VecResetArray(x);CHKERRQ(ierr); 1981 } 1982 if (apply_left) { 1983 PetscScalar *ay; 1984 PetscInt i; 1985 1986 ierr = VecGetArray(y,&ay);CHKERRQ(ierr); 1987 for (i=0;i<ctx->benign_n;i++) { 1988 PetscScalar sum,val; 1989 const PetscInt *idxs; 1990 PetscInt nz,j; 1991 ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 1992 ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 1993 val = -ay[idxs[nz-1]]; 1994 if (ctx->apply_p0) { 1995 sum = 0.; 1996 for (j=0;j<nz-1;j++) { 1997 sum += ay[idxs[j]]; 1998 ay[idxs[j]] += val; 1999 } 2000 ay[idxs[nz-1]] += sum; 2001 } else { 2002 for (j=0;j<nz-1;j++) { 2003 ay[idxs[j]] += val; 2004 } 2005 ay[idxs[nz-1]] = 0.; 2006 } 2007 ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 2008 } 2009 ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr); 2010 } 2011 PetscFunctionReturn(0); 2012 } 2013 2014 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y) 2015 { 2016 PetscErrorCode ierr; 2017 2018 PetscFunctionBegin; 2019 ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr); 2020 PetscFunctionReturn(0); 2021 } 2022 2023 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y) 2024 { 2025 PetscErrorCode ierr; 2026 2027 PetscFunctionBegin; 2028 ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr); 2029 PetscFunctionReturn(0); 2030 } 2031 2032 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore) 2033 { 2034 PC_IS *pcis = (PC_IS*)pc->data; 2035 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 2036 PCBDDCBenignMatMult_ctx ctx; 2037 PetscErrorCode ierr; 2038 2039 PetscFunctionBegin; 2040 if (!restore) { 2041 Mat A_IB,A_BI; 2042 PetscScalar *work; 2043 PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL; 2044 2045 if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored"); 2046 if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0); 2047 ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr); 2048 ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr); 2049 ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); 2050 ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr); 2051 ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr); 2052 ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr); 2053 ierr = PetscNew(&ctx);CHKERRQ(ierr); 2054 ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr); 2055 ctx->apply_left = PETSC_TRUE; 2056 ctx->apply_right = PETSC_FALSE; 2057 ctx->apply_p0 = PETSC_FALSE; 2058 ctx->benign_n = pcbddc->benign_n; 2059 if (reuse) { 2060 ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs; 2061 ctx->free = PETSC_FALSE; 2062 } else { /* TODO: could be optimized for successive solves */ 2063 ISLocalToGlobalMapping N_to_D; 2064 PetscInt i; 2065 2066 ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr); 2067 ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr); 2068 for (i=0;i<pcbddc->benign_n;i++) { 2069 ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr); 2070 } 2071 ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr); 2072 ctx->free = PETSC_TRUE; 2073 } 2074 ctx->A = pcis->A_IB; 2075 ctx->work = work; 2076 ierr = MatSetUp(A_IB);CHKERRQ(ierr); 2077 ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2078 ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2079 pcis->A_IB = A_IB; 2080 2081 /* A_BI as A_IB^T */ 2082 ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr); 2083 pcbddc->benign_original_mat = pcis->A_BI; 2084 pcis->A_BI = A_BI; 2085 } else { 2086 if (!pcbddc->benign_original_mat) { 2087 PetscFunctionReturn(0); 2088 } 2089 ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr); 2090 ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr); 2091 pcis->A_IB = ctx->A; 2092 ctx->A = NULL; 2093 ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr); 2094 pcis->A_BI = pcbddc->benign_original_mat; 2095 pcbddc->benign_original_mat = NULL; 2096 if (ctx->free) { 2097 PetscInt i; 2098 for (i=0;i<ctx->benign_n;i++) { 2099 ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr); 2100 } 2101 ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr); 2102 } 2103 ierr = PetscFree(ctx->work);CHKERRQ(ierr); 2104 ierr = PetscFree(ctx);CHKERRQ(ierr); 2105 } 2106 PetscFunctionReturn(0); 2107 } 2108 2109 /* used just in bddc debug mode */ 2110 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B) 2111 { 2112 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 2113 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2114 Mat An; 2115 PetscErrorCode ierr; 2116 2117 PetscFunctionBegin; 2118 ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr); 2119 ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr); 2120 if (is1) { 2121 ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr); 2122 ierr = MatDestroy(&An);CHKERRQ(ierr); 2123 } else { 2124 *B = An; 2125 } 2126 PetscFunctionReturn(0); 2127 } 2128 2129 /* TODO: add reuse flag */ 2130 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B) 2131 { 2132 Mat Bt; 2133 PetscScalar *a,*bdata; 2134 const PetscInt *ii,*ij; 2135 PetscInt m,n,i,nnz,*bii,*bij; 2136 PetscBool flg_row; 2137 PetscErrorCode ierr; 2138 2139 PetscFunctionBegin; 2140 ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr); 2141 ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr); 2142 ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr); 2143 nnz = n; 2144 for (i=0;i<ii[n];i++) { 2145 if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++; 2146 } 2147 ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr); 2148 ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr); 2149 ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr); 2150 nnz = 0; 2151 bii[0] = 0; 2152 for (i=0;i<n;i++) { 2153 PetscInt j; 2154 for (j=ii[i];j<ii[i+1];j++) { 2155 PetscScalar entry = a[j]; 2156 if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) { 2157 bij[nnz] = ij[j]; 2158 bdata[nnz] = entry; 2159 nnz++; 2160 } 2161 } 2162 bii[i+1] = nnz; 2163 } 2164 ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr); 2165 ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr); 2166 ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr); 2167 { 2168 Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data); 2169 b->free_a = PETSC_TRUE; 2170 b->free_ij = PETSC_TRUE; 2171 } 2172 if (*B == A) { 2173 ierr = MatDestroy(&A);CHKERRQ(ierr); 2174 } 2175 *B = Bt; 2176 PetscFunctionReturn(0); 2177 } 2178 2179 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv) 2180 { 2181 Mat B = NULL; 2182 DM dm; 2183 IS is_dummy,*cc_n; 2184 ISLocalToGlobalMapping l2gmap_dummy; 2185 PCBDDCGraph graph; 2186 PetscInt *xadj_filtered = NULL,*adjncy_filtered = NULL; 2187 PetscInt i,n; 2188 PetscInt *xadj,*adjncy; 2189 PetscBool isplex = PETSC_FALSE; 2190 PetscErrorCode ierr; 2191 2192 PetscFunctionBegin; 2193 if (ncc) *ncc = 0; 2194 if (cc) *cc = NULL; 2195 if (primalv) *primalv = NULL; 2196 ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr); 2197 ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr); 2198 if (!dm) { 2199 ierr = PCGetDM(pc,&dm);CHKERRQ(ierr); 2200 } 2201 if (dm) { 2202 ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr); 2203 } 2204 if (filter) isplex = PETSC_FALSE; 2205 2206 if (isplex) { /* this code has been modified from plexpartition.c */ 2207 PetscInt p, pStart, pEnd, a, adjSize, idx, size, nroots; 2208 PetscInt *adj = NULL; 2209 IS cellNumbering; 2210 const PetscInt *cellNum; 2211 PetscBool useCone, useClosure; 2212 PetscSection section; 2213 PetscSegBuffer adjBuffer; 2214 PetscSF sfPoint; 2215 PetscErrorCode ierr; 2216 2217 PetscFunctionBegin; 2218 ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr); 2219 ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr); 2220 ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr); 2221 /* Build adjacency graph via a section/segbuffer */ 2222 ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), §ion);CHKERRQ(ierr); 2223 ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr); 2224 ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr); 2225 /* Always use FVM adjacency to create partitioner graph */ 2226 ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr); 2227 ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr); 2228 ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr); 2229 ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr); 2230 for (n = 0, p = pStart; p < pEnd; p++) { 2231 /* Skip non-owned cells in parallel (ParMetis expects no overlap) */ 2232 if (nroots > 0) {if (cellNum[p] < 0) continue;} 2233 adjSize = PETSC_DETERMINE; 2234 ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr); 2235 for (a = 0; a < adjSize; ++a) { 2236 const PetscInt point = adj[a]; 2237 if (pStart <= point && point < pEnd) { 2238 PetscInt *PETSC_RESTRICT pBuf; 2239 ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr); 2240 ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr); 2241 *pBuf = point; 2242 } 2243 } 2244 n++; 2245 } 2246 ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr); 2247 /* Derive CSR graph from section/segbuffer */ 2248 ierr = PetscSectionSetUp(section);CHKERRQ(ierr); 2249 ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr); 2250 ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr); 2251 for (idx = 0, p = pStart; p < pEnd; p++) { 2252 if (nroots > 0) {if (cellNum[p] < 0) continue;} 2253 ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr); 2254 } 2255 xadj[n] = size; 2256 ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr); 2257 /* Clean up */ 2258 ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr); 2259 ierr = PetscSectionDestroy(§ion);CHKERRQ(ierr); 2260 ierr = PetscFree(adj);CHKERRQ(ierr); 2261 graph->xadj = xadj; 2262 graph->adjncy = adjncy; 2263 } else { 2264 Mat A; 2265 PetscBool isseqaij, flg_row; 2266 2267 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2268 if (!A->rmap->N || !A->cmap->N) { 2269 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 2270 PetscFunctionReturn(0); 2271 } 2272 ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 2273 if (!isseqaij && filter) { 2274 PetscBool isseqdense; 2275 2276 ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr); 2277 if (!isseqdense) { 2278 ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); 2279 } else { /* TODO: rectangular case and LDA */ 2280 PetscScalar *array; 2281 PetscReal chop=1.e-6; 2282 2283 ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr); 2284 ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr); 2285 ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr); 2286 for (i=0;i<n;i++) { 2287 PetscInt j; 2288 for (j=i+1;j<n;j++) { 2289 PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)])); 2290 if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.; 2291 if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.; 2292 } 2293 } 2294 ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr); 2295 ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr); 2296 } 2297 } else { 2298 ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr); 2299 B = A; 2300 } 2301 ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 2302 2303 /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */ 2304 if (filter) { 2305 PetscScalar *data; 2306 PetscInt j,cum; 2307 2308 ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr); 2309 ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr); 2310 cum = 0; 2311 for (i=0;i<n;i++) { 2312 PetscInt t; 2313 2314 for (j=xadj[i];j<xadj[i+1];j++) { 2315 if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) { 2316 continue; 2317 } 2318 adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j]; 2319 } 2320 t = xadj_filtered[i]; 2321 xadj_filtered[i] = cum; 2322 cum += t; 2323 } 2324 ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr); 2325 graph->xadj = xadj_filtered; 2326 graph->adjncy = adjncy_filtered; 2327 } else { 2328 graph->xadj = xadj; 2329 graph->adjncy = adjncy; 2330 } 2331 } 2332 /* compute local connected components using PCBDDCGraph */ 2333 ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr); 2334 ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr); 2335 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 2336 ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr); 2337 ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr); 2338 ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr); 2339 ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr); 2340 2341 /* partial clean up */ 2342 ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr); 2343 if (B) { 2344 PetscBool flg_row; 2345 ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 2346 ierr = MatDestroy(&B);CHKERRQ(ierr); 2347 } 2348 if (isplex) { 2349 ierr = PetscFree(xadj);CHKERRQ(ierr); 2350 ierr = PetscFree(adjncy);CHKERRQ(ierr); 2351 } 2352 2353 /* get back data */ 2354 if (isplex) { 2355 if (ncc) *ncc = graph->ncc; 2356 if (cc || primalv) { 2357 Mat A; 2358 PetscBT btv,btvt; 2359 PetscSection subSection; 2360 PetscInt *ids,cum,cump,*cids,*pids; 2361 2362 ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr); 2363 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2364 ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr); 2365 ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr); 2366 ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr); 2367 2368 cids[0] = 0; 2369 for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) { 2370 PetscInt j; 2371 2372 ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr); 2373 for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) { 2374 PetscInt k, size, *closure = NULL, cell = graph->queue[j]; 2375 2376 ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr); 2377 for (k = 0; k < 2*size; k += 2) { 2378 PetscInt s, p = closure[k], off, dof, cdof; 2379 2380 ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr); 2381 ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr); 2382 ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr); 2383 for (s = 0; s < dof-cdof; s++) { 2384 if (PetscBTLookupSet(btvt,off+s)) continue; 2385 if (!PetscBTLookup(btv,off+s)) { 2386 ids[cum++] = off+s; 2387 } else { /* cross-vertex */ 2388 pids[cump++] = off+s; 2389 } 2390 } 2391 } 2392 ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr); 2393 } 2394 cids[i+1] = cum; 2395 /* mark dofs as already assigned */ 2396 for (j = cids[i]; j < cids[i+1]; j++) { 2397 ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr); 2398 } 2399 } 2400 if (cc) { 2401 ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr); 2402 for (i = 0; i < graph->ncc; i++) { 2403 ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr); 2404 } 2405 *cc = cc_n; 2406 } 2407 if (primalv) { 2408 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr); 2409 } 2410 ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr); 2411 ierr = PetscBTDestroy(&btv);CHKERRQ(ierr); 2412 ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr); 2413 } 2414 } else { 2415 if (ncc) *ncc = graph->ncc; 2416 if (cc) { 2417 ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr); 2418 for (i=0;i<graph->ncc;i++) { 2419 ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr); 2420 } 2421 *cc = cc_n; 2422 } 2423 } 2424 /* clean up graph */ 2425 graph->xadj = 0; 2426 graph->adjncy = 0; 2427 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 2428 PetscFunctionReturn(0); 2429 } 2430 2431 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag) 2432 { 2433 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2434 PC_IS* pcis = (PC_IS*)(pc->data); 2435 IS dirIS = NULL; 2436 PetscInt i; 2437 PetscErrorCode ierr; 2438 2439 PetscFunctionBegin; 2440 ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr); 2441 if (zerodiag) { 2442 Mat A; 2443 Vec vec3_N; 2444 PetscScalar *vals; 2445 const PetscInt *idxs; 2446 PetscInt nz,*count; 2447 2448 /* p0 */ 2449 ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr); 2450 ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr); 2451 ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr); 2452 ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr); 2453 for (i=0;i<nz;i++) vals[i] = 1.; 2454 ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2455 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 2456 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 2457 /* v_I */ 2458 ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr); 2459 for (i=0;i<nz;i++) vals[i] = 0.; 2460 ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2461 ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr); 2462 ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2463 for (i=0;i<pcis->n_B;i++) vals[i] = 0.; 2464 ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2465 ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2466 if (dirIS) { 2467 PetscInt n; 2468 2469 ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr); 2470 ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr); 2471 for (i=0;i<n;i++) vals[i] = 0.; 2472 ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2473 ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr); 2474 } 2475 ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr); 2476 ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr); 2477 ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr); 2478 ierr = VecSet(vec3_N,0.);CHKERRQ(ierr); 2479 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2480 ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr); 2481 ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr); 2482 if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0])); 2483 ierr = PetscFree(vals);CHKERRQ(ierr); 2484 ierr = VecDestroy(&vec3_N);CHKERRQ(ierr); 2485 2486 /* there should not be any pressure dofs lying on the interface */ 2487 ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr); 2488 ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2489 for (i=0;i<pcis->n_B;i++) count[idxs[i]]++; 2490 ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2491 ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr); 2492 for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %D is an interface dof",idxs[i]); 2493 ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr); 2494 ierr = PetscFree(count);CHKERRQ(ierr); 2495 } 2496 ierr = ISDestroy(&dirIS);CHKERRQ(ierr); 2497 2498 /* check PCBDDCBenignGetOrSetP0 */ 2499 ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr); 2500 for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i; 2501 ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr); 2502 for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1; 2503 ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr); 2504 for (i=0;i<pcbddc->benign_n;i++) { 2505 PetscInt val = PetscRealPart(pcbddc->benign_p0[i]); 2506 if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i); 2507 } 2508 PetscFunctionReturn(0); 2509 } 2510 2511 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal) 2512 { 2513 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2514 IS pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs; 2515 PetscInt nz,n,benign_n,bsp = 1; 2516 PetscInt *interior_dofs,n_interior_dofs,nneu; 2517 PetscBool sorted,have_null,has_null_pressures,recompute_zerodiag,checkb; 2518 PetscErrorCode ierr; 2519 2520 PetscFunctionBegin; 2521 if (reuse) goto project_b0; 2522 ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr); 2523 ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr); 2524 for (n=0;n<pcbddc->benign_n;n++) { 2525 ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr); 2526 } 2527 ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr); 2528 has_null_pressures = PETSC_TRUE; 2529 have_null = PETSC_TRUE; 2530 /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided) 2531 Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field) 2532 Checks if all the pressure dofs in each subdomain have a zero diagonal 2533 If not, a change of basis on pressures is not needed 2534 since the local Schur complements are already SPD 2535 */ 2536 if (pcbddc->n_ISForDofsLocal) { 2537 IS iP = NULL; 2538 PetscInt p,*pp; 2539 PetscBool flg; 2540 2541 ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr); 2542 n = pcbddc->n_ISForDofsLocal; 2543 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr); 2544 ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr); 2545 ierr = PetscOptionsEnd();CHKERRQ(ierr); 2546 if (!flg) { 2547 n = 1; 2548 pp[0] = pcbddc->n_ISForDofsLocal-1; 2549 } 2550 2551 bsp = 0; 2552 for (p=0;p<n;p++) { 2553 PetscInt bs; 2554 2555 if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]); 2556 ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr); 2557 bsp += bs; 2558 } 2559 ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr); 2560 bsp = 0; 2561 for (p=0;p<n;p++) { 2562 const PetscInt *idxs; 2563 PetscInt b,bs,npl,*bidxs; 2564 2565 ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr); 2566 ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr); 2567 ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr); 2568 ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr); 2569 for (b=0;b<bs;b++) { 2570 PetscInt i; 2571 2572 for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b]; 2573 ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr); 2574 bsp++; 2575 } 2576 ierr = PetscFree(bidxs);CHKERRQ(ierr); 2577 ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr); 2578 } 2579 ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr); 2580 2581 /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */ 2582 ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr); 2583 if (iP) { 2584 IS newpressures; 2585 2586 ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr); 2587 ierr = ISDestroy(&pressures);CHKERRQ(ierr); 2588 pressures = newpressures; 2589 } 2590 ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr); 2591 if (!sorted) { 2592 ierr = ISSort(pressures);CHKERRQ(ierr); 2593 } 2594 ierr = PetscFree(pp);CHKERRQ(ierr); 2595 } 2596 2597 /* pcis has not been setup yet, so get the local size from the subdomain matrix */ 2598 ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr); 2599 if (!n) pcbddc->benign_change_explicit = PETSC_TRUE; 2600 ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr); 2601 ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr); 2602 if (!sorted) { 2603 ierr = ISSort(zerodiag);CHKERRQ(ierr); 2604 } 2605 ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr); 2606 zerodiag_save = zerodiag; 2607 ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr); 2608 if (!nz) { 2609 if (n) have_null = PETSC_FALSE; 2610 has_null_pressures = PETSC_FALSE; 2611 ierr = ISDestroy(&zerodiag);CHKERRQ(ierr); 2612 } 2613 recompute_zerodiag = PETSC_FALSE; 2614 2615 /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */ 2616 zerodiag_subs = NULL; 2617 benign_n = 0; 2618 n_interior_dofs = 0; 2619 interior_dofs = NULL; 2620 nneu = 0; 2621 if (pcbddc->NeumannBoundariesLocal) { 2622 ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr); 2623 } 2624 checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level); 2625 if (checkb) { /* need to compute interior nodes */ 2626 PetscInt n,i,j; 2627 PetscInt n_neigh,*neigh,*n_shared,**shared; 2628 PetscInt *iwork; 2629 2630 ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr); 2631 ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 2632 ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr); 2633 ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr); 2634 for (i=1;i<n_neigh;i++) 2635 for (j=0;j<n_shared[i];j++) 2636 iwork[shared[i][j]] += 1; 2637 for (i=0;i<n;i++) 2638 if (!iwork[i]) 2639 interior_dofs[n_interior_dofs++] = i; 2640 ierr = PetscFree(iwork);CHKERRQ(ierr); 2641 ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 2642 } 2643 if (has_null_pressures) { 2644 IS *subs; 2645 PetscInt nsubs,i,j,nl; 2646 const PetscInt *idxs; 2647 PetscScalar *array; 2648 Vec *work; 2649 Mat_IS* matis = (Mat_IS*)(pc->pmat->data); 2650 2651 subs = pcbddc->local_subs; 2652 nsubs = pcbddc->n_local_subs; 2653 /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */ 2654 if (checkb) { 2655 ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr); 2656 ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr); 2657 ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr); 2658 /* work[0] = 1_p */ 2659 ierr = VecSet(work[0],0.);CHKERRQ(ierr); 2660 ierr = VecGetArray(work[0],&array);CHKERRQ(ierr); 2661 for (j=0;j<nl;j++) array[idxs[j]] = 1.; 2662 ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr); 2663 /* work[0] = 1_v */ 2664 ierr = VecSet(work[1],1.);CHKERRQ(ierr); 2665 ierr = VecGetArray(work[1],&array);CHKERRQ(ierr); 2666 for (j=0;j<nl;j++) array[idxs[j]] = 0.; 2667 ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr); 2668 ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr); 2669 } 2670 2671 if (nsubs > 1 || bsp > 1) { 2672 IS *is; 2673 PetscInt b,totb; 2674 2675 totb = bsp; 2676 is = bsp > 1 ? bzerodiag : &zerodiag; 2677 nsubs = PetscMax(nsubs,1); 2678 ierr = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr); 2679 for (b=0;b<totb;b++) { 2680 for (i=0;i<nsubs;i++) { 2681 ISLocalToGlobalMapping l2g; 2682 IS t_zerodiag_subs; 2683 PetscInt nl; 2684 2685 if (subs) { 2686 ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr); 2687 } else { 2688 IS tis; 2689 2690 ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr); 2691 ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr); 2692 ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr); 2693 ierr = ISDestroy(&tis);CHKERRQ(ierr); 2694 } 2695 ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr); 2696 ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr); 2697 if (nl) { 2698 PetscBool valid = PETSC_TRUE; 2699 2700 if (checkb) { 2701 ierr = VecSet(matis->x,0);CHKERRQ(ierr); 2702 ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr); 2703 ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr); 2704 ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr); 2705 for (j=0;j<nl;j++) array[idxs[j]] = 1.; 2706 ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr); 2707 ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr); 2708 ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr); 2709 ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr); 2710 ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr); 2711 ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr); 2712 for (j=0;j<n_interior_dofs;j++) { 2713 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) { 2714 valid = PETSC_FALSE; 2715 break; 2716 } 2717 } 2718 ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr); 2719 } 2720 if (valid && nneu) { 2721 const PetscInt *idxs; 2722 PetscInt nzb; 2723 2724 ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 2725 ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr); 2726 ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 2727 if (nzb) valid = PETSC_FALSE; 2728 } 2729 if (valid && pressures) { 2730 IS t_pressure_subs,tmp; 2731 PetscInt i1,i2; 2732 2733 ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr); 2734 ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr); 2735 ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr); 2736 ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr); 2737 if (i2 != i1) valid = PETSC_FALSE; 2738 ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr); 2739 ierr = ISDestroy(&tmp);CHKERRQ(ierr); 2740 } 2741 if (valid) { 2742 ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr); 2743 benign_n++; 2744 } else recompute_zerodiag = PETSC_TRUE; 2745 } 2746 ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr); 2747 ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr); 2748 } 2749 } 2750 } else { /* there's just one subdomain (or zero if they have not been detected */ 2751 PetscBool valid = PETSC_TRUE; 2752 2753 if (nneu) valid = PETSC_FALSE; 2754 if (valid && pressures) { 2755 ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr); 2756 } 2757 if (valid && checkb) { 2758 ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr); 2759 ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr); 2760 ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr); 2761 for (j=0;j<n_interior_dofs;j++) { 2762 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) { 2763 valid = PETSC_FALSE; 2764 break; 2765 } 2766 } 2767 ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr); 2768 } 2769 if (valid) { 2770 benign_n = 1; 2771 ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr); 2772 ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr); 2773 zerodiag_subs[0] = zerodiag; 2774 } 2775 } 2776 if (checkb) { 2777 ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr); 2778 } 2779 } 2780 ierr = PetscFree(interior_dofs);CHKERRQ(ierr); 2781 2782 if (!benign_n) { 2783 PetscInt n; 2784 2785 ierr = ISDestroy(&zerodiag);CHKERRQ(ierr); 2786 recompute_zerodiag = PETSC_FALSE; 2787 ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr); 2788 if (n) have_null = PETSC_FALSE; 2789 } 2790 2791 /* final check for null pressures */ 2792 if (zerodiag && pressures) { 2793 ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr); 2794 } 2795 2796 if (recompute_zerodiag) { 2797 ierr = ISDestroy(&zerodiag);CHKERRQ(ierr); 2798 if (benign_n == 1) { 2799 ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr); 2800 zerodiag = zerodiag_subs[0]; 2801 } else { 2802 PetscInt i,nzn,*new_idxs; 2803 2804 nzn = 0; 2805 for (i=0;i<benign_n;i++) { 2806 PetscInt ns; 2807 ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr); 2808 nzn += ns; 2809 } 2810 ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr); 2811 nzn = 0; 2812 for (i=0;i<benign_n;i++) { 2813 PetscInt ns,*idxs; 2814 ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr); 2815 ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 2816 ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr); 2817 ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 2818 nzn += ns; 2819 } 2820 ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr); 2821 ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr); 2822 } 2823 have_null = PETSC_FALSE; 2824 } 2825 2826 /* determines if the coarse solver will be singular or not */ 2827 ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 2828 2829 /* Prepare matrix to compute no-net-flux */ 2830 if (pcbddc->compute_nonetflux && !pcbddc->divudotp) { 2831 Mat A,loc_divudotp; 2832 ISLocalToGlobalMapping rl2g,cl2g,l2gmap; 2833 IS row,col,isused = NULL; 2834 PetscInt M,N,n,st,n_isused; 2835 2836 if (pressures) { 2837 isused = pressures; 2838 } else { 2839 isused = zerodiag_save; 2840 } 2841 ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr); 2842 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2843 ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr); 2844 if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field"); 2845 n_isused = 0; 2846 if (isused) { 2847 ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr); 2848 } 2849 ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 2850 st = st-n_isused; 2851 if (n) { 2852 const PetscInt *gidxs; 2853 2854 ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr); 2855 ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr); 2856 /* TODO: extend ISCreateStride with st = PETSC_DECIDE */ 2857 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr); 2858 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr); 2859 ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr); 2860 } else { 2861 ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr); 2862 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr); 2863 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr); 2864 } 2865 ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr); 2866 ierr = ISGetSize(row,&M);CHKERRQ(ierr); 2867 ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr); 2868 ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr); 2869 ierr = ISDestroy(&row);CHKERRQ(ierr); 2870 ierr = ISDestroy(&col);CHKERRQ(ierr); 2871 ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr); 2872 ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr); 2873 ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); 2874 ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr); 2875 ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr); 2876 ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr); 2877 ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr); 2878 ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr); 2879 ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2880 ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2881 } 2882 ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr); 2883 ierr = ISDestroy(&pressures);CHKERRQ(ierr); 2884 if (bzerodiag) { 2885 PetscInt i; 2886 2887 for (i=0;i<bsp;i++) { 2888 ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr); 2889 } 2890 ierr = PetscFree(bzerodiag);CHKERRQ(ierr); 2891 } 2892 pcbddc->benign_n = benign_n; 2893 pcbddc->benign_zerodiag_subs = zerodiag_subs; 2894 2895 /* determines if the problem has subdomains with 0 pressure block */ 2896 have_null = (PetscBool)(!!pcbddc->benign_n); 2897 ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 2898 2899 project_b0: 2900 ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr); 2901 /* change of basis and p0 dofs */ 2902 if (pcbddc->benign_n) { 2903 PetscInt i,s,*nnz; 2904 2905 /* local change of basis for pressures */ 2906 ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr); 2907 ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr); 2908 ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr); 2909 ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); 2910 ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr); 2911 for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */ 2912 for (i=0;i<pcbddc->benign_n;i++) { 2913 const PetscInt *idxs; 2914 PetscInt nzs,j; 2915 2916 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr); 2917 ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 2918 for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */ 2919 nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */ 2920 ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 2921 } 2922 ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr); 2923 ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2924 ierr = PetscFree(nnz);CHKERRQ(ierr); 2925 /* set identity by default */ 2926 for (i=0;i<n;i++) { 2927 ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr); 2928 } 2929 ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr); 2930 ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr); 2931 /* set change on pressures */ 2932 for (s=0;s<pcbddc->benign_n;s++) { 2933 PetscScalar *array; 2934 const PetscInt *idxs; 2935 PetscInt nzs; 2936 2937 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr); 2938 ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr); 2939 for (i=0;i<nzs-1;i++) { 2940 PetscScalar vals[2]; 2941 PetscInt cols[2]; 2942 2943 cols[0] = idxs[i]; 2944 cols[1] = idxs[nzs-1]; 2945 vals[0] = 1.; 2946 vals[1] = 1.; 2947 ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr); 2948 } 2949 ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr); 2950 for (i=0;i<nzs-1;i++) array[i] = -1.; 2951 array[nzs-1] = 1.; 2952 ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr); 2953 /* store local idxs for p0 */ 2954 pcbddc->benign_p0_lidx[s] = idxs[nzs-1]; 2955 ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr); 2956 ierr = PetscFree(array);CHKERRQ(ierr); 2957 } 2958 ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2959 ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2960 2961 /* project if needed */ 2962 if (pcbddc->benign_change_explicit) { 2963 Mat M; 2964 2965 ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr); 2966 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 2967 ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr); 2968 ierr = MatDestroy(&M);CHKERRQ(ierr); 2969 } 2970 /* store global idxs for p0 */ 2971 ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr); 2972 } 2973 *zerodiaglocal = zerodiag; 2974 PetscFunctionReturn(0); 2975 } 2976 2977 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get) 2978 { 2979 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2980 PetscScalar *array; 2981 PetscErrorCode ierr; 2982 2983 PetscFunctionBegin; 2984 if (!pcbddc->benign_sf) { 2985 ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr); 2986 ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr); 2987 } 2988 if (get) { 2989 ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr); 2990 ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr); 2991 ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr); 2992 ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr); 2993 } else { 2994 ierr = VecGetArray(v,&array);CHKERRQ(ierr); 2995 ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr); 2996 ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr); 2997 ierr = VecRestoreArray(v,&array);CHKERRQ(ierr); 2998 } 2999 PetscFunctionReturn(0); 3000 } 3001 3002 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop) 3003 { 3004 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3005 PetscErrorCode ierr; 3006 3007 PetscFunctionBegin; 3008 /* TODO: add error checking 3009 - avoid nested pop (or push) calls. 3010 - cannot push before pop. 3011 - cannot call this if pcbddc->local_mat is NULL 3012 */ 3013 if (!pcbddc->benign_n) { 3014 PetscFunctionReturn(0); 3015 } 3016 if (pop) { 3017 if (pcbddc->benign_change_explicit) { 3018 IS is_p0; 3019 MatReuse reuse; 3020 3021 /* extract B_0 */ 3022 reuse = MAT_INITIAL_MATRIX; 3023 if (pcbddc->benign_B0) { 3024 reuse = MAT_REUSE_MATRIX; 3025 } 3026 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr); 3027 ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr); 3028 /* remove rows and cols from local problem */ 3029 ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr); 3030 ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 3031 ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr); 3032 ierr = ISDestroy(&is_p0);CHKERRQ(ierr); 3033 } else { 3034 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3035 PetscScalar *vals; 3036 PetscInt i,n,*idxs_ins; 3037 3038 ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr); 3039 ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr); 3040 if (!pcbddc->benign_B0) { 3041 PetscInt *nnz; 3042 ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr); 3043 ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr); 3044 ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); 3045 ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr); 3046 for (i=0;i<pcbddc->benign_n;i++) { 3047 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr); 3048 nnz[i] = n - nnz[i]; 3049 } 3050 ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr); 3051 ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 3052 ierr = PetscFree(nnz);CHKERRQ(ierr); 3053 } 3054 3055 for (i=0;i<pcbddc->benign_n;i++) { 3056 PetscScalar *array; 3057 PetscInt *idxs,j,nz,cum; 3058 3059 ierr = VecSet(matis->x,0.);CHKERRQ(ierr); 3060 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 3061 ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 3062 for (j=0;j<nz;j++) vals[j] = 1.; 3063 ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 3064 ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr); 3065 ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr); 3066 ierr = VecSet(matis->y,0.);CHKERRQ(ierr); 3067 ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr); 3068 ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr); 3069 cum = 0; 3070 for (j=0;j<n;j++) { 3071 if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) { 3072 vals[cum] = array[j]; 3073 idxs_ins[cum] = j; 3074 cum++; 3075 } 3076 } 3077 ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr); 3078 ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr); 3079 ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 3080 } 3081 ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3082 ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3083 ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr); 3084 } 3085 } else { /* push */ 3086 if (pcbddc->benign_change_explicit) { 3087 PetscInt i; 3088 3089 for (i=0;i<pcbddc->benign_n;i++) { 3090 PetscScalar *B0_vals; 3091 PetscInt *B0_cols,B0_ncol; 3092 3093 ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr); 3094 ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr); 3095 ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr); 3096 ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr); 3097 ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr); 3098 } 3099 ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3100 ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3101 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!"); 3102 } 3103 PetscFunctionReturn(0); 3104 } 3105 3106 PetscErrorCode PCBDDCAdaptiveSelection(PC pc) 3107 { 3108 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3109 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 3110 PetscBLASInt B_dummyint,B_neigs,B_ierr,B_lwork; 3111 PetscBLASInt *B_iwork,*B_ifail; 3112 PetscScalar *work,lwork; 3113 PetscScalar *St,*S,*eigv; 3114 PetscScalar *Sarray,*Starray; 3115 PetscReal *eigs,thresh,lthresh,uthresh; 3116 PetscInt i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs; 3117 PetscBool allocated_S_St; 3118 #if defined(PETSC_USE_COMPLEX) 3119 PetscReal *rwork; 3120 #endif 3121 PetscErrorCode ierr; 3122 3123 PetscFunctionBegin; 3124 if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data"); 3125 if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO"); 3126 if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef); 3127 ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 3128 3129 if (pcbddc->dbg_flag) { 3130 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 3131 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3132 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr); 3133 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 3134 } 3135 3136 if (pcbddc->dbg_flag) { 3137 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr); 3138 } 3139 3140 /* max size of subsets */ 3141 mss = 0; 3142 for (i=0;i<sub_schurs->n_subs;i++) { 3143 PetscInt subset_size; 3144 3145 ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr); 3146 mss = PetscMax(mss,subset_size); 3147 } 3148 3149 /* min/max and threshold */ 3150 nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss; 3151 nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0; 3152 nmax = PetscMax(nmin,nmax); 3153 allocated_S_St = PETSC_FALSE; 3154 if (nmin || !sub_schurs->is_posdef) { /* XXX */ 3155 allocated_S_St = PETSC_TRUE; 3156 } 3157 3158 /* allocate lapack workspace */ 3159 cum = cum2 = 0; 3160 maxneigs = 0; 3161 for (i=0;i<sub_schurs->n_subs;i++) { 3162 PetscInt n,subset_size; 3163 3164 ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr); 3165 n = PetscMin(subset_size,nmax); 3166 cum += subset_size; 3167 cum2 += subset_size*n; 3168 maxneigs = PetscMax(maxneigs,n); 3169 } 3170 if (mss) { 3171 if (sub_schurs->is_symmetric) { 3172 PetscBLASInt B_itype = 1; 3173 PetscBLASInt B_N = mss; 3174 PetscReal zero = 0.0; 3175 PetscReal eps = 0.0; /* dlamch? */ 3176 3177 B_lwork = -1; 3178 S = NULL; 3179 St = NULL; 3180 eigs = NULL; 3181 eigv = NULL; 3182 B_iwork = NULL; 3183 B_ifail = NULL; 3184 #if defined(PETSC_USE_COMPLEX) 3185 rwork = NULL; 3186 #endif 3187 thresh = 1.0; 3188 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 3189 #if defined(PETSC_USE_COMPLEX) 3190 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3191 #else 3192 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3193 #endif 3194 if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr); 3195 ierr = PetscFPTrapPop();CHKERRQ(ierr); 3196 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented"); 3197 } else { 3198 lwork = 0; 3199 } 3200 3201 nv = 0; 3202 if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */ 3203 ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr); 3204 } 3205 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr); 3206 if (allocated_S_St) { 3207 ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr); 3208 } 3209 ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr); 3210 #if defined(PETSC_USE_COMPLEX) 3211 ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr); 3212 #endif 3213 ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n, 3214 nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr, 3215 nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr, 3216 nv+cum,&pcbddc->adaptive_constraints_idxs, 3217 nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr); 3218 ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr); 3219 3220 maxneigs = 0; 3221 cum = cumarray = 0; 3222 pcbddc->adaptive_constraints_idxs_ptr[0] = 0; 3223 pcbddc->adaptive_constraints_data_ptr[0] = 0; 3224 if (sub_schurs->is_vertices && pcbddc->use_vertices) { 3225 const PetscInt *idxs; 3226 3227 ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr); 3228 for (cum=0;cum<nv;cum++) { 3229 pcbddc->adaptive_constraints_n[cum] = 1; 3230 pcbddc->adaptive_constraints_idxs[cum] = idxs[cum]; 3231 pcbddc->adaptive_constraints_data[cum] = 1.0; 3232 pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1; 3233 pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1; 3234 } 3235 ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr); 3236 } 3237 3238 if (mss) { /* multilevel */ 3239 ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr); 3240 ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr); 3241 } 3242 3243 lthresh = pcbddc->adaptive_threshold[0]; 3244 uthresh = pcbddc->adaptive_threshold[1]; 3245 for (i=0;i<sub_schurs->n_subs;i++) { 3246 const PetscInt *idxs; 3247 PetscReal upper,lower; 3248 PetscInt j,subset_size,eigs_start = 0; 3249 PetscBLASInt B_N; 3250 PetscBool same_data = PETSC_FALSE; 3251 PetscBool scal = PETSC_FALSE; 3252 3253 if (pcbddc->use_deluxe_scaling) { 3254 upper = PETSC_MAX_REAL; 3255 lower = uthresh; 3256 } else { 3257 if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling"); 3258 upper = 1./uthresh; 3259 lower = 0.; 3260 } 3261 ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr); 3262 ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr); 3263 ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr); 3264 /* this is experimental: we assume the dofs have been properly grouped to have 3265 the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */ 3266 if (!sub_schurs->is_posdef) { 3267 Mat T; 3268 3269 for (j=0;j<subset_size;j++) { 3270 if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) { 3271 ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr); 3272 ierr = MatScale(T,-1.0);CHKERRQ(ierr); 3273 ierr = MatDestroy(&T);CHKERRQ(ierr); 3274 ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr); 3275 ierr = MatScale(T,-1.0);CHKERRQ(ierr); 3276 ierr = MatDestroy(&T);CHKERRQ(ierr); 3277 if (sub_schurs->change_primal_sub) { 3278 PetscInt nz,k; 3279 const PetscInt *idxs; 3280 3281 ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr); 3282 ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr); 3283 for (k=0;k<nz;k++) { 3284 *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0; 3285 *(Starray + cumarray + idxs[k]*(subset_size+1)) = 0.0; 3286 } 3287 ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr); 3288 } 3289 scal = PETSC_TRUE; 3290 break; 3291 } 3292 } 3293 } 3294 3295 if (allocated_S_St) { /* S and S_t should be copied since we could need them later */ 3296 if (sub_schurs->is_symmetric) { 3297 PetscInt j,k; 3298 if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */ 3299 ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3300 ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3301 } 3302 for (j=0;j<subset_size;j++) { 3303 for (k=j;k<subset_size;k++) { 3304 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k]; 3305 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k]; 3306 } 3307 } 3308 } else { 3309 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3310 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3311 } 3312 } else { 3313 S = Sarray + cumarray; 3314 St = Starray + cumarray; 3315 } 3316 /* see if we can save some work */ 3317 if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) { 3318 ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr); 3319 } 3320 3321 if (same_data && !sub_schurs->change) { /* there's no need of constraints here */ 3322 B_neigs = 0; 3323 } else { 3324 if (sub_schurs->is_symmetric) { 3325 PetscBLASInt B_itype = 1; 3326 PetscBLASInt B_IL, B_IU; 3327 PetscReal eps = -1.0; /* dlamch? */ 3328 PetscInt nmin_s; 3329 PetscBool compute_range; 3330 3331 B_neigs = 0; 3332 compute_range = (PetscBool)!same_data; 3333 if (nmin >= subset_size) compute_range = PETSC_FALSE; 3334 3335 if (pcbddc->dbg_flag) { 3336 PetscInt nc = 0; 3337 3338 if (sub_schurs->change_primal_sub) { 3339 ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr); 3340 } 3341 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr); 3342 } 3343 3344 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 3345 if (compute_range) { 3346 3347 /* ask for eigenvalues larger than thresh */ 3348 if (sub_schurs->is_posdef) { 3349 #if defined(PETSC_USE_COMPLEX) 3350 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3351 #else 3352 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3353 #endif 3354 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3355 } else { /* no theory so far, but it works nicely */ 3356 PetscInt recipe = 0,recipe_m = 1; 3357 PetscReal bb[2]; 3358 3359 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr); 3360 switch (recipe) { 3361 case 0: 3362 if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; } 3363 else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; } 3364 #if defined(PETSC_USE_COMPLEX) 3365 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3366 #else 3367 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3368 #endif 3369 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3370 break; 3371 case 1: 3372 bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh; 3373 #if defined(PETSC_USE_COMPLEX) 3374 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3375 #else 3376 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3377 #endif 3378 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3379 if (!scal) { 3380 PetscBLASInt B_neigs2 = 0; 3381 3382 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL; 3383 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3384 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3385 #if defined(PETSC_USE_COMPLEX) 3386 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3387 #else 3388 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3389 #endif 3390 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3391 B_neigs += B_neigs2; 3392 } 3393 break; 3394 case 2: 3395 if (scal) { 3396 bb[0] = PETSC_MIN_REAL; 3397 bb[1] = 0; 3398 #if defined(PETSC_USE_COMPLEX) 3399 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3400 #else 3401 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3402 #endif 3403 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3404 } else { 3405 PetscBLASInt B_neigs2 = 0; 3406 PetscBool import = PETSC_FALSE; 3407 3408 lthresh = PetscMax(lthresh,0.0); 3409 if (lthresh > 0.0) { 3410 bb[0] = PETSC_MIN_REAL; 3411 bb[1] = lthresh*lthresh; 3412 3413 import = PETSC_TRUE; 3414 #if defined(PETSC_USE_COMPLEX) 3415 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3416 #else 3417 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3418 #endif 3419 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3420 } 3421 bb[0] = PetscMax(lthresh*lthresh,uthresh); 3422 bb[1] = PETSC_MAX_REAL; 3423 if (import) { 3424 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3425 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3426 } 3427 #if defined(PETSC_USE_COMPLEX) 3428 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3429 #else 3430 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3431 #endif 3432 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3433 B_neigs += B_neigs2; 3434 } 3435 break; 3436 case 3: 3437 if (scal) { 3438 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr); 3439 } else { 3440 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr); 3441 } 3442 if (!scal) { 3443 bb[0] = uthresh; 3444 bb[1] = PETSC_MAX_REAL; 3445 #if defined(PETSC_USE_COMPLEX) 3446 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3447 #else 3448 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3449 #endif 3450 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3451 } 3452 if (recipe_m > 0 && B_N - B_neigs > 0) { 3453 PetscBLASInt B_neigs2 = 0; 3454 3455 B_IL = 1; 3456 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr); 3457 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3458 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3459 #if defined(PETSC_USE_COMPLEX) 3460 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3461 #else 3462 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3463 #endif 3464 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3465 B_neigs += B_neigs2; 3466 } 3467 break; 3468 case 4: 3469 bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; 3470 #if defined(PETSC_USE_COMPLEX) 3471 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3472 #else 3473 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3474 #endif 3475 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3476 { 3477 PetscBLASInt B_neigs2 = 0; 3478 3479 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL; 3480 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3481 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3482 #if defined(PETSC_USE_COMPLEX) 3483 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3484 #else 3485 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3486 #endif 3487 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3488 B_neigs += B_neigs2; 3489 } 3490 break; 3491 case 5: /* same as before: first compute all eigenvalues, then filter */ 3492 #if defined(PETSC_USE_COMPLEX) 3493 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3494 #else 3495 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3496 #endif 3497 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3498 { 3499 PetscInt e,k,ne; 3500 for (e=0,ne=0;e<B_neigs;e++) { 3501 if (eigs[e] < lthresh || eigs[e] > uthresh) { 3502 for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k]; 3503 eigs[ne] = eigs[e]; 3504 ne++; 3505 } 3506 } 3507 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr); 3508 B_neigs = ne; 3509 } 3510 break; 3511 default: 3512 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe); 3513 break; 3514 } 3515 } 3516 } else if (!same_data) { /* this is just to see all the eigenvalues */ 3517 B_IU = PetscMax(1,PetscMin(B_N,nmax)); 3518 B_IL = 1; 3519 #if defined(PETSC_USE_COMPLEX) 3520 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3521 #else 3522 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3523 #endif 3524 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3525 } else { /* same_data is true, so just get the adaptive functional requested by the user */ 3526 PetscInt k; 3527 if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen"); 3528 ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr); 3529 ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr); 3530 nmin = nmax; 3531 ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr); 3532 for (k=0;k<nmax;k++) { 3533 eigs[k] = 1./PETSC_SMALL; 3534 eigv[k*(subset_size+1)] = 1.0; 3535 } 3536 } 3537 ierr = PetscFPTrapPop();CHKERRQ(ierr); 3538 if (B_ierr) { 3539 if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr); 3540 else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr); 3541 else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1); 3542 } 3543 3544 if (B_neigs > nmax) { 3545 if (pcbddc->dbg_flag) { 3546 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr); 3547 } 3548 if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax; 3549 B_neigs = nmax; 3550 } 3551 3552 nmin_s = PetscMin(nmin,B_N); 3553 if (B_neigs < nmin_s) { 3554 PetscBLASInt B_neigs2 = 0; 3555 3556 if (pcbddc->use_deluxe_scaling) { 3557 if (scal) { 3558 B_IU = nmin_s; 3559 B_IL = B_neigs + 1; 3560 } else { 3561 B_IL = B_N - nmin_s + 1; 3562 B_IU = B_N - B_neigs; 3563 } 3564 } else { 3565 B_IL = B_neigs + 1; 3566 B_IU = nmin_s; 3567 } 3568 if (pcbddc->dbg_flag) { 3569 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," found %d eigs, less than minimum required %D. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);CHKERRQ(ierr); 3570 } 3571 if (sub_schurs->is_symmetric) { 3572 PetscInt j,k; 3573 for (j=0;j<subset_size;j++) { 3574 for (k=j;k<subset_size;k++) { 3575 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k]; 3576 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k]; 3577 } 3578 } 3579 } else { 3580 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3581 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3582 } 3583 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 3584 #if defined(PETSC_USE_COMPLEX) 3585 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr)); 3586 #else 3587 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr)); 3588 #endif 3589 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3590 ierr = PetscFPTrapPop();CHKERRQ(ierr); 3591 B_neigs += B_neigs2; 3592 } 3593 if (B_ierr) { 3594 if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr); 3595 else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr); 3596 else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1); 3597 } 3598 if (pcbddc->dbg_flag) { 3599 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," -> Got %d eigs\n",B_neigs);CHKERRQ(ierr); 3600 for (j=0;j<B_neigs;j++) { 3601 if (eigs[j] == 0.0) { 3602 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," Inf\n");CHKERRQ(ierr); 3603 } else { 3604 if (pcbddc->use_deluxe_scaling) { 3605 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr); 3606 } else { 3607 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr); 3608 } 3609 } 3610 } 3611 } 3612 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented"); 3613 } 3614 /* change the basis back to the original one */ 3615 if (sub_schurs->change) { 3616 Mat change,phi,phit; 3617 3618 if (pcbddc->dbg_flag > 2) { 3619 PetscInt ii; 3620 for (ii=0;ii<B_neigs;ii++) { 3621 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr); 3622 for (j=0;j<B_N;j++) { 3623 #if defined(PETSC_USE_COMPLEX) 3624 PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]); 3625 PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]); 3626 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr); 3627 #else 3628 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr); 3629 #endif 3630 } 3631 } 3632 } 3633 ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr); 3634 ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr); 3635 ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr); 3636 ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 3637 ierr = MatDestroy(&phit);CHKERRQ(ierr); 3638 ierr = MatDestroy(&phi);CHKERRQ(ierr); 3639 } 3640 maxneigs = PetscMax(B_neigs,maxneigs); 3641 pcbddc->adaptive_constraints_n[i+nv] = B_neigs; 3642 if (B_neigs) { 3643 ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3644 3645 if (pcbddc->dbg_flag > 1) { 3646 PetscInt ii; 3647 for (ii=0;ii<B_neigs;ii++) { 3648 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr); 3649 for (j=0;j<B_N;j++) { 3650 #if defined(PETSC_USE_COMPLEX) 3651 PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]); 3652 PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]); 3653 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr); 3654 #else 3655 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr); 3656 #endif 3657 } 3658 } 3659 } 3660 ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr); 3661 pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size; 3662 pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs; 3663 cum++; 3664 } 3665 ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr); 3666 /* shift for next computation */ 3667 cumarray += subset_size*subset_size; 3668 } 3669 if (pcbddc->dbg_flag) { 3670 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 3671 } 3672 3673 if (mss) { 3674 ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr); 3675 ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr); 3676 /* destroy matrices (junk) */ 3677 ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr); 3678 ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr); 3679 } 3680 if (allocated_S_St) { 3681 ierr = PetscFree2(S,St);CHKERRQ(ierr); 3682 } 3683 ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr); 3684 #if defined(PETSC_USE_COMPLEX) 3685 ierr = PetscFree(rwork);CHKERRQ(ierr); 3686 #endif 3687 if (pcbddc->dbg_flag) { 3688 PetscInt maxneigs_r; 3689 ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 3690 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr); 3691 } 3692 ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 3693 PetscFunctionReturn(0); 3694 } 3695 3696 PetscErrorCode PCBDDCSetUpSolvers(PC pc) 3697 { 3698 PetscScalar *coarse_submat_vals; 3699 PetscErrorCode ierr; 3700 3701 PetscFunctionBegin; 3702 /* Setup local scatters R_to_B and (optionally) R_to_D */ 3703 /* PCBDDCSetUpLocalWorkVectors should be called first! */ 3704 ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr); 3705 3706 /* Setup local neumann solver ksp_R */ 3707 /* PCBDDCSetUpLocalScatters should be called first! */ 3708 ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 3709 3710 /* 3711 Setup local correction and local part of coarse basis. 3712 Gives back the dense local part of the coarse matrix in column major ordering 3713 */ 3714 ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr); 3715 3716 /* Compute total number of coarse nodes and setup coarse solver */ 3717 ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr); 3718 3719 /* free */ 3720 ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr); 3721 PetscFunctionReturn(0); 3722 } 3723 3724 PetscErrorCode PCBDDCResetCustomization(PC pc) 3725 { 3726 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3727 PetscErrorCode ierr; 3728 3729 PetscFunctionBegin; 3730 ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr); 3731 ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 3732 ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 3733 ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr); 3734 ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 3735 ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr); 3736 ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr); 3737 ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr); 3738 ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr); 3739 ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr); 3740 PetscFunctionReturn(0); 3741 } 3742 3743 PetscErrorCode PCBDDCResetTopography(PC pc) 3744 { 3745 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3746 PetscInt i; 3747 PetscErrorCode ierr; 3748 3749 PetscFunctionBegin; 3750 ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr); 3751 ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr); 3752 ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr); 3753 ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr); 3754 ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 3755 ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr); 3756 ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr); 3757 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 3758 ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr); 3759 ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr); 3760 ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr); 3761 for (i=0;i<pcbddc->n_local_subs;i++) { 3762 ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr); 3763 } 3764 pcbddc->n_local_subs = 0; 3765 ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr); 3766 ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr); 3767 pcbddc->graphanalyzed = PETSC_FALSE; 3768 pcbddc->recompute_topography = PETSC_TRUE; 3769 pcbddc->corner_selected = PETSC_FALSE; 3770 PetscFunctionReturn(0); 3771 } 3772 3773 PetscErrorCode PCBDDCResetSolvers(PC pc) 3774 { 3775 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3776 PetscErrorCode ierr; 3777 3778 PetscFunctionBegin; 3779 ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 3780 if (pcbddc->coarse_phi_B) { 3781 PetscScalar *array; 3782 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr); 3783 ierr = PetscFree(array);CHKERRQ(ierr); 3784 } 3785 ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 3786 ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 3787 ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr); 3788 ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr); 3789 ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 3790 ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 3791 ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 3792 ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 3793 ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 3794 ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 3795 ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr); 3796 ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 3797 ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 3798 ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 3799 ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr); 3800 ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr); 3801 ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr); 3802 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 3803 ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 3804 ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr); 3805 ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr); 3806 ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr); 3807 ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr); 3808 ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr); 3809 ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr); 3810 ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr); 3811 ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr); 3812 if (pcbddc->benign_zerodiag_subs) { 3813 PetscInt i; 3814 for (i=0;i<pcbddc->benign_n;i++) { 3815 ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr); 3816 } 3817 ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr); 3818 } 3819 ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr); 3820 PetscFunctionReturn(0); 3821 } 3822 3823 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc) 3824 { 3825 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3826 PC_IS *pcis = (PC_IS*)pc->data; 3827 VecType impVecType; 3828 PetscInt n_constraints,n_R,old_size; 3829 PetscErrorCode ierr; 3830 3831 PetscFunctionBegin; 3832 n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices; 3833 n_R = pcis->n - pcbddc->n_vertices; 3834 ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr); 3835 /* local work vectors (try to avoid unneeded work)*/ 3836 /* R nodes */ 3837 old_size = -1; 3838 if (pcbddc->vec1_R) { 3839 ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr); 3840 } 3841 if (n_R != old_size) { 3842 ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 3843 ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 3844 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr); 3845 ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr); 3846 ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr); 3847 ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr); 3848 } 3849 /* local primal dofs */ 3850 old_size = -1; 3851 if (pcbddc->vec1_P) { 3852 ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr); 3853 } 3854 if (pcbddc->local_primal_size != old_size) { 3855 ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 3856 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr); 3857 ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr); 3858 ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr); 3859 } 3860 /* local explicit constraints */ 3861 old_size = -1; 3862 if (pcbddc->vec1_C) { 3863 ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr); 3864 } 3865 if (n_constraints && n_constraints != old_size) { 3866 ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 3867 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr); 3868 ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr); 3869 ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr); 3870 } 3871 PetscFunctionReturn(0); 3872 } 3873 3874 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n) 3875 { 3876 PetscErrorCode ierr; 3877 /* pointers to pcis and pcbddc */ 3878 PC_IS* pcis = (PC_IS*)pc->data; 3879 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3880 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 3881 /* submatrices of local problem */ 3882 Mat A_RV,A_VR,A_VV,local_auxmat2_R; 3883 /* submatrices of local coarse problem */ 3884 Mat S_VV,S_CV,S_VC,S_CC; 3885 /* working matrices */ 3886 Mat C_CR; 3887 /* additional working stuff */ 3888 PC pc_R; 3889 Mat F,Brhs = NULL; 3890 Vec dummy_vec; 3891 PetscBool isLU,isCHOL,isILU,need_benign_correction,sparserhs; 3892 PetscScalar *coarse_submat_vals; /* TODO: use a PETSc matrix */ 3893 PetscScalar *work; 3894 PetscInt *idx_V_B; 3895 PetscInt lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I; 3896 PetscInt i,n_R,n_D,n_B; 3897 3898 /* some shortcuts to scalars */ 3899 PetscScalar one=1.0,m_one=-1.0; 3900 3901 PetscFunctionBegin; 3902 if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented"); 3903 ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 3904 3905 /* Set Non-overlapping dimensions */ 3906 n_vertices = pcbddc->n_vertices; 3907 n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices; 3908 n_B = pcis->n_B; 3909 n_D = pcis->n - n_B; 3910 n_R = pcis->n - n_vertices; 3911 3912 /* vertices in boundary numbering */ 3913 ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr); 3914 ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr); 3915 if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i); 3916 3917 /* Subdomain contribution (Non-overlapping) to coarse matrix */ 3918 ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr); 3919 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr); 3920 ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr); 3921 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr); 3922 ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr); 3923 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr); 3924 ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr); 3925 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr); 3926 ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr); 3927 3928 /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */ 3929 ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr); 3930 ierr = PCSetUp(pc_R);CHKERRQ(ierr); 3931 ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr); 3932 ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr); 3933 ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr); 3934 lda_rhs = n_R; 3935 need_benign_correction = PETSC_FALSE; 3936 if (isLU || isILU || isCHOL) { 3937 ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr); 3938 } else if (sub_schurs && sub_schurs->reuse_solver) { 3939 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 3940 MatFactorType type; 3941 3942 F = reuse_solver->F; 3943 ierr = MatGetFactorType(F,&type);CHKERRQ(ierr); 3944 if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE; 3945 ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr); 3946 need_benign_correction = (PetscBool)(!!reuse_solver->benign_n); 3947 } else { 3948 F = NULL; 3949 } 3950 3951 /* determine if we can use a sparse right-hand side */ 3952 sparserhs = PETSC_FALSE; 3953 if (F) { 3954 MatSolverType solver; 3955 3956 ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr); 3957 ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr); 3958 } 3959 3960 /* allocate workspace */ 3961 n = 0; 3962 if (n_constraints) { 3963 n += lda_rhs*n_constraints; 3964 } 3965 if (n_vertices) { 3966 n = PetscMax(2*lda_rhs*n_vertices,n); 3967 n = PetscMax((lda_rhs+n_B)*n_vertices,n); 3968 } 3969 if (!pcbddc->symmetric_primal) { 3970 n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n); 3971 } 3972 ierr = PetscMalloc1(n,&work);CHKERRQ(ierr); 3973 3974 /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */ 3975 dummy_vec = NULL; 3976 if (need_benign_correction && lda_rhs != n_R && F) { 3977 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr); 3978 ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr); 3979 ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr); 3980 } 3981 3982 /* Precompute stuffs needed for preprocessing and application of BDDC*/ 3983 if (n_constraints) { 3984 Mat M3,C_B; 3985 IS is_aux; 3986 PetscScalar *array,*array2; 3987 3988 ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 3989 ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 3990 3991 /* Extract constraints on R nodes: C_{CR} */ 3992 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr); 3993 ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr); 3994 ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr); 3995 3996 /* Assemble local_auxmat2_R = (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */ 3997 /* Assemble pcbddc->local_auxmat2 = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */ 3998 if (!sparserhs) { 3999 ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr); 4000 for (i=0;i<n_constraints;i++) { 4001 const PetscScalar *row_cmat_values; 4002 const PetscInt *row_cmat_indices; 4003 PetscInt size_of_constraint,j; 4004 4005 ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr); 4006 for (j=0;j<size_of_constraint;j++) { 4007 work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j]; 4008 } 4009 ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr); 4010 } 4011 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr); 4012 } else { 4013 Mat tC_CR; 4014 4015 ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr); 4016 if (lda_rhs != n_R) { 4017 PetscScalar *aa; 4018 PetscInt r,*ii,*jj; 4019 PetscBool done; 4020 4021 ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4022 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed"); 4023 ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr); 4024 ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr); 4025 ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4026 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed"); 4027 } else { 4028 ierr = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr); 4029 tC_CR = C_CR; 4030 } 4031 ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr); 4032 ierr = MatDestroy(&tC_CR);CHKERRQ(ierr); 4033 } 4034 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr); 4035 if (F) { 4036 if (need_benign_correction) { 4037 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4038 4039 /* rhs is already zero on interior dofs, no need to change the rhs */ 4040 ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr); 4041 } 4042 ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr); 4043 if (need_benign_correction) { 4044 PetscScalar *marr; 4045 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4046 4047 ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4048 if (lda_rhs != n_R) { 4049 for (i=0;i<n_constraints;i++) { 4050 ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr); 4051 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4052 ierr = VecResetArray(dummy_vec);CHKERRQ(ierr); 4053 } 4054 } else { 4055 for (i=0;i<n_constraints;i++) { 4056 ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr); 4057 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4058 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4059 } 4060 } 4061 ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4062 } 4063 } else { 4064 PetscScalar *marr; 4065 4066 ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4067 for (i=0;i<n_constraints;i++) { 4068 ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr); 4069 ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr); 4070 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4071 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4072 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4073 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4074 } 4075 ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4076 } 4077 if (sparserhs) { 4078 ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr); 4079 } 4080 ierr = MatDestroy(&Brhs);CHKERRQ(ierr); 4081 if (!pcbddc->switch_static) { 4082 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr); 4083 ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr); 4084 ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr); 4085 for (i=0;i<n_constraints;i++) { 4086 ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr); 4087 ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr); 4088 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4089 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4090 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4091 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4092 } 4093 ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr); 4094 ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr); 4095 ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr); 4096 } else { 4097 if (lda_rhs != n_R) { 4098 IS dummy; 4099 4100 ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr); 4101 ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr); 4102 ierr = ISDestroy(&dummy);CHKERRQ(ierr); 4103 } else { 4104 ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr); 4105 pcbddc->local_auxmat2 = local_auxmat2_R; 4106 } 4107 ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr); 4108 } 4109 ierr = ISDestroy(&is_aux);CHKERRQ(ierr); 4110 /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} */ 4111 ierr = MatScale(M3,m_one);CHKERRQ(ierr); 4112 if (isCHOL) { 4113 ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr); 4114 } else { 4115 ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr); 4116 } 4117 ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr); 4118 /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */ 4119 ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr); 4120 ierr = MatDestroy(&C_B);CHKERRQ(ierr); 4121 ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */ 4122 ierr = MatDestroy(&M3);CHKERRQ(ierr); 4123 } 4124 4125 /* Get submatrices from subdomain matrix */ 4126 if (n_vertices) { 4127 IS is_aux; 4128 PetscBool isseqaij; 4129 4130 if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */ 4131 IS tis; 4132 4133 ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr); 4134 ierr = ISSort(tis);CHKERRQ(ierr); 4135 ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr); 4136 ierr = ISDestroy(&tis);CHKERRQ(ierr); 4137 } else { 4138 ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr); 4139 } 4140 ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr); 4141 ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr); 4142 ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 4143 if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */ 4144 ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr); 4145 } 4146 ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr); 4147 ierr = ISDestroy(&is_aux);CHKERRQ(ierr); 4148 } 4149 4150 /* Matrix of coarse basis functions (local) */ 4151 if (pcbddc->coarse_phi_B) { 4152 PetscInt on_B,on_primal,on_D=n_D; 4153 if (pcbddc->coarse_phi_D) { 4154 ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr); 4155 } 4156 ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr); 4157 if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) { 4158 PetscScalar *marray; 4159 4160 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr); 4161 ierr = PetscFree(marray);CHKERRQ(ierr); 4162 ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 4163 ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr); 4164 ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 4165 ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr); 4166 } 4167 } 4168 4169 if (!pcbddc->coarse_phi_B) { 4170 PetscScalar *marr; 4171 4172 /* memory size */ 4173 n = n_B*pcbddc->local_primal_size; 4174 if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size; 4175 if (!pcbddc->symmetric_primal) n *= 2; 4176 ierr = PetscCalloc1(n,&marr);CHKERRQ(ierr); 4177 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr); 4178 marr += n_B*pcbddc->local_primal_size; 4179 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4180 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr); 4181 marr += n_D*pcbddc->local_primal_size; 4182 } 4183 if (!pcbddc->symmetric_primal) { 4184 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr); 4185 marr += n_B*pcbddc->local_primal_size; 4186 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4187 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr); 4188 } 4189 } else { 4190 ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr); 4191 pcbddc->coarse_psi_B = pcbddc->coarse_phi_B; 4192 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4193 ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr); 4194 pcbddc->coarse_psi_D = pcbddc->coarse_phi_D; 4195 } 4196 } 4197 } 4198 4199 /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */ 4200 p0_lidx_I = NULL; 4201 if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) { 4202 const PetscInt *idxs; 4203 4204 ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 4205 ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr); 4206 for (i=0;i<pcbddc->benign_n;i++) { 4207 ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr); 4208 } 4209 ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 4210 } 4211 4212 /* vertices */ 4213 if (n_vertices) { 4214 PetscBool restoreavr = PETSC_FALSE; 4215 4216 ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr); 4217 4218 if (n_R) { 4219 Mat A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */ 4220 PetscBLASInt B_N,B_one = 1; 4221 PetscScalar *x,*y; 4222 4223 ierr = MatScale(A_RV,m_one);CHKERRQ(ierr); 4224 if (need_benign_correction) { 4225 ISLocalToGlobalMapping RtoN; 4226 IS is_p0; 4227 PetscInt *idxs_p0,n; 4228 4229 ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr); 4230 ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr); 4231 ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr); 4232 if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n); 4233 ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr); 4234 ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr); 4235 ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr); 4236 ierr = ISDestroy(&is_p0);CHKERRQ(ierr); 4237 } 4238 4239 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr); 4240 if (!sparserhs || need_benign_correction) { 4241 if (lda_rhs == n_R) { 4242 ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr); 4243 } else { 4244 PetscScalar *av,*array; 4245 const PetscInt *xadj,*adjncy; 4246 PetscInt n; 4247 PetscBool flg_row; 4248 4249 array = work+lda_rhs*n_vertices; 4250 ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr); 4251 ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr); 4252 ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4253 ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr); 4254 for (i=0;i<n;i++) { 4255 PetscInt j; 4256 for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j]; 4257 } 4258 ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4259 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 4260 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr); 4261 } 4262 if (need_benign_correction) { 4263 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4264 PetscScalar *marr; 4265 4266 ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr); 4267 /* need \Phi^T A_RV = (I+L)A_RV, L given by 4268 4269 | 0 0 0 | (V) 4270 L = | 0 0 -1 | (P-p0) 4271 | 0 0 -1 | (p0) 4272 4273 */ 4274 for (i=0;i<reuse_solver->benign_n;i++) { 4275 const PetscScalar *vals; 4276 const PetscInt *idxs,*idxs_zero; 4277 PetscInt n,j,nz; 4278 4279 ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 4280 ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4281 ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4282 for (j=0;j<n;j++) { 4283 PetscScalar val = vals[j]; 4284 PetscInt k,col = idxs[j]; 4285 for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val; 4286 } 4287 ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4288 ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4289 } 4290 ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr); 4291 } 4292 ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr); 4293 Brhs = A_RV; 4294 } else { 4295 Mat tA_RVT,A_RVT; 4296 4297 if (!pcbddc->symmetric_primal) { 4298 /* A_RV already scaled by -1 */ 4299 ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr); 4300 } else { 4301 restoreavr = PETSC_TRUE; 4302 ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr); 4303 ierr = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr); 4304 A_RVT = A_VR; 4305 } 4306 if (lda_rhs != n_R) { 4307 PetscScalar *aa; 4308 PetscInt r,*ii,*jj; 4309 PetscBool done; 4310 4311 ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4312 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed"); 4313 ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr); 4314 ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr); 4315 ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4316 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed"); 4317 } else { 4318 ierr = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr); 4319 tA_RVT = A_RVT; 4320 } 4321 ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr); 4322 ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr); 4323 ierr = MatDestroy(&A_RVT);CHKERRQ(ierr); 4324 } 4325 if (F) { 4326 /* need to correct the rhs */ 4327 if (need_benign_correction) { 4328 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4329 PetscScalar *marr; 4330 4331 ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr); 4332 if (lda_rhs != n_R) { 4333 for (i=0;i<n_vertices;i++) { 4334 ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr); 4335 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 4336 ierr = VecResetArray(dummy_vec);CHKERRQ(ierr); 4337 } 4338 } else { 4339 for (i=0;i<n_vertices;i++) { 4340 ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr); 4341 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 4342 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4343 } 4344 } 4345 ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr); 4346 } 4347 ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr); 4348 if (restoreavr) { 4349 ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr); 4350 } 4351 /* need to correct the solution */ 4352 if (need_benign_correction) { 4353 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4354 PetscScalar *marr; 4355 4356 ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr); 4357 if (lda_rhs != n_R) { 4358 for (i=0;i<n_vertices;i++) { 4359 ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr); 4360 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4361 ierr = VecResetArray(dummy_vec);CHKERRQ(ierr); 4362 } 4363 } else { 4364 for (i=0;i<n_vertices;i++) { 4365 ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr); 4366 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4367 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4368 } 4369 } 4370 ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr); 4371 } 4372 } else { 4373 ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr); 4374 for (i=0;i<n_vertices;i++) { 4375 ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr); 4376 ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr); 4377 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4378 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4379 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4380 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4381 } 4382 ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr); 4383 } 4384 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 4385 ierr = MatDestroy(&Brhs);CHKERRQ(ierr); 4386 /* S_VV and S_CV */ 4387 if (n_constraints) { 4388 Mat B; 4389 4390 ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr); 4391 for (i=0;i<n_vertices;i++) { 4392 ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr); 4393 ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr); 4394 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4395 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4396 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4397 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4398 } 4399 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr); 4400 ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr); 4401 ierr = MatDestroy(&B);CHKERRQ(ierr); 4402 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr); 4403 ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr); 4404 ierr = MatScale(S_CV,m_one);CHKERRQ(ierr); 4405 ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr); 4406 PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one)); 4407 ierr = MatDestroy(&B);CHKERRQ(ierr); 4408 } 4409 if (lda_rhs != n_R) { 4410 ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr); 4411 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr); 4412 ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr); 4413 } 4414 ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr); 4415 /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */ 4416 if (need_benign_correction) { 4417 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4418 PetscScalar *marr,*sums; 4419 4420 ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr); 4421 ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr); 4422 for (i=0;i<reuse_solver->benign_n;i++) { 4423 const PetscScalar *vals; 4424 const PetscInt *idxs,*idxs_zero; 4425 PetscInt n,j,nz; 4426 4427 ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 4428 ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4429 for (j=0;j<n_vertices;j++) { 4430 PetscInt k; 4431 sums[j] = 0.; 4432 for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs]; 4433 } 4434 ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4435 for (j=0;j<n;j++) { 4436 PetscScalar val = vals[j]; 4437 PetscInt k; 4438 for (k=0;k<n_vertices;k++) { 4439 marr[idxs[j]+k*n_vertices] += val*sums[k]; 4440 } 4441 } 4442 ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4443 ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4444 } 4445 ierr = PetscFree(sums);CHKERRQ(ierr); 4446 ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr); 4447 ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr); 4448 } 4449 ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr); 4450 ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr); 4451 ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr); 4452 ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr); 4453 PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one)); 4454 ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr); 4455 ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr); 4456 ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 4457 ierr = MatDestroy(&S_VVt);CHKERRQ(ierr); 4458 } else { 4459 ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 4460 } 4461 ierr = MatDestroy(&A_VV);CHKERRQ(ierr); 4462 4463 /* coarse basis functions */ 4464 for (i=0;i<n_vertices;i++) { 4465 PetscScalar *y; 4466 4467 ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr); 4468 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4469 ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr); 4470 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4471 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4472 y[n_B*i+idx_V_B[i]] = 1.0; 4473 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4474 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4475 4476 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4477 PetscInt j; 4478 4479 ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4480 ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr); 4481 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4482 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4483 ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr); 4484 for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0; 4485 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4486 } 4487 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4488 } 4489 /* if n_R == 0 the object is not destroyed */ 4490 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 4491 } 4492 ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr); 4493 4494 if (n_constraints) { 4495 Mat B; 4496 4497 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr); 4498 ierr = MatScale(S_CC,m_one);CHKERRQ(ierr); 4499 ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr); 4500 ierr = MatScale(S_CC,m_one);CHKERRQ(ierr); 4501 if (n_vertices) { 4502 if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */ 4503 ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr); 4504 } else { 4505 Mat S_VCt; 4506 4507 if (lda_rhs != n_R) { 4508 ierr = MatDestroy(&B);CHKERRQ(ierr); 4509 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr); 4510 ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr); 4511 } 4512 ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr); 4513 ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 4514 ierr = MatDestroy(&S_VCt);CHKERRQ(ierr); 4515 } 4516 } 4517 ierr = MatDestroy(&B);CHKERRQ(ierr); 4518 /* coarse basis functions */ 4519 for (i=0;i<n_constraints;i++) { 4520 PetscScalar *y; 4521 4522 ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr); 4523 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4524 ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr); 4525 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4526 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4527 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4528 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4529 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4530 PetscInt j; 4531 4532 ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4533 ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr); 4534 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4535 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4536 ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr); 4537 for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0; 4538 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4539 } 4540 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4541 } 4542 } 4543 if (n_constraints) { 4544 ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr); 4545 } 4546 ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr); 4547 4548 /* coarse matrix entries relative to B_0 */ 4549 if (pcbddc->benign_n) { 4550 Mat B0_B,B0_BPHI; 4551 IS is_dummy; 4552 PetscScalar *data; 4553 PetscInt j; 4554 4555 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr); 4556 ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr); 4557 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 4558 ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr); 4559 ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr); 4560 ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr); 4561 for (j=0;j<pcbddc->benign_n;j++) { 4562 PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j; 4563 for (i=0;i<pcbddc->local_primal_size;i++) { 4564 coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j]; 4565 coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j]; 4566 } 4567 } 4568 ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr); 4569 ierr = MatDestroy(&B0_B);CHKERRQ(ierr); 4570 ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr); 4571 } 4572 4573 /* compute other basis functions for non-symmetric problems */ 4574 if (!pcbddc->symmetric_primal) { 4575 Mat B_V=NULL,B_C=NULL; 4576 PetscScalar *marray; 4577 4578 if (n_constraints) { 4579 Mat S_CCT,C_CRT; 4580 4581 ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr); 4582 ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr); 4583 ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr); 4584 ierr = MatDestroy(&S_CCT);CHKERRQ(ierr); 4585 if (n_vertices) { 4586 Mat S_VCT; 4587 4588 ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr); 4589 ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr); 4590 ierr = MatDestroy(&S_VCT);CHKERRQ(ierr); 4591 } 4592 ierr = MatDestroy(&C_CRT);CHKERRQ(ierr); 4593 } else { 4594 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr); 4595 } 4596 if (n_vertices && n_R) { 4597 PetscScalar *av,*marray; 4598 const PetscInt *xadj,*adjncy; 4599 PetscInt n; 4600 PetscBool flg_row; 4601 4602 /* B_V = B_V - A_VR^T */ 4603 ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr); 4604 ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4605 ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr); 4606 ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr); 4607 for (i=0;i<n;i++) { 4608 PetscInt j; 4609 for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j]; 4610 } 4611 ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr); 4612 ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4613 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 4614 } 4615 4616 /* currently there's no support for MatTransposeMatSolve(F,B,X) */ 4617 if (n_vertices) { 4618 ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr); 4619 for (i=0;i<n_vertices;i++) { 4620 ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr); 4621 ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr); 4622 ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4623 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4624 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4625 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4626 } 4627 ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr); 4628 } 4629 if (B_C) { 4630 ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr); 4631 for (i=n_vertices;i<n_constraints+n_vertices;i++) { 4632 ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr); 4633 ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr); 4634 ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4635 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4636 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4637 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4638 } 4639 ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr); 4640 } 4641 /* coarse basis functions */ 4642 for (i=0;i<pcbddc->local_primal_size;i++) { 4643 PetscScalar *y; 4644 4645 ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr); 4646 ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr); 4647 ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr); 4648 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4649 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4650 if (i<n_vertices) { 4651 y[n_B*i+idx_V_B[i]] = 1.0; 4652 } 4653 ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr); 4654 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4655 4656 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4657 ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr); 4658 ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr); 4659 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4660 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4661 ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr); 4662 ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr); 4663 } 4664 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4665 } 4666 ierr = MatDestroy(&B_V);CHKERRQ(ierr); 4667 ierr = MatDestroy(&B_C);CHKERRQ(ierr); 4668 } 4669 4670 /* free memory */ 4671 ierr = PetscFree(idx_V_B);CHKERRQ(ierr); 4672 ierr = MatDestroy(&S_VV);CHKERRQ(ierr); 4673 ierr = MatDestroy(&S_CV);CHKERRQ(ierr); 4674 ierr = MatDestroy(&S_VC);CHKERRQ(ierr); 4675 ierr = MatDestroy(&S_CC);CHKERRQ(ierr); 4676 ierr = PetscFree(work);CHKERRQ(ierr); 4677 if (n_vertices) { 4678 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 4679 } 4680 if (n_constraints) { 4681 ierr = MatDestroy(&C_CR);CHKERRQ(ierr); 4682 } 4683 /* Checking coarse_sub_mat and coarse basis functios */ 4684 /* Symmetric case : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 4685 /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 4686 if (pcbddc->dbg_flag) { 4687 Mat coarse_sub_mat; 4688 Mat AUXMAT,TM1,TM2,TM3,TM4; 4689 Mat coarse_phi_D,coarse_phi_B; 4690 Mat coarse_psi_D,coarse_psi_B; 4691 Mat A_II,A_BB,A_IB,A_BI; 4692 Mat C_B,CPHI; 4693 IS is_dummy; 4694 Vec mones; 4695 MatType checkmattype=MATSEQAIJ; 4696 PetscReal real_value; 4697 4698 if (pcbddc->benign_n && !pcbddc->benign_change_explicit) { 4699 Mat A; 4700 ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr); 4701 ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 4702 ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 4703 ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 4704 ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 4705 ierr = MatDestroy(&A);CHKERRQ(ierr); 4706 } else { 4707 ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 4708 ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 4709 ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 4710 ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 4711 } 4712 ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr); 4713 ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr); 4714 if (!pcbddc->symmetric_primal) { 4715 ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr); 4716 ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr); 4717 } 4718 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr); 4719 4720 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 4721 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr); 4722 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 4723 if (!pcbddc->symmetric_primal) { 4724 ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4725 ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 4726 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4727 ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4728 ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 4729 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4730 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4731 ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 4732 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4733 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4734 ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 4735 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4736 } else { 4737 ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 4738 ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 4739 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4740 ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 4741 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4742 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4743 ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 4744 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4745 } 4746 ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4747 ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4748 ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4749 ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr); 4750 if (pcbddc->benign_n) { 4751 Mat B0_B,B0_BPHI; 4752 PetscScalar *data,*data2; 4753 PetscInt j; 4754 4755 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr); 4756 ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr); 4757 ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr); 4758 ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr); 4759 ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr); 4760 ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr); 4761 for (j=0;j<pcbddc->benign_n;j++) { 4762 PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j; 4763 for (i=0;i<pcbddc->local_primal_size;i++) { 4764 data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j]; 4765 data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j]; 4766 } 4767 } 4768 ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr); 4769 ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr); 4770 ierr = MatDestroy(&B0_B);CHKERRQ(ierr); 4771 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 4772 ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr); 4773 } 4774 #if 0 4775 { 4776 PetscViewer viewer; 4777 char filename[256]; 4778 sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level); 4779 ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr); 4780 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 4781 ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr); 4782 ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr); 4783 ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr); 4784 ierr = MatView(TM1,viewer);CHKERRQ(ierr); 4785 if (pcbddc->coarse_phi_B) { 4786 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr); 4787 ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr); 4788 } 4789 if (pcbddc->coarse_phi_D) { 4790 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr); 4791 ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr); 4792 } 4793 if (pcbddc->coarse_psi_B) { 4794 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr); 4795 ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr); 4796 } 4797 if (pcbddc->coarse_psi_D) { 4798 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr); 4799 ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr); 4800 } 4801 ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr); 4802 ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr); 4803 ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr); 4804 ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr); 4805 ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr); 4806 ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr); 4807 ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr); 4808 ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr); 4809 ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr); 4810 ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr); 4811 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 4812 } 4813 #endif 4814 ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4815 ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr); 4816 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 4817 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr); 4818 4819 /* check constraints */ 4820 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr); 4821 ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr); 4822 if (!pcbddc->benign_n) { /* TODO: add benign case */ 4823 ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr); 4824 } else { 4825 PetscScalar *data; 4826 Mat tmat; 4827 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr); 4828 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr); 4829 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr); 4830 ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr); 4831 ierr = MatDestroy(&tmat);CHKERRQ(ierr); 4832 } 4833 ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr); 4834 ierr = VecSet(mones,-1.0);CHKERRQ(ierr); 4835 ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr); 4836 ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr); 4837 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr); 4838 if (!pcbddc->symmetric_primal) { 4839 ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr); 4840 ierr = VecSet(mones,-1.0);CHKERRQ(ierr); 4841 ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr); 4842 ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr); 4843 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr); 4844 } 4845 ierr = MatDestroy(&C_B);CHKERRQ(ierr); 4846 ierr = MatDestroy(&CPHI);CHKERRQ(ierr); 4847 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 4848 ierr = VecDestroy(&mones);CHKERRQ(ierr); 4849 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 4850 ierr = MatDestroy(&A_II);CHKERRQ(ierr); 4851 ierr = MatDestroy(&A_BB);CHKERRQ(ierr); 4852 ierr = MatDestroy(&A_IB);CHKERRQ(ierr); 4853 ierr = MatDestroy(&A_BI);CHKERRQ(ierr); 4854 ierr = MatDestroy(&TM1);CHKERRQ(ierr); 4855 ierr = MatDestroy(&TM2);CHKERRQ(ierr); 4856 ierr = MatDestroy(&TM3);CHKERRQ(ierr); 4857 ierr = MatDestroy(&TM4);CHKERRQ(ierr); 4858 ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr); 4859 ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr); 4860 if (!pcbddc->symmetric_primal) { 4861 ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr); 4862 ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr); 4863 } 4864 ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr); 4865 } 4866 /* get back data */ 4867 *coarse_submat_vals_n = coarse_submat_vals; 4868 ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 4869 PetscFunctionReturn(0); 4870 } 4871 4872 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B) 4873 { 4874 Mat *work_mat; 4875 IS isrow_s,iscol_s; 4876 PetscBool rsorted,csorted; 4877 PetscInt rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL; 4878 PetscErrorCode ierr; 4879 4880 PetscFunctionBegin; 4881 ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr); 4882 ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr); 4883 ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr); 4884 ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr); 4885 4886 if (!rsorted) { 4887 const PetscInt *idxs; 4888 PetscInt *idxs_sorted,i; 4889 4890 ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr); 4891 ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr); 4892 for (i=0;i<rsize;i++) { 4893 idxs_perm_r[i] = i; 4894 } 4895 ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr); 4896 ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr); 4897 for (i=0;i<rsize;i++) { 4898 idxs_sorted[i] = idxs[idxs_perm_r[i]]; 4899 } 4900 ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr); 4901 ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr); 4902 } else { 4903 ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr); 4904 isrow_s = isrow; 4905 } 4906 4907 if (!csorted) { 4908 if (isrow == iscol) { 4909 ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr); 4910 iscol_s = isrow_s; 4911 } else { 4912 const PetscInt *idxs; 4913 PetscInt *idxs_sorted,i; 4914 4915 ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr); 4916 ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr); 4917 for (i=0;i<csize;i++) { 4918 idxs_perm_c[i] = i; 4919 } 4920 ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr); 4921 ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr); 4922 for (i=0;i<csize;i++) { 4923 idxs_sorted[i] = idxs[idxs_perm_c[i]]; 4924 } 4925 ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr); 4926 ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr); 4927 } 4928 } else { 4929 ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr); 4930 iscol_s = iscol; 4931 } 4932 4933 ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr); 4934 4935 if (!rsorted || !csorted) { 4936 Mat new_mat; 4937 IS is_perm_r,is_perm_c; 4938 4939 if (!rsorted) { 4940 PetscInt *idxs_r,i; 4941 ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr); 4942 for (i=0;i<rsize;i++) { 4943 idxs_r[idxs_perm_r[i]] = i; 4944 } 4945 ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr); 4946 ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr); 4947 } else { 4948 ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr); 4949 } 4950 ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr); 4951 4952 if (!csorted) { 4953 if (isrow_s == iscol_s) { 4954 ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr); 4955 is_perm_c = is_perm_r; 4956 } else { 4957 PetscInt *idxs_c,i; 4958 if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present"); 4959 ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr); 4960 for (i=0;i<csize;i++) { 4961 idxs_c[idxs_perm_c[i]] = i; 4962 } 4963 ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr); 4964 ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr); 4965 } 4966 } else { 4967 ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr); 4968 } 4969 ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr); 4970 4971 ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr); 4972 ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr); 4973 work_mat[0] = new_mat; 4974 ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr); 4975 ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr); 4976 } 4977 4978 ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr); 4979 *B = work_mat[0]; 4980 ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr); 4981 ierr = ISDestroy(&isrow_s);CHKERRQ(ierr); 4982 ierr = ISDestroy(&iscol_s);CHKERRQ(ierr); 4983 PetscFunctionReturn(0); 4984 } 4985 4986 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix) 4987 { 4988 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 4989 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 4990 Mat new_mat,lA; 4991 IS is_local,is_global; 4992 PetscInt local_size; 4993 PetscBool isseqaij; 4994 PetscErrorCode ierr; 4995 4996 PetscFunctionBegin; 4997 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 4998 ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr); 4999 ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr); 5000 ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr); 5001 ierr = ISDestroy(&is_local);CHKERRQ(ierr); 5002 ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr); 5003 ierr = ISDestroy(&is_global);CHKERRQ(ierr); 5004 5005 /* check */ 5006 if (pcbddc->dbg_flag) { 5007 Vec x,x_change; 5008 PetscReal error; 5009 5010 ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr); 5011 ierr = VecSetRandom(x,NULL);CHKERRQ(ierr); 5012 ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr); 5013 ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5014 ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5015 ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr); 5016 if (!pcbddc->change_interior) { 5017 const PetscScalar *x,*y,*v; 5018 PetscReal lerror = 0.; 5019 PetscInt i; 5020 5021 ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr); 5022 ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr); 5023 ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr); 5024 for (i=0;i<local_size;i++) 5025 if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror) 5026 lerror = PetscAbsScalar(x[i]-y[i]); 5027 ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr); 5028 ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr); 5029 ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr); 5030 ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 5031 if (error > PETSC_SMALL) { 5032 if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) { 5033 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error); 5034 } else { 5035 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error); 5036 } 5037 } 5038 } 5039 ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5040 ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5041 ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr); 5042 ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr); 5043 if (error > PETSC_SMALL) { 5044 if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) { 5045 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error); 5046 } else { 5047 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error); 5048 } 5049 } 5050 ierr = VecDestroy(&x);CHKERRQ(ierr); 5051 ierr = VecDestroy(&x_change);CHKERRQ(ierr); 5052 } 5053 5054 /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */ 5055 ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr); 5056 5057 /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */ 5058 ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 5059 if (isseqaij) { 5060 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5061 ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr); 5062 if (lA) { 5063 Mat work; 5064 ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr); 5065 ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr); 5066 ierr = MatDestroy(&work);CHKERRQ(ierr); 5067 } 5068 } else { 5069 Mat work_mat; 5070 5071 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5072 ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr); 5073 ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr); 5074 ierr = MatDestroy(&work_mat);CHKERRQ(ierr); 5075 if (lA) { 5076 Mat work; 5077 ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr); 5078 ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr); 5079 ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr); 5080 ierr = MatDestroy(&work);CHKERRQ(ierr); 5081 } 5082 } 5083 if (matis->A->symmetric_set) { 5084 ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr); 5085 #if !defined(PETSC_USE_COMPLEX) 5086 ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr); 5087 #endif 5088 } 5089 ierr = MatDestroy(&new_mat);CHKERRQ(ierr); 5090 PetscFunctionReturn(0); 5091 } 5092 5093 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc) 5094 { 5095 PC_IS* pcis = (PC_IS*)(pc->data); 5096 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 5097 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5098 PetscInt *idx_R_local=NULL; 5099 PetscInt n_vertices,i,j,n_R,n_D,n_B; 5100 PetscInt vbs,bs; 5101 PetscBT bitmask=NULL; 5102 PetscErrorCode ierr; 5103 5104 PetscFunctionBegin; 5105 /* 5106 No need to setup local scatters if 5107 - primal space is unchanged 5108 AND 5109 - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains) 5110 AND 5111 - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine 5112 */ 5113 if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) { 5114 PetscFunctionReturn(0); 5115 } 5116 /* destroy old objects */ 5117 ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr); 5118 ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 5119 ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 5120 /* Set Non-overlapping dimensions */ 5121 n_B = pcis->n_B; 5122 n_D = pcis->n - n_B; 5123 n_vertices = pcbddc->n_vertices; 5124 5125 /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */ 5126 5127 /* create auxiliary bitmask and allocate workspace */ 5128 if (!sub_schurs || !sub_schurs->reuse_solver) { 5129 ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr); 5130 ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr); 5131 for (i=0;i<n_vertices;i++) { 5132 ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr); 5133 } 5134 5135 for (i=0, n_R=0; i<pcis->n; i++) { 5136 if (!PetscBTLookup(bitmask,i)) { 5137 idx_R_local[n_R++] = i; 5138 } 5139 } 5140 } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */ 5141 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5142 5143 ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5144 ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr); 5145 } 5146 5147 /* Block code */ 5148 vbs = 1; 5149 ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr); 5150 if (bs>1 && !(n_vertices%bs)) { 5151 PetscBool is_blocked = PETSC_TRUE; 5152 PetscInt *vary; 5153 if (!sub_schurs || !sub_schurs->reuse_solver) { 5154 ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr); 5155 ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr); 5156 /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */ 5157 /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */ 5158 for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++; 5159 for (i=0; i<pcis->n/bs; i++) { 5160 if (vary[i]!=0 && vary[i]!=bs) { 5161 is_blocked = PETSC_FALSE; 5162 break; 5163 } 5164 } 5165 ierr = PetscFree(vary);CHKERRQ(ierr); 5166 } else { 5167 /* Verify directly the R set */ 5168 for (i=0; i<n_R/bs; i++) { 5169 PetscInt j,node=idx_R_local[bs*i]; 5170 for (j=1; j<bs; j++) { 5171 if (node != idx_R_local[bs*i+j]-j) { 5172 is_blocked = PETSC_FALSE; 5173 break; 5174 } 5175 } 5176 } 5177 } 5178 if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */ 5179 vbs = bs; 5180 for (i=0;i<n_R/vbs;i++) { 5181 idx_R_local[i] = idx_R_local[vbs*i]/vbs; 5182 } 5183 } 5184 } 5185 ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr); 5186 if (sub_schurs && sub_schurs->reuse_solver) { 5187 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5188 5189 ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5190 ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr); 5191 ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr); 5192 reuse_solver->is_R = pcbddc->is_R_local; 5193 } else { 5194 ierr = PetscFree(idx_R_local);CHKERRQ(ierr); 5195 } 5196 5197 /* print some info if requested */ 5198 if (pcbddc->dbg_flag) { 5199 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 5200 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5201 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 5202 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr); 5203 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr); 5204 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %D, v_size = %D, constraints = %D, local_primal_size = %D\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr); 5205 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5206 } 5207 5208 /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */ 5209 if (!sub_schurs || !sub_schurs->reuse_solver) { 5210 IS is_aux1,is_aux2; 5211 PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local; 5212 5213 ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5214 ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr); 5215 ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr); 5216 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5217 for (i=0; i<n_D; i++) { 5218 ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr); 5219 } 5220 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5221 for (i=0, j=0; i<n_R; i++) { 5222 if (!PetscBTLookup(bitmask,idx_R_local[i])) { 5223 aux_array1[j++] = i; 5224 } 5225 } 5226 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr); 5227 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5228 for (i=0, j=0; i<n_B; i++) { 5229 if (!PetscBTLookup(bitmask,is_indices[i])) { 5230 aux_array2[j++] = i; 5231 } 5232 } 5233 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5234 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr); 5235 ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr); 5236 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 5237 ierr = ISDestroy(&is_aux2);CHKERRQ(ierr); 5238 5239 if (pcbddc->switch_static || pcbddc->dbg_flag) { 5240 ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr); 5241 for (i=0, j=0; i<n_R; i++) { 5242 if (PetscBTLookup(bitmask,idx_R_local[i])) { 5243 aux_array1[j++] = i; 5244 } 5245 } 5246 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr); 5247 ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 5248 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 5249 } 5250 ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr); 5251 ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5252 } else { 5253 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5254 IS tis; 5255 PetscInt schur_size; 5256 5257 ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr); 5258 ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr); 5259 ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr); 5260 ierr = ISDestroy(&tis);CHKERRQ(ierr); 5261 if (pcbddc->switch_static || pcbddc->dbg_flag) { 5262 ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr); 5263 ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 5264 ierr = ISDestroy(&tis);CHKERRQ(ierr); 5265 } 5266 } 5267 PetscFunctionReturn(0); 5268 } 5269 5270 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B) 5271 { 5272 MatNullSpace NullSpace; 5273 Mat dmat; 5274 const Vec *nullvecs; 5275 Vec v,v2,*nullvecs2; 5276 VecScatter sct; 5277 PetscInt k,nnsp_size,bsiz,n,N,bs; 5278 PetscBool nnsp_has_cnst; 5279 PetscErrorCode ierr; 5280 5281 PetscFunctionBegin; 5282 ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr); 5283 if (!NullSpace) { 5284 ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr); 5285 } 5286 if (NullSpace) PetscFunctionReturn(0); 5287 ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr); 5288 if (!NullSpace) { 5289 ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr); 5290 } 5291 if (!NullSpace) PetscFunctionReturn(0); 5292 ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr); 5293 ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr); 5294 ierr = VecScatterCreateWithData(v,is,v2,NULL,&sct);CHKERRQ(ierr); 5295 ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr); 5296 bsiz = nnsp_size+!!nnsp_has_cnst; 5297 ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr); 5298 ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr); 5299 ierr = VecGetSize(v2,&N);CHKERRQ(ierr); 5300 ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr); 5301 ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr); 5302 for (k=0;k<nnsp_size;k++) { 5303 PetscScalar *arr; 5304 5305 ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr); 5306 ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr); 5307 ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5308 ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5309 ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr); 5310 } 5311 if (nnsp_has_cnst) { 5312 PetscScalar *arr; 5313 5314 ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr); 5315 ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr); 5316 ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr); 5317 ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr); 5318 } 5319 ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr); 5320 ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr); 5321 ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr); 5322 ierr = MatDestroy(&dmat);CHKERRQ(ierr); 5323 for (k=0;k<bsiz;k++) { 5324 ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr); 5325 } 5326 ierr = PetscFree(nullvecs2);CHKERRQ(ierr); 5327 ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr); 5328 ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr); 5329 ierr = VecDestroy(&v);CHKERRQ(ierr); 5330 ierr = VecDestroy(&v2);CHKERRQ(ierr); 5331 ierr = VecScatterDestroy(&sct);CHKERRQ(ierr); 5332 PetscFunctionReturn(0); 5333 } 5334 5335 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann) 5336 { 5337 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 5338 PC_IS *pcis = (PC_IS*)pc->data; 5339 PC pc_temp; 5340 Mat A_RR; 5341 MatNullSpace nnsp; 5342 MatReuse reuse; 5343 PetscScalar m_one = -1.0; 5344 PetscReal value; 5345 PetscInt n_D,n_R; 5346 PetscBool issbaij,opts; 5347 PetscErrorCode ierr; 5348 void (*f)(void) = 0; 5349 char dir_prefix[256],neu_prefix[256],str_level[16]; 5350 size_t len; 5351 5352 PetscFunctionBegin; 5353 ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 5354 /* compute prefixes */ 5355 ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr); 5356 ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr); 5357 if (!pcbddc->current_level) { 5358 ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr); 5359 ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr); 5360 ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr); 5361 ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr); 5362 } else { 5363 ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr); 5364 ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr); 5365 len -= 15; /* remove "pc_bddc_coarse_" */ 5366 if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */ 5367 if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */ 5368 /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */ 5369 ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr); 5370 ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr); 5371 ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr); 5372 ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr); 5373 ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr); 5374 ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr); 5375 } 5376 5377 /* DIRICHLET PROBLEM */ 5378 if (dirichlet) { 5379 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5380 if (pcbddc->benign_n && !pcbddc->benign_change_explicit) { 5381 if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented"); 5382 if (pcbddc->dbg_flag) { 5383 Mat A_IIn; 5384 5385 ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr); 5386 ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr); 5387 pcis->A_II = A_IIn; 5388 } 5389 } 5390 if (pcbddc->local_mat->symmetric_set) { 5391 ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr); 5392 } 5393 /* Matrix for Dirichlet problem is pcis->A_II */ 5394 n_D = pcis->n - pcis->n_B; 5395 opts = PETSC_FALSE; 5396 if (!pcbddc->ksp_D) { /* create object if not yet build */ 5397 opts = PETSC_TRUE; 5398 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr); 5399 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr); 5400 /* default */ 5401 ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr); 5402 ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr); 5403 ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); 5404 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 5405 if (issbaij) { 5406 ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr); 5407 } else { 5408 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 5409 } 5410 ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr); 5411 } 5412 ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr); 5413 ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr); 5414 /* Allow user's customization */ 5415 if (opts) { 5416 ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr); 5417 } 5418 if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */ 5419 ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr); 5420 } 5421 ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr); 5422 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 5423 ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr); 5424 if (f && pcbddc->mat_graph->cloc && !nnsp) { 5425 PetscReal *coords = pcbddc->mat_graph->coords,*scoords; 5426 const PetscInt *idxs; 5427 PetscInt cdim = pcbddc->mat_graph->cdim,nl,i,d; 5428 5429 ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr); 5430 ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 5431 ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr); 5432 for (i=0;i<nl;i++) { 5433 for (d=0;d<cdim;d++) { 5434 scoords[i*cdim+d] = coords[idxs[i]*cdim+d]; 5435 } 5436 } 5437 ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 5438 ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr); 5439 ierr = PetscFree(scoords);CHKERRQ(ierr); 5440 } 5441 if (sub_schurs && sub_schurs->reuse_solver) { 5442 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5443 5444 ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr); 5445 } 5446 5447 /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */ 5448 if (!n_D) { 5449 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 5450 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 5451 } 5452 /* set ksp_D into pcis data */ 5453 ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr); 5454 ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr); 5455 pcis->ksp_D = pcbddc->ksp_D; 5456 } 5457 5458 /* NEUMANN PROBLEM */ 5459 A_RR = 0; 5460 if (neumann) { 5461 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5462 PetscInt ibs,mbs; 5463 PetscBool issbaij, reuse_neumann_solver; 5464 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 5465 5466 reuse_neumann_solver = PETSC_FALSE; 5467 if (sub_schurs && sub_schurs->reuse_solver) { 5468 IS iP; 5469 5470 reuse_neumann_solver = PETSC_TRUE; 5471 ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr); 5472 if (iP) reuse_neumann_solver = PETSC_FALSE; 5473 } 5474 /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */ 5475 ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr); 5476 if (pcbddc->ksp_R) { /* already created ksp */ 5477 PetscInt nn_R; 5478 ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr); 5479 ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr); 5480 ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr); 5481 if (nn_R != n_R) { /* old ksp is not reusable, so reset it */ 5482 ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr); 5483 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5484 reuse = MAT_INITIAL_MATRIX; 5485 } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */ 5486 if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */ 5487 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5488 reuse = MAT_INITIAL_MATRIX; 5489 } else { /* safe to reuse the matrix */ 5490 reuse = MAT_REUSE_MATRIX; 5491 } 5492 } 5493 /* last check */ 5494 if (pc->flag == DIFFERENT_NONZERO_PATTERN) { 5495 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5496 reuse = MAT_INITIAL_MATRIX; 5497 } 5498 } else { /* first time, so we need to create the matrix */ 5499 reuse = MAT_INITIAL_MATRIX; 5500 } 5501 /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */ 5502 ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr); 5503 ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr); 5504 ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); 5505 if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */ 5506 if (matis->A == pcbddc->local_mat) { 5507 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5508 ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5509 } else { 5510 ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5511 } 5512 } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */ 5513 if (matis->A == pcbddc->local_mat) { 5514 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5515 ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5516 } else { 5517 ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5518 } 5519 } 5520 /* extract A_RR */ 5521 if (reuse_neumann_solver) { 5522 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5523 5524 if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */ 5525 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5526 if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */ 5527 ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr); 5528 } else { 5529 ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr); 5530 } 5531 } else { 5532 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5533 ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr); 5534 ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr); 5535 } 5536 } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */ 5537 ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr); 5538 } 5539 if (pcbddc->local_mat->symmetric_set) { 5540 ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr); 5541 } 5542 opts = PETSC_FALSE; 5543 if (!pcbddc->ksp_R) { /* create object if not present */ 5544 opts = PETSC_TRUE; 5545 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr); 5546 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr); 5547 /* default */ 5548 ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr); 5549 ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr); 5550 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 5551 ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); 5552 if (issbaij) { 5553 ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr); 5554 } else { 5555 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 5556 } 5557 ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr); 5558 } 5559 ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr); 5560 ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr); 5561 if (opts) { /* Allow user's customization once */ 5562 ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr); 5563 } 5564 if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */ 5565 ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr); 5566 } 5567 ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr); 5568 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 5569 ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr); 5570 if (f && pcbddc->mat_graph->cloc && !nnsp) { 5571 PetscReal *coords = pcbddc->mat_graph->coords,*scoords; 5572 const PetscInt *idxs; 5573 PetscInt cdim = pcbddc->mat_graph->cdim,nl,i,d; 5574 5575 ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr); 5576 ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr); 5577 ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr); 5578 for (i=0;i<nl;i++) { 5579 for (d=0;d<cdim;d++) { 5580 scoords[i*cdim+d] = coords[idxs[i]*cdim+d]; 5581 } 5582 } 5583 ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr); 5584 ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr); 5585 ierr = PetscFree(scoords);CHKERRQ(ierr); 5586 } 5587 5588 /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */ 5589 if (!n_R) { 5590 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 5591 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 5592 } 5593 /* Reuse solver if it is present */ 5594 if (reuse_neumann_solver) { 5595 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5596 5597 ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr); 5598 } 5599 } 5600 5601 if (pcbddc->dbg_flag) { 5602 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5603 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 5604 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 5605 } 5606 5607 /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */ 5608 if (pcbddc->NullSpace_corr[0]) { 5609 ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr); 5610 } 5611 if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) { 5612 ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr); 5613 } 5614 if (neumann && pcbddc->NullSpace_corr[2]) { 5615 ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr); 5616 } 5617 /* check Dirichlet and Neumann solvers */ 5618 if (pcbddc->dbg_flag) { 5619 if (dirichlet) { /* Dirichlet */ 5620 ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr); 5621 ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 5622 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr); 5623 ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr); 5624 ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr); 5625 ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr); 5626 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr); 5627 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5628 } 5629 if (neumann) { /* Neumann */ 5630 ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr); 5631 ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 5632 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr); 5633 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 5634 ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr); 5635 ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr); 5636 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr); 5637 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5638 } 5639 } 5640 /* free Neumann problem's matrix */ 5641 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5642 ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 5643 PetscFunctionReturn(0); 5644 } 5645 5646 static PetscErrorCode PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose) 5647 { 5648 PetscErrorCode ierr; 5649 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5650 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5651 PetscBool reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE; 5652 5653 PetscFunctionBegin; 5654 if (!reuse_solver) { 5655 ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr); 5656 } 5657 if (!pcbddc->switch_static) { 5658 if (applytranspose && pcbddc->local_auxmat1) { 5659 ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr); 5660 ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr); 5661 } 5662 if (!reuse_solver) { 5663 ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5664 ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5665 } else { 5666 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5667 5668 ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5669 ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5670 } 5671 } else { 5672 ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5673 ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5674 ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5675 ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5676 if (applytranspose && pcbddc->local_auxmat1) { 5677 ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr); 5678 ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr); 5679 ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5680 ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5681 } 5682 } 5683 if (!reuse_solver || pcbddc->switch_static) { 5684 if (applytranspose) { 5685 ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 5686 } else { 5687 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 5688 } 5689 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr); 5690 } else { 5691 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5692 5693 if (applytranspose) { 5694 ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr); 5695 } else { 5696 ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr); 5697 } 5698 } 5699 ierr = VecSet(inout_B,0.);CHKERRQ(ierr); 5700 if (!pcbddc->switch_static) { 5701 if (!reuse_solver) { 5702 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5703 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5704 } else { 5705 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5706 5707 ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5708 ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5709 } 5710 if (!applytranspose && pcbddc->local_auxmat1) { 5711 ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr); 5712 ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr); 5713 } 5714 } else { 5715 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5716 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5717 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5718 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5719 if (!applytranspose && pcbddc->local_auxmat1) { 5720 ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr); 5721 ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 5722 } 5723 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5724 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5725 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5726 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5727 } 5728 PetscFunctionReturn(0); 5729 } 5730 5731 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */ 5732 PetscErrorCode PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose) 5733 { 5734 PetscErrorCode ierr; 5735 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5736 PC_IS* pcis = (PC_IS*) (pc->data); 5737 const PetscScalar zero = 0.0; 5738 5739 PetscFunctionBegin; 5740 /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */ 5741 if (!pcbddc->benign_apply_coarse_only) { 5742 if (applytranspose) { 5743 ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 5744 if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 5745 } else { 5746 ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 5747 if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 5748 } 5749 } else { 5750 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 5751 } 5752 5753 /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */ 5754 if (pcbddc->benign_n) { 5755 PetscScalar *array; 5756 PetscInt j; 5757 5758 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5759 for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j]; 5760 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5761 } 5762 5763 /* start communications from local primal nodes to rhs of coarse solver */ 5764 ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr); 5765 ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5766 ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5767 5768 /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */ 5769 if (pcbddc->coarse_ksp) { 5770 Mat coarse_mat; 5771 Vec rhs,sol; 5772 MatNullSpace nullsp; 5773 PetscBool isbddc = PETSC_FALSE; 5774 5775 if (pcbddc->benign_have_null) { 5776 PC coarse_pc; 5777 5778 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 5779 ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr); 5780 /* we need to propagate to coarser levels the need for a possible benign correction */ 5781 if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) { 5782 PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data); 5783 coarsepcbddc->benign_skip_correction = PETSC_FALSE; 5784 coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE; 5785 } 5786 } 5787 ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr); 5788 ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr); 5789 ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr); 5790 if (applytranspose) { 5791 if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented"); 5792 ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr); 5793 ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr); 5794 ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr); 5795 if (nullsp) { 5796 ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr); 5797 } 5798 } else { 5799 ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr); 5800 if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */ 5801 PC coarse_pc; 5802 5803 if (nullsp) { 5804 ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr); 5805 } 5806 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 5807 ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr); 5808 ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr); 5809 ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr); 5810 } else { 5811 ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr); 5812 ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr); 5813 if (nullsp) { 5814 ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr); 5815 } 5816 } 5817 } 5818 /* we don't need the benign correction at coarser levels anymore */ 5819 if (pcbddc->benign_have_null && isbddc) { 5820 PC coarse_pc; 5821 PC_BDDC* coarsepcbddc; 5822 5823 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 5824 coarsepcbddc = (PC_BDDC*)(coarse_pc->data); 5825 coarsepcbddc->benign_skip_correction = PETSC_TRUE; 5826 coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE; 5827 } 5828 } 5829 5830 /* Local solution on R nodes */ 5831 if (pcis->n && !pcbddc->benign_apply_coarse_only) { 5832 ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr); 5833 } 5834 /* communications from coarse sol to local primal nodes */ 5835 ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5836 ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5837 5838 /* Sum contributions from the two levels */ 5839 if (!pcbddc->benign_apply_coarse_only) { 5840 if (applytranspose) { 5841 ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 5842 if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 5843 } else { 5844 ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 5845 if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 5846 } 5847 /* store p0 */ 5848 if (pcbddc->benign_n) { 5849 PetscScalar *array; 5850 PetscInt j; 5851 5852 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5853 for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j]; 5854 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5855 } 5856 } else { /* expand the coarse solution */ 5857 if (applytranspose) { 5858 ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr); 5859 } else { 5860 ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr); 5861 } 5862 } 5863 PetscFunctionReturn(0); 5864 } 5865 5866 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode) 5867 { 5868 PetscErrorCode ierr; 5869 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5870 PetscScalar *array; 5871 Vec from,to; 5872 5873 PetscFunctionBegin; 5874 if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */ 5875 from = pcbddc->coarse_vec; 5876 to = pcbddc->vec1_P; 5877 if (pcbddc->coarse_ksp) { /* get array from coarse processes */ 5878 Vec tvec; 5879 5880 ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr); 5881 ierr = VecResetArray(tvec);CHKERRQ(ierr); 5882 ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr); 5883 ierr = VecGetArray(tvec,&array);CHKERRQ(ierr); 5884 ierr = VecPlaceArray(from,array);CHKERRQ(ierr); 5885 ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr); 5886 } 5887 } else { /* from local to global -> put data in coarse right hand side */ 5888 from = pcbddc->vec1_P; 5889 to = pcbddc->coarse_vec; 5890 } 5891 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr); 5892 PetscFunctionReturn(0); 5893 } 5894 5895 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode) 5896 { 5897 PetscErrorCode ierr; 5898 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5899 PetscScalar *array; 5900 Vec from,to; 5901 5902 PetscFunctionBegin; 5903 if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */ 5904 from = pcbddc->coarse_vec; 5905 to = pcbddc->vec1_P; 5906 } else { /* from local to global -> put data in coarse right hand side */ 5907 from = pcbddc->vec1_P; 5908 to = pcbddc->coarse_vec; 5909 } 5910 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr); 5911 if (smode == SCATTER_FORWARD) { 5912 if (pcbddc->coarse_ksp) { /* get array from coarse processes */ 5913 Vec tvec; 5914 5915 ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr); 5916 ierr = VecGetArray(to,&array);CHKERRQ(ierr); 5917 ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr); 5918 ierr = VecRestoreArray(to,&array);CHKERRQ(ierr); 5919 } 5920 } else { 5921 if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */ 5922 ierr = VecResetArray(from);CHKERRQ(ierr); 5923 } 5924 } 5925 PetscFunctionReturn(0); 5926 } 5927 5928 /* uncomment for testing purposes */ 5929 /* #define PETSC_MISSING_LAPACK_GESVD 1 */ 5930 PetscErrorCode PCBDDCConstraintsSetUp(PC pc) 5931 { 5932 PetscErrorCode ierr; 5933 PC_IS* pcis = (PC_IS*)(pc->data); 5934 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 5935 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 5936 /* one and zero */ 5937 PetscScalar one=1.0,zero=0.0; 5938 /* space to store constraints and their local indices */ 5939 PetscScalar *constraints_data; 5940 PetscInt *constraints_idxs,*constraints_idxs_B; 5941 PetscInt *constraints_idxs_ptr,*constraints_data_ptr; 5942 PetscInt *constraints_n; 5943 /* iterators */ 5944 PetscInt i,j,k,total_counts,total_counts_cc,cum; 5945 /* BLAS integers */ 5946 PetscBLASInt lwork,lierr; 5947 PetscBLASInt Blas_N,Blas_M,Blas_K,Blas_one=1; 5948 PetscBLASInt Blas_LDA,Blas_LDB,Blas_LDC; 5949 /* reuse */ 5950 PetscInt olocal_primal_size,olocal_primal_size_cc; 5951 PetscInt *olocal_primal_ref_node,*olocal_primal_ref_mult; 5952 /* change of basis */ 5953 PetscBool qr_needed; 5954 PetscBT change_basis,qr_needed_idx; 5955 /* auxiliary stuff */ 5956 PetscInt *nnz,*is_indices; 5957 PetscInt ncc; 5958 /* some quantities */ 5959 PetscInt n_vertices,total_primal_vertices,valid_constraints; 5960 PetscInt size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints; 5961 PetscReal tol; /* tolerance for retaining eigenmodes */ 5962 5963 PetscFunctionBegin; 5964 tol = PetscSqrtReal(PETSC_SMALL); 5965 /* Destroy Mat objects computed previously */ 5966 ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 5967 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 5968 ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr); 5969 /* save info on constraints from previous setup (if any) */ 5970 olocal_primal_size = pcbddc->local_primal_size; 5971 olocal_primal_size_cc = pcbddc->local_primal_size_cc; 5972 ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr); 5973 ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr); 5974 ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr); 5975 ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr); 5976 ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 5977 5978 if (!pcbddc->adaptive_selection) { 5979 IS ISForVertices,*ISForFaces,*ISForEdges; 5980 MatNullSpace nearnullsp; 5981 const Vec *nearnullvecs; 5982 Vec *localnearnullsp; 5983 PetscScalar *array; 5984 PetscInt n_ISForFaces,n_ISForEdges,nnsp_size; 5985 PetscBool nnsp_has_cnst; 5986 /* LAPACK working arrays for SVD or POD */ 5987 PetscBool skip_lapack,boolforchange; 5988 PetscScalar *work; 5989 PetscReal *singular_vals; 5990 #if defined(PETSC_USE_COMPLEX) 5991 PetscReal *rwork; 5992 #endif 5993 #if defined(PETSC_MISSING_LAPACK_GESVD) 5994 PetscScalar *temp_basis,*correlation_mat; 5995 #else 5996 PetscBLASInt dummy_int=1; 5997 PetscScalar dummy_scalar=1.; 5998 #endif 5999 6000 /* Get index sets for faces, edges and vertices from graph */ 6001 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr); 6002 /* print some info */ 6003 if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) { 6004 PetscInt nv; 6005 6006 ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr); 6007 ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr); 6008 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 6009 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 6010 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr); 6011 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr); 6012 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr); 6013 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 6014 ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 6015 } 6016 6017 /* free unneeded index sets */ 6018 if (!pcbddc->use_vertices) { 6019 ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr); 6020 } 6021 if (!pcbddc->use_edges) { 6022 for (i=0;i<n_ISForEdges;i++) { 6023 ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr); 6024 } 6025 ierr = PetscFree(ISForEdges);CHKERRQ(ierr); 6026 n_ISForEdges = 0; 6027 } 6028 if (!pcbddc->use_faces) { 6029 for (i=0;i<n_ISForFaces;i++) { 6030 ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr); 6031 } 6032 ierr = PetscFree(ISForFaces);CHKERRQ(ierr); 6033 n_ISForFaces = 0; 6034 } 6035 6036 /* check if near null space is attached to global mat */ 6037 ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr); 6038 if (nearnullsp) { 6039 ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr); 6040 /* remove any stored info */ 6041 ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr); 6042 ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr); 6043 /* store information for BDDC solver reuse */ 6044 ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr); 6045 pcbddc->onearnullspace = nearnullsp; 6046 ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr); 6047 for (i=0;i<nnsp_size;i++) { 6048 ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr); 6049 } 6050 } else { /* if near null space is not provided BDDC uses constants by default */ 6051 nnsp_size = 0; 6052 nnsp_has_cnst = PETSC_TRUE; 6053 } 6054 /* get max number of constraints on a single cc */ 6055 max_constraints = nnsp_size; 6056 if (nnsp_has_cnst) max_constraints++; 6057 6058 /* 6059 Evaluate maximum storage size needed by the procedure 6060 - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]" 6061 - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]" 6062 There can be multiple constraints per connected component 6063 */ 6064 n_vertices = 0; 6065 if (ISForVertices) { 6066 ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr); 6067 } 6068 ncc = n_vertices+n_ISForFaces+n_ISForEdges; 6069 ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr); 6070 6071 total_counts = n_ISForFaces+n_ISForEdges; 6072 total_counts *= max_constraints; 6073 total_counts += n_vertices; 6074 ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr); 6075 6076 total_counts = 0; 6077 max_size_of_constraint = 0; 6078 for (i=0;i<n_ISForEdges+n_ISForFaces;i++) { 6079 IS used_is; 6080 if (i<n_ISForEdges) { 6081 used_is = ISForEdges[i]; 6082 } else { 6083 used_is = ISForFaces[i-n_ISForEdges]; 6084 } 6085 ierr = ISGetSize(used_is,&j);CHKERRQ(ierr); 6086 total_counts += j; 6087 max_size_of_constraint = PetscMax(j,max_size_of_constraint); 6088 } 6089 ierr = PetscMalloc3(total_counts*max_constraints+n_vertices,&constraints_data,total_counts+n_vertices,&constraints_idxs,total_counts+n_vertices,&constraints_idxs_B);CHKERRQ(ierr); 6090 6091 /* get local part of global near null space vectors */ 6092 ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr); 6093 for (k=0;k<nnsp_size;k++) { 6094 ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 6095 ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6096 ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6097 } 6098 6099 /* whether or not to skip lapack calls */ 6100 skip_lapack = PETSC_TRUE; 6101 if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE; 6102 6103 /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */ 6104 if (!skip_lapack) { 6105 PetscScalar temp_work; 6106 6107 #if defined(PETSC_MISSING_LAPACK_GESVD) 6108 /* Proper Orthogonal Decomposition (POD) using the snapshot method */ 6109 ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr); 6110 ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr); 6111 ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr); 6112 #if defined(PETSC_USE_COMPLEX) 6113 ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr); 6114 #endif 6115 /* now we evaluate the optimal workspace using query with lwork=-1 */ 6116 ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr); 6117 ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr); 6118 lwork = -1; 6119 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6120 #if !defined(PETSC_USE_COMPLEX) 6121 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr)); 6122 #else 6123 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr)); 6124 #endif 6125 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6126 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr); 6127 #else /* on missing GESVD */ 6128 /* SVD */ 6129 PetscInt max_n,min_n; 6130 max_n = max_size_of_constraint; 6131 min_n = max_constraints; 6132 if (max_size_of_constraint < max_constraints) { 6133 min_n = max_size_of_constraint; 6134 max_n = max_constraints; 6135 } 6136 ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr); 6137 #if defined(PETSC_USE_COMPLEX) 6138 ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr); 6139 #endif 6140 /* now we evaluate the optimal workspace using query with lwork=-1 */ 6141 lwork = -1; 6142 ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr); 6143 ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr); 6144 ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr); 6145 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6146 #if !defined(PETSC_USE_COMPLEX) 6147 PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr)); 6148 #else 6149 PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr)); 6150 #endif 6151 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6152 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr); 6153 #endif /* on missing GESVD */ 6154 /* Allocate optimal workspace */ 6155 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr); 6156 ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr); 6157 } 6158 /* Now we can loop on constraining sets */ 6159 total_counts = 0; 6160 constraints_idxs_ptr[0] = 0; 6161 constraints_data_ptr[0] = 0; 6162 /* vertices */ 6163 if (n_vertices) { 6164 ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6165 ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr); 6166 for (i=0;i<n_vertices;i++) { 6167 constraints_n[total_counts] = 1; 6168 constraints_data[total_counts] = 1.0; 6169 constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1; 6170 constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1; 6171 total_counts++; 6172 } 6173 ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6174 n_vertices = total_counts; 6175 } 6176 6177 /* edges and faces */ 6178 total_counts_cc = total_counts; 6179 for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) { 6180 IS used_is; 6181 PetscBool idxs_copied = PETSC_FALSE; 6182 6183 if (ncc<n_ISForEdges) { 6184 used_is = ISForEdges[ncc]; 6185 boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */ 6186 } else { 6187 used_is = ISForFaces[ncc-n_ISForEdges]; 6188 boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */ 6189 } 6190 temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 6191 6192 ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr); 6193 ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6194 /* change of basis should not be performed on local periodic nodes */ 6195 if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE; 6196 if (nnsp_has_cnst) { 6197 PetscScalar quad_value; 6198 6199 ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr); 6200 idxs_copied = PETSC_TRUE; 6201 6202 if (!pcbddc->use_nnsp_true) { 6203 quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 6204 } else { 6205 quad_value = 1.0; 6206 } 6207 for (j=0;j<size_of_constraint;j++) { 6208 constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value; 6209 } 6210 temp_constraints++; 6211 total_counts++; 6212 } 6213 for (k=0;k<nnsp_size;k++) { 6214 PetscReal real_value; 6215 PetscScalar *ptr_to_data; 6216 6217 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 6218 ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint]; 6219 for (j=0;j<size_of_constraint;j++) { 6220 ptr_to_data[j] = array[is_indices[j]]; 6221 } 6222 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 6223 /* check if array is null on the connected component */ 6224 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6225 PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one)); 6226 if (real_value > tol*size_of_constraint) { /* keep indices and values */ 6227 temp_constraints++; 6228 total_counts++; 6229 if (!idxs_copied) { 6230 ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr); 6231 idxs_copied = PETSC_TRUE; 6232 } 6233 } 6234 } 6235 ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6236 valid_constraints = temp_constraints; 6237 if (!pcbddc->use_nnsp_true && temp_constraints) { 6238 if (temp_constraints == 1) { /* just normalize the constraint */ 6239 PetscScalar norm,*ptr_to_data; 6240 6241 ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]]; 6242 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6243 PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one)); 6244 norm = 1.0/PetscSqrtReal(PetscRealPart(norm)); 6245 PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one)); 6246 } else { /* perform SVD */ 6247 PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]]; 6248 6249 #if defined(PETSC_MISSING_LAPACK_GESVD) 6250 /* SVD: Y = U*S*V^H -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag 6251 POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2) 6252 -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined 6253 the constraints basis will differ (by a complex factor with absolute value equal to 1) 6254 from that computed using LAPACKgesvd 6255 -> This is due to a different computation of eigenvectors in LAPACKheev 6256 -> The quality of the POD-computed basis will be the same */ 6257 ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr); 6258 /* Store upper triangular part of correlation matrix */ 6259 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6260 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6261 for (j=0;j<temp_constraints;j++) { 6262 for (k=0;k<j+1;k++) { 6263 PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k] = BLASdot_(&Blas_N,ptr_to_data+k*size_of_constraint,&Blas_one,ptr_to_data+j*size_of_constraint,&Blas_one)); 6264 } 6265 } 6266 /* compute eigenvalues and eigenvectors of correlation matrix */ 6267 ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 6268 ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr); 6269 #if !defined(PETSC_USE_COMPLEX) 6270 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr)); 6271 #else 6272 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr)); 6273 #endif 6274 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6275 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr); 6276 /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */ 6277 j = 0; 6278 while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++; 6279 total_counts = total_counts-j; 6280 valid_constraints = temp_constraints-j; 6281 /* scale and copy POD basis into used quadrature memory */ 6282 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6283 ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 6284 ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr); 6285 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6286 ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr); 6287 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr); 6288 if (j<temp_constraints) { 6289 PetscInt ii; 6290 for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]); 6291 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6292 PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,ptr_to_data,&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC)); 6293 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6294 for (k=0;k<temp_constraints-j;k++) { 6295 for (ii=0;ii<size_of_constraint;ii++) { 6296 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii]; 6297 } 6298 } 6299 } 6300 #else /* on missing GESVD */ 6301 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6302 ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 6303 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6304 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6305 #if !defined(PETSC_USE_COMPLEX) 6306 PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr)); 6307 #else 6308 PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr)); 6309 #endif 6310 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr); 6311 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6312 /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */ 6313 k = temp_constraints; 6314 if (k > size_of_constraint) k = size_of_constraint; 6315 j = 0; 6316 while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++; 6317 valid_constraints = k-j; 6318 total_counts = total_counts-temp_constraints+valid_constraints; 6319 #endif /* on missing GESVD */ 6320 } 6321 } 6322 /* update pointers information */ 6323 if (valid_constraints) { 6324 constraints_n[total_counts_cc] = valid_constraints; 6325 constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint; 6326 constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints; 6327 /* set change_of_basis flag */ 6328 if (boolforchange) { 6329 PetscBTSet(change_basis,total_counts_cc); 6330 } 6331 total_counts_cc++; 6332 } 6333 } 6334 /* free workspace */ 6335 if (!skip_lapack) { 6336 ierr = PetscFree(work);CHKERRQ(ierr); 6337 #if defined(PETSC_USE_COMPLEX) 6338 ierr = PetscFree(rwork);CHKERRQ(ierr); 6339 #endif 6340 ierr = PetscFree(singular_vals);CHKERRQ(ierr); 6341 #if defined(PETSC_MISSING_LAPACK_GESVD) 6342 ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 6343 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 6344 #endif 6345 } 6346 for (k=0;k<nnsp_size;k++) { 6347 ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 6348 } 6349 ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 6350 /* free index sets of faces, edges and vertices */ 6351 for (i=0;i<n_ISForFaces;i++) { 6352 ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr); 6353 } 6354 if (n_ISForFaces) { 6355 ierr = PetscFree(ISForFaces);CHKERRQ(ierr); 6356 } 6357 for (i=0;i<n_ISForEdges;i++) { 6358 ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr); 6359 } 6360 if (n_ISForEdges) { 6361 ierr = PetscFree(ISForEdges);CHKERRQ(ierr); 6362 } 6363 ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr); 6364 } else { 6365 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 6366 6367 total_counts = 0; 6368 n_vertices = 0; 6369 if (sub_schurs->is_vertices && pcbddc->use_vertices) { 6370 ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr); 6371 } 6372 max_constraints = 0; 6373 total_counts_cc = 0; 6374 for (i=0;i<sub_schurs->n_subs+n_vertices;i++) { 6375 total_counts += pcbddc->adaptive_constraints_n[i]; 6376 if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++; 6377 max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]); 6378 } 6379 constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr; 6380 constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr; 6381 constraints_idxs = pcbddc->adaptive_constraints_idxs; 6382 constraints_data = pcbddc->adaptive_constraints_data; 6383 /* constraints_n differs from pcbddc->adaptive_constraints_n */ 6384 ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr); 6385 total_counts_cc = 0; 6386 for (i=0;i<sub_schurs->n_subs+n_vertices;i++) { 6387 if (pcbddc->adaptive_constraints_n[i]) { 6388 constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i]; 6389 } 6390 } 6391 6392 max_size_of_constraint = 0; 6393 for (i=0;i<total_counts_cc;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]); 6394 ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr); 6395 /* Change of basis */ 6396 ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr); 6397 if (pcbddc->use_change_of_basis) { 6398 for (i=0;i<sub_schurs->n_subs;i++) { 6399 if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) { 6400 ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr); 6401 } 6402 } 6403 } 6404 } 6405 pcbddc->local_primal_size = total_counts; 6406 ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 6407 6408 /* map constraints_idxs in boundary numbering */ 6409 ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr); 6410 if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i); 6411 6412 /* Create constraint matrix */ 6413 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 6414 ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr); 6415 ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr); 6416 6417 /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */ 6418 /* determine if a QR strategy is needed for change of basis */ 6419 qr_needed = pcbddc->use_qr_single; 6420 ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr); 6421 total_primal_vertices=0; 6422 pcbddc->local_primal_size_cc = 0; 6423 for (i=0;i<total_counts_cc;i++) { 6424 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6425 if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) { 6426 pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]]; 6427 pcbddc->local_primal_size_cc += 1; 6428 } else if (PetscBTLookup(change_basis,i)) { 6429 for (k=0;k<constraints_n[i];k++) { 6430 pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k]; 6431 } 6432 pcbddc->local_primal_size_cc += constraints_n[i]; 6433 if (constraints_n[i] > 1 || pcbddc->use_qr_single) { 6434 PetscBTSet(qr_needed_idx,i); 6435 qr_needed = PETSC_TRUE; 6436 } 6437 } else { 6438 pcbddc->local_primal_size_cc += 1; 6439 } 6440 } 6441 /* note that the local variable n_vertices used below stores the number of pointwise constraints */ 6442 pcbddc->n_vertices = total_primal_vertices; 6443 /* permute indices in order to have a sorted set of vertices */ 6444 ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 6445 ierr = PetscMalloc2(pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_node,pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_mult);CHKERRQ(ierr); 6446 ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr); 6447 for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1; 6448 6449 /* nonzero structure of constraint matrix */ 6450 /* and get reference dof for local constraints */ 6451 ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr); 6452 for (i=0;i<total_primal_vertices;i++) nnz[i] = 1; 6453 6454 j = total_primal_vertices; 6455 total_counts = total_primal_vertices; 6456 cum = total_primal_vertices; 6457 for (i=n_vertices;i<total_counts_cc;i++) { 6458 if (!PetscBTLookup(change_basis,i)) { 6459 pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]]; 6460 pcbddc->local_primal_ref_mult[cum] = constraints_n[i]; 6461 cum++; 6462 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6463 for (k=0;k<constraints_n[i];k++) { 6464 pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k]; 6465 nnz[j+k] = size_of_constraint; 6466 } 6467 j += constraints_n[i]; 6468 } 6469 } 6470 ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 6471 ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 6472 ierr = PetscFree(nnz);CHKERRQ(ierr); 6473 6474 /* set values in constraint matrix */ 6475 for (i=0;i<total_primal_vertices;i++) { 6476 ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 6477 } 6478 total_counts = total_primal_vertices; 6479 for (i=n_vertices;i<total_counts_cc;i++) { 6480 if (!PetscBTLookup(change_basis,i)) { 6481 PetscInt *cols; 6482 6483 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6484 cols = constraints_idxs+constraints_idxs_ptr[i]; 6485 for (k=0;k<constraints_n[i];k++) { 6486 PetscInt row = total_counts+k; 6487 PetscScalar *vals; 6488 6489 vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint; 6490 ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr); 6491 } 6492 total_counts += constraints_n[i]; 6493 } 6494 } 6495 /* assembling */ 6496 ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6497 ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6498 ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr); 6499 6500 /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */ 6501 if (pcbddc->use_change_of_basis) { 6502 /* dual and primal dofs on a single cc */ 6503 PetscInt dual_dofs,primal_dofs; 6504 /* working stuff for GEQRF */ 6505 PetscScalar *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t; 6506 PetscBLASInt lqr_work; 6507 /* working stuff for UNGQR */ 6508 PetscScalar *gqr_work = NULL,lgqr_work_t; 6509 PetscBLASInt lgqr_work; 6510 /* working stuff for TRTRS */ 6511 PetscScalar *trs_rhs = NULL; 6512 PetscBLASInt Blas_NRHS; 6513 /* pointers for values insertion into change of basis matrix */ 6514 PetscInt *start_rows,*start_cols; 6515 PetscScalar *start_vals; 6516 /* working stuff for values insertion */ 6517 PetscBT is_primal; 6518 PetscInt *aux_primal_numbering_B; 6519 /* matrix sizes */ 6520 PetscInt global_size,local_size; 6521 /* temporary change of basis */ 6522 Mat localChangeOfBasisMatrix; 6523 /* extra space for debugging */ 6524 PetscScalar *dbg_work = NULL; 6525 6526 /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */ 6527 ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr); 6528 ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr); 6529 ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr); 6530 /* nonzeros for local mat */ 6531 ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr); 6532 if (!pcbddc->benign_change || pcbddc->fake_change) { 6533 for (i=0;i<pcis->n;i++) nnz[i]=1; 6534 } else { 6535 const PetscInt *ii; 6536 PetscInt n; 6537 PetscBool flg_row; 6538 ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr); 6539 for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i]; 6540 ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr); 6541 } 6542 for (i=n_vertices;i<total_counts_cc;i++) { 6543 if (PetscBTLookup(change_basis,i)) { 6544 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6545 if (PetscBTLookup(qr_needed_idx,i)) { 6546 for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint; 6547 } else { 6548 nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint; 6549 for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2; 6550 } 6551 } 6552 } 6553 ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 6554 ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 6555 ierr = PetscFree(nnz);CHKERRQ(ierr); 6556 /* Set interior change in the matrix */ 6557 if (!pcbddc->benign_change || pcbddc->fake_change) { 6558 for (i=0;i<pcis->n;i++) { 6559 ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 6560 } 6561 } else { 6562 const PetscInt *ii,*jj; 6563 PetscScalar *aa; 6564 PetscInt n; 6565 PetscBool flg_row; 6566 ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr); 6567 ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr); 6568 for (i=0;i<n;i++) { 6569 ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr); 6570 } 6571 ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr); 6572 ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr); 6573 } 6574 6575 if (pcbddc->dbg_flag) { 6576 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 6577 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 6578 } 6579 6580 6581 /* Now we loop on the constraints which need a change of basis */ 6582 /* 6583 Change of basis matrix is evaluated similarly to the FIRST APPROACH in 6584 Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) 6585 6586 Basic blocks of change of basis matrix T computed by 6587 6588 - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified) 6589 6590 | 1 0 ... 0 s_1/S | 6591 | 0 1 ... 0 s_2/S | 6592 | ... | 6593 | 0 ... 1 s_{n-1}/S | 6594 | -s_1/s_n ... -s_{n-1}/s_n s_n/S | 6595 6596 with S = \sum_{i=1}^n s_i^2 6597 NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering 6598 in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering 6599 6600 - QR decomposition of constraints otherwise 6601 */ 6602 if (qr_needed && max_size_of_constraint) { 6603 /* space to store Q */ 6604 ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr); 6605 /* array to store scaling factors for reflectors */ 6606 ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr); 6607 /* first we issue queries for optimal work */ 6608 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr); 6609 ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr); 6610 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6611 lqr_work = -1; 6612 PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr)); 6613 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr); 6614 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr); 6615 ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr); 6616 lgqr_work = -1; 6617 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr); 6618 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr); 6619 ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr); 6620 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6621 if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */ 6622 PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr)); 6623 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr); 6624 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr); 6625 ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr); 6626 /* array to store rhs and solution of triangular solver */ 6627 ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr); 6628 /* allocating workspace for check */ 6629 if (pcbddc->dbg_flag) { 6630 ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr); 6631 } 6632 } 6633 /* array to store whether a node is primal or not */ 6634 ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr); 6635 ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr); 6636 ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr); 6637 if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i); 6638 for (i=0;i<total_primal_vertices;i++) { 6639 ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr); 6640 } 6641 ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr); 6642 6643 /* loop on constraints and see whether or not they need a change of basis and compute it */ 6644 for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) { 6645 size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts]; 6646 if (PetscBTLookup(change_basis,total_counts)) { 6647 /* get constraint info */ 6648 primal_dofs = constraints_n[total_counts]; 6649 dual_dofs = size_of_constraint-primal_dofs; 6650 6651 if (pcbddc->dbg_flag) { 6652 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %D: %D need a change of basis (size %D)\n",total_counts,primal_dofs,size_of_constraint);CHKERRQ(ierr); 6653 } 6654 6655 if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */ 6656 6657 /* copy quadrature constraints for change of basis check */ 6658 if (pcbddc->dbg_flag) { 6659 ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 6660 } 6661 /* copy temporary constraints into larger work vector (in order to store all columns of Q) */ 6662 ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 6663 6664 /* compute QR decomposition of constraints */ 6665 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6666 ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 6667 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6668 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6669 PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr)); 6670 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr); 6671 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6672 6673 /* explictly compute R^-T */ 6674 ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr); 6675 for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0; 6676 ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 6677 ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr); 6678 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6679 ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr); 6680 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6681 PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr)); 6682 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr); 6683 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6684 6685 /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */ 6686 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6687 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6688 ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr); 6689 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6690 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6691 PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr)); 6692 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr); 6693 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6694 6695 /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints 6696 i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below) 6697 where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */ 6698 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6699 ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 6700 ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr); 6701 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6702 ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr); 6703 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr); 6704 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6705 PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,constraints_data+constraints_data_ptr[total_counts],&Blas_LDC)); 6706 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6707 ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 6708 6709 /* insert values in change of basis matrix respecting global ordering of new primal dofs */ 6710 start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]]; 6711 /* insert cols for primal dofs */ 6712 for (j=0;j<primal_dofs;j++) { 6713 start_vals = &qr_basis[j*size_of_constraint]; 6714 start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j]; 6715 ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr); 6716 } 6717 /* insert cols for dual dofs */ 6718 for (j=0,k=0;j<dual_dofs;k++) { 6719 if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) { 6720 start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint]; 6721 start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k]; 6722 ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr); 6723 j++; 6724 } 6725 } 6726 6727 /* check change of basis */ 6728 if (pcbddc->dbg_flag) { 6729 PetscInt ii,jj; 6730 PetscBool valid_qr=PETSC_TRUE; 6731 ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr); 6732 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6733 ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr); 6734 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6735 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr); 6736 ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr); 6737 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6738 PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,dbg_work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&dbg_work[size_of_constraint*primal_dofs],&Blas_LDC)); 6739 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6740 for (jj=0;jj<size_of_constraint;jj++) { 6741 for (ii=0;ii<primal_dofs;ii++) { 6742 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE; 6743 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE; 6744 } 6745 } 6746 if (!valid_qr) { 6747 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr); 6748 for (jj=0;jj<size_of_constraint;jj++) { 6749 for (ii=0;ii<primal_dofs;ii++) { 6750 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) { 6751 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %D is not orthogonal to constraint %D (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));CHKERRQ(ierr); 6752 } 6753 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) { 6754 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %D is not unitary w.r.t constraint %D (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));CHKERRQ(ierr); 6755 } 6756 } 6757 } 6758 } else { 6759 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr); 6760 } 6761 } 6762 } else { /* simple transformation block */ 6763 PetscInt row,col; 6764 PetscScalar val,norm; 6765 6766 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6767 PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one)); 6768 for (j=0;j<size_of_constraint;j++) { 6769 PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j]; 6770 row = constraints_idxs[constraints_idxs_ptr[total_counts]+j]; 6771 if (!PetscBTLookup(is_primal,row_B)) { 6772 col = constraints_idxs[constraints_idxs_ptr[total_counts]]; 6773 ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr); 6774 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr); 6775 } else { 6776 for (k=0;k<size_of_constraint;k++) { 6777 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k]; 6778 if (row != col) { 6779 val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]]; 6780 } else { 6781 val = constraints_data[constraints_data_ptr[total_counts]]/norm; 6782 } 6783 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr); 6784 } 6785 } 6786 } 6787 if (pcbddc->dbg_flag) { 6788 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr); 6789 } 6790 } 6791 } else { 6792 if (pcbddc->dbg_flag) { 6793 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr); 6794 } 6795 } 6796 } 6797 6798 /* free workspace */ 6799 if (qr_needed) { 6800 if (pcbddc->dbg_flag) { 6801 ierr = PetscFree(dbg_work);CHKERRQ(ierr); 6802 } 6803 ierr = PetscFree(trs_rhs);CHKERRQ(ierr); 6804 ierr = PetscFree(qr_tau);CHKERRQ(ierr); 6805 ierr = PetscFree(qr_work);CHKERRQ(ierr); 6806 ierr = PetscFree(gqr_work);CHKERRQ(ierr); 6807 ierr = PetscFree(qr_basis);CHKERRQ(ierr); 6808 } 6809 ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr); 6810 ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6811 ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6812 6813 /* assembling of global change of variable */ 6814 if (!pcbddc->fake_change) { 6815 Mat tmat; 6816 PetscInt bs; 6817 6818 ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr); 6819 ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr); 6820 ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr); 6821 ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr); 6822 ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6823 ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6824 ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 6825 ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr); 6826 ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr); 6827 ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr); 6828 ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr); 6829 ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr); 6830 ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 6831 ierr = MatDestroy(&tmat);CHKERRQ(ierr); 6832 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 6833 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 6834 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6835 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6836 ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr); 6837 ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr); 6838 6839 /* check */ 6840 if (pcbddc->dbg_flag) { 6841 PetscReal error; 6842 Vec x,x_change; 6843 6844 ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr); 6845 ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr); 6846 ierr = VecSetRandom(x,NULL);CHKERRQ(ierr); 6847 ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr); 6848 ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6849 ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6850 ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 6851 ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6852 ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6853 ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr); 6854 ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr); 6855 ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr); 6856 if (error > PETSC_SMALL) { 6857 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error); 6858 } 6859 ierr = VecDestroy(&x);CHKERRQ(ierr); 6860 ierr = VecDestroy(&x_change);CHKERRQ(ierr); 6861 } 6862 /* adapt sub_schurs computed (if any) */ 6863 if (pcbddc->use_deluxe_scaling) { 6864 PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs; 6865 6866 if (pcbddc->use_change_of_basis && pcbddc->adaptive_userdefined) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints"); 6867 if (sub_schurs && sub_schurs->S_Ej_all) { 6868 Mat S_new,tmat; 6869 IS is_all_N,is_V_Sall = NULL; 6870 6871 ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr); 6872 ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr); 6873 if (pcbddc->deluxe_zerorows) { 6874 ISLocalToGlobalMapping NtoSall; 6875 IS is_V; 6876 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr); 6877 ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr); 6878 ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr); 6879 ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr); 6880 ierr = ISDestroy(&is_V);CHKERRQ(ierr); 6881 } 6882 ierr = ISDestroy(&is_all_N);CHKERRQ(ierr); 6883 ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr); 6884 ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr); 6885 ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr); 6886 if (pcbddc->deluxe_zerorows) { 6887 const PetscScalar *array; 6888 const PetscInt *idxs_V,*idxs_all; 6889 PetscInt i,n_V; 6890 6891 ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr); 6892 ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr); 6893 ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr); 6894 ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr); 6895 ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr); 6896 for (i=0;i<n_V;i++) { 6897 PetscScalar val; 6898 PetscInt idx; 6899 6900 idx = idxs_V[i]; 6901 val = array[idxs_all[idxs_V[i]]]; 6902 ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr); 6903 } 6904 ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6905 ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6906 ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr); 6907 ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr); 6908 ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr); 6909 } 6910 sub_schurs->S_Ej_all = S_new; 6911 ierr = MatDestroy(&S_new);CHKERRQ(ierr); 6912 if (sub_schurs->sum_S_Ej_all) { 6913 ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr); 6914 ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr); 6915 ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr); 6916 if (pcbddc->deluxe_zerorows) { 6917 ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr); 6918 } 6919 sub_schurs->sum_S_Ej_all = S_new; 6920 ierr = MatDestroy(&S_new);CHKERRQ(ierr); 6921 } 6922 ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr); 6923 ierr = MatDestroy(&tmat);CHKERRQ(ierr); 6924 } 6925 /* destroy any change of basis context in sub_schurs */ 6926 if (sub_schurs && sub_schurs->change) { 6927 PetscInt i; 6928 6929 for (i=0;i<sub_schurs->n_subs;i++) { 6930 ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr); 6931 } 6932 ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr); 6933 } 6934 } 6935 if (pcbddc->switch_static) { /* need to save the local change */ 6936 pcbddc->switch_static_change = localChangeOfBasisMatrix; 6937 } else { 6938 ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr); 6939 } 6940 /* determine if any process has changed the pressures locally */ 6941 pcbddc->change_interior = pcbddc->benign_have_null; 6942 } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */ 6943 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 6944 pcbddc->ConstraintMatrix = localChangeOfBasisMatrix; 6945 pcbddc->use_qr_single = qr_needed; 6946 } 6947 } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) { 6948 if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) { 6949 ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr); 6950 pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix; 6951 } else { 6952 Mat benign_global = NULL; 6953 if (pcbddc->benign_have_null) { 6954 Mat M; 6955 6956 pcbddc->change_interior = PETSC_TRUE; 6957 ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr); 6958 ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr); 6959 ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr); 6960 if (pcbddc->benign_change) { 6961 ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr); 6962 ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr); 6963 } else { 6964 ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr); 6965 ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr); 6966 } 6967 ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr); 6968 ierr = MatDestroy(&M);CHKERRQ(ierr); 6969 ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6970 ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6971 } 6972 if (pcbddc->user_ChangeOfBasisMatrix) { 6973 ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 6974 ierr = MatDestroy(&benign_global);CHKERRQ(ierr); 6975 } else if (pcbddc->benign_have_null) { 6976 pcbddc->ChangeOfBasisMatrix = benign_global; 6977 } 6978 } 6979 if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */ 6980 IS is_global; 6981 const PetscInt *gidxs; 6982 6983 ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr); 6984 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr); 6985 ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr); 6986 ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr); 6987 ierr = ISDestroy(&is_global);CHKERRQ(ierr); 6988 } 6989 } 6990 if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) { 6991 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr); 6992 } 6993 6994 if (!pcbddc->fake_change) { 6995 /* add pressure dofs to set of primal nodes for numbering purposes */ 6996 for (i=0;i<pcbddc->benign_n;i++) { 6997 pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i]; 6998 pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i]; 6999 pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1; 7000 pcbddc->local_primal_size_cc++; 7001 pcbddc->local_primal_size++; 7002 } 7003 7004 /* check if a new primal space has been introduced (also take into account benign trick) */ 7005 pcbddc->new_primal_space_local = PETSC_TRUE; 7006 if (olocal_primal_size == pcbddc->local_primal_size) { 7007 ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr); 7008 pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local); 7009 if (!pcbddc->new_primal_space_local) { 7010 ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr); 7011 pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local); 7012 } 7013 } 7014 /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */ 7015 ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 7016 } 7017 ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr); 7018 7019 /* flush dbg viewer */ 7020 if (pcbddc->dbg_flag) { 7021 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 7022 } 7023 7024 /* free workspace */ 7025 ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr); 7026 ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr); 7027 if (!pcbddc->adaptive_selection) { 7028 ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr); 7029 ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr); 7030 } else { 7031 ierr = PetscFree5(pcbddc->adaptive_constraints_n, 7032 pcbddc->adaptive_constraints_idxs_ptr, 7033 pcbddc->adaptive_constraints_data_ptr, 7034 pcbddc->adaptive_constraints_idxs, 7035 pcbddc->adaptive_constraints_data);CHKERRQ(ierr); 7036 ierr = PetscFree(constraints_n);CHKERRQ(ierr); 7037 ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr); 7038 } 7039 PetscFunctionReturn(0); 7040 } 7041 /* #undef PETSC_MISSING_LAPACK_GESVD */ 7042 7043 PetscErrorCode PCBDDCAnalyzeInterface(PC pc) 7044 { 7045 ISLocalToGlobalMapping map; 7046 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 7047 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 7048 PetscInt i,N; 7049 PetscBool rcsr = PETSC_FALSE; 7050 PetscErrorCode ierr; 7051 7052 PetscFunctionBegin; 7053 if (pcbddc->recompute_topography) { 7054 pcbddc->graphanalyzed = PETSC_FALSE; 7055 /* Reset previously computed graph */ 7056 ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr); 7057 /* Init local Graph struct */ 7058 ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr); 7059 ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr); 7060 ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr); 7061 7062 if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) { 7063 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 7064 } 7065 /* Check validity of the csr graph passed in by the user */ 7066 if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %D, expected %D",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs); 7067 7068 /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */ 7069 if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) { 7070 PetscInt *xadj,*adjncy; 7071 PetscInt nvtxs; 7072 PetscBool flg_row=PETSC_FALSE; 7073 7074 ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 7075 if (flg_row) { 7076 ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr); 7077 pcbddc->computed_rowadj = PETSC_TRUE; 7078 } 7079 ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 7080 rcsr = PETSC_TRUE; 7081 } 7082 if (pcbddc->dbg_flag) { 7083 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 7084 } 7085 7086 if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) { 7087 PetscReal *lcoords; 7088 PetscInt n; 7089 MPI_Datatype dimrealtype; 7090 7091 /* TODO: support for blocked */ 7092 if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n); 7093 ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr); 7094 ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr); 7095 ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr); 7096 ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr); 7097 ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr); 7098 ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr); 7099 ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr); 7100 ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr); 7101 7102 pcbddc->mat_graph->coords = lcoords; 7103 pcbddc->mat_graph->cloc = PETSC_TRUE; 7104 pcbddc->mat_graph->cnloc = n; 7105 } 7106 if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs); 7107 pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected); 7108 7109 /* Setup of Graph */ 7110 pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */ 7111 ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 7112 7113 /* attach info on disconnected subdomains if present */ 7114 if (pcbddc->n_local_subs) { 7115 PetscInt *local_subs; 7116 7117 ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr); 7118 for (i=0;i<pcbddc->n_local_subs;i++) { 7119 const PetscInt *idxs; 7120 PetscInt nl,j; 7121 7122 ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr); 7123 ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr); 7124 for (j=0;j<nl;j++) local_subs[idxs[j]] = i; 7125 ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr); 7126 } 7127 pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs; 7128 pcbddc->mat_graph->local_subs = local_subs; 7129 } 7130 } 7131 7132 if (!pcbddc->graphanalyzed) { 7133 /* Graph's connected components analysis */ 7134 ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr); 7135 pcbddc->graphanalyzed = PETSC_TRUE; 7136 pcbddc->corner_selected = pcbddc->corner_selection; 7137 } 7138 if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0; 7139 PetscFunctionReturn(0); 7140 } 7141 7142 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[]) 7143 { 7144 PetscInt i,j; 7145 PetscScalar *alphas; 7146 PetscReal norm; 7147 PetscErrorCode ierr; 7148 7149 PetscFunctionBegin; 7150 if (!n) PetscFunctionReturn(0); 7151 ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr); 7152 ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr); 7153 if (norm < PETSC_SMALL) { 7154 ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr); 7155 } 7156 for (i=1;i<n;i++) { 7157 ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr); 7158 for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]); 7159 ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr); 7160 ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr); 7161 if (norm < PETSC_SMALL) { 7162 ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr); 7163 } 7164 } 7165 ierr = PetscFree(alphas);CHKERRQ(ierr); 7166 PetscFunctionReturn(0); 7167 } 7168 7169 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void) 7170 { 7171 Mat A; 7172 PetscInt n_neighs,*neighs,*n_shared,**shared; 7173 PetscMPIInt size,rank,color; 7174 PetscInt *xadj,*adjncy; 7175 PetscInt *adjncy_wgt,*v_wgt,*ranks_send_to_idx; 7176 PetscInt im_active,active_procs,N,n,i,j,threshold = 2; 7177 PetscInt void_procs,*procs_candidates = NULL; 7178 PetscInt xadj_count,*count; 7179 PetscBool ismatis,use_vwgt=PETSC_FALSE; 7180 PetscSubcomm psubcomm; 7181 MPI_Comm subcomm; 7182 PetscErrorCode ierr; 7183 7184 PetscFunctionBegin; 7185 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 7186 ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr); 7187 if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME); 7188 PetscValidLogicalCollectiveInt(mat,*n_subdomains,2); 7189 PetscValidLogicalCollectiveInt(mat,redprocs,3); 7190 if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains); 7191 7192 if (have_void) *have_void = PETSC_FALSE; 7193 ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr); 7194 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr); 7195 ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr); 7196 ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr); 7197 im_active = !!n; 7198 ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr); 7199 void_procs = size - active_procs; 7200 /* get ranks of of non-active processes in mat communicator */ 7201 if (void_procs) { 7202 PetscInt ncand; 7203 7204 if (have_void) *have_void = PETSC_TRUE; 7205 ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr); 7206 ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr); 7207 for (i=0,ncand=0;i<size;i++) { 7208 if (!procs_candidates[i]) { 7209 procs_candidates[ncand++] = i; 7210 } 7211 } 7212 /* force n_subdomains to be not greater that the number of non-active processes */ 7213 *n_subdomains = PetscMin(void_procs,*n_subdomains); 7214 } 7215 7216 /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix 7217 number of subdomains requested 1 -> send to master or first candidate in voids */ 7218 ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr); 7219 if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) { 7220 PetscInt issize,isidx,dest; 7221 if (*n_subdomains == 1) dest = 0; 7222 else dest = rank; 7223 if (im_active) { 7224 issize = 1; 7225 if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */ 7226 isidx = procs_candidates[dest]; 7227 } else { 7228 isidx = dest; 7229 } 7230 } else { 7231 issize = 0; 7232 isidx = -1; 7233 } 7234 if (*n_subdomains != 1) *n_subdomains = active_procs; 7235 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr); 7236 ierr = PetscFree(procs_candidates);CHKERRQ(ierr); 7237 PetscFunctionReturn(0); 7238 } 7239 ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr); 7240 ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr); 7241 threshold = PetscMax(threshold,2); 7242 7243 /* Get info on mapping */ 7244 ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr); 7245 7246 /* build local CSR graph of subdomains' connectivity */ 7247 ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr); 7248 xadj[0] = 0; 7249 xadj[1] = PetscMax(n_neighs-1,0); 7250 ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr); 7251 ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr); 7252 ierr = PetscCalloc1(n,&count);CHKERRQ(ierr); 7253 for (i=1;i<n_neighs;i++) 7254 for (j=0;j<n_shared[i];j++) 7255 count[shared[i][j]] += 1; 7256 7257 xadj_count = 0; 7258 for (i=1;i<n_neighs;i++) { 7259 for (j=0;j<n_shared[i];j++) { 7260 if (count[shared[i][j]] < threshold) { 7261 adjncy[xadj_count] = neighs[i]; 7262 adjncy_wgt[xadj_count] = n_shared[i]; 7263 xadj_count++; 7264 break; 7265 } 7266 } 7267 } 7268 xadj[1] = xadj_count; 7269 ierr = PetscFree(count);CHKERRQ(ierr); 7270 ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr); 7271 ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr); 7272 7273 ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr); 7274 7275 /* Restrict work on active processes only */ 7276 ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr); 7277 if (void_procs) { 7278 ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr); 7279 ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */ 7280 ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr); 7281 subcomm = PetscSubcommChild(psubcomm); 7282 } else { 7283 psubcomm = NULL; 7284 subcomm = PetscObjectComm((PetscObject)mat); 7285 } 7286 7287 v_wgt = NULL; 7288 if (!color) { 7289 ierr = PetscFree(xadj);CHKERRQ(ierr); 7290 ierr = PetscFree(adjncy);CHKERRQ(ierr); 7291 ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr); 7292 } else { 7293 Mat subdomain_adj; 7294 IS new_ranks,new_ranks_contig; 7295 MatPartitioning partitioner; 7296 PetscInt rstart=0,rend=0; 7297 PetscInt *is_indices,*oldranks; 7298 PetscMPIInt size; 7299 PetscBool aggregate; 7300 7301 ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr); 7302 if (void_procs) { 7303 PetscInt prank = rank; 7304 ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr); 7305 ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr); 7306 for (i=0;i<xadj[1];i++) { 7307 ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr); 7308 } 7309 ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr); 7310 } else { 7311 oldranks = NULL; 7312 } 7313 aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE); 7314 if (aggregate) { /* TODO: all this part could be made more efficient */ 7315 PetscInt lrows,row,ncols,*cols; 7316 PetscMPIInt nrank; 7317 PetscScalar *vals; 7318 7319 ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr); 7320 lrows = 0; 7321 if (nrank<redprocs) { 7322 lrows = size/redprocs; 7323 if (nrank<size%redprocs) lrows++; 7324 } 7325 ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr); 7326 ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr); 7327 ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 7328 ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 7329 row = nrank; 7330 ncols = xadj[1]-xadj[0]; 7331 cols = adjncy; 7332 ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr); 7333 for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i]; 7334 ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr); 7335 ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7336 ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7337 ierr = PetscFree(xadj);CHKERRQ(ierr); 7338 ierr = PetscFree(adjncy);CHKERRQ(ierr); 7339 ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr); 7340 ierr = PetscFree(vals);CHKERRQ(ierr); 7341 if (use_vwgt) { 7342 Vec v; 7343 const PetscScalar *array; 7344 PetscInt nl; 7345 7346 ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr); 7347 ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr); 7348 ierr = VecAssemblyBegin(v);CHKERRQ(ierr); 7349 ierr = VecAssemblyEnd(v);CHKERRQ(ierr); 7350 ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr); 7351 ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr); 7352 ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr); 7353 for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]); 7354 ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr); 7355 ierr = VecDestroy(&v);CHKERRQ(ierr); 7356 } 7357 } else { 7358 ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr); 7359 if (use_vwgt) { 7360 ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr); 7361 v_wgt[0] = n; 7362 } 7363 } 7364 /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */ 7365 7366 /* Partition */ 7367 ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr); 7368 #if defined(PETSC_HAVE_PTSCOTCH) 7369 ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr); 7370 #elif defined(PETSC_HAVE_PARMETIS) 7371 ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr); 7372 #else 7373 ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr); 7374 #endif 7375 ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr); 7376 if (v_wgt) { 7377 ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr); 7378 } 7379 *n_subdomains = PetscMin((PetscInt)size,*n_subdomains); 7380 ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr); 7381 ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr); 7382 ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr); 7383 /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */ 7384 7385 /* renumber new_ranks to avoid "holes" in new set of processors */ 7386 ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr); 7387 ierr = ISDestroy(&new_ranks);CHKERRQ(ierr); 7388 ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr); 7389 if (!aggregate) { 7390 if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */ 7391 #if defined(PETSC_USE_DEBUG) 7392 if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen"); 7393 #endif 7394 ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]]; 7395 } else if (oldranks) { 7396 ranks_send_to_idx[0] = oldranks[is_indices[0]]; 7397 } else { 7398 ranks_send_to_idx[0] = is_indices[0]; 7399 } 7400 } else { 7401 PetscInt idx = 0; 7402 PetscMPIInt tag; 7403 MPI_Request *reqs; 7404 7405 ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr); 7406 ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr); 7407 for (i=rstart;i<rend;i++) { 7408 ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr); 7409 } 7410 ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr); 7411 ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7412 ierr = PetscFree(reqs);CHKERRQ(ierr); 7413 if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */ 7414 #if defined(PETSC_USE_DEBUG) 7415 if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen"); 7416 #endif 7417 ranks_send_to_idx[0] = procs_candidates[oldranks[idx]]; 7418 } else if (oldranks) { 7419 ranks_send_to_idx[0] = oldranks[idx]; 7420 } else { 7421 ranks_send_to_idx[0] = idx; 7422 } 7423 } 7424 ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr); 7425 /* clean up */ 7426 ierr = PetscFree(oldranks);CHKERRQ(ierr); 7427 ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr); 7428 ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr); 7429 ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr); 7430 } 7431 ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr); 7432 ierr = PetscFree(procs_candidates);CHKERRQ(ierr); 7433 7434 /* assemble parallel IS for sends */ 7435 i = 1; 7436 if (!color) i=0; 7437 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr); 7438 PetscFunctionReturn(0); 7439 } 7440 7441 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate; 7442 7443 PetscErrorCode PCBDDCMatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, PetscBool restrict_full, PetscBool reuse, Mat *mat_n, PetscInt nis, IS isarray[], PetscInt nvecs, Vec nnsp_vec[]) 7444 { 7445 Mat local_mat; 7446 IS is_sends_internal; 7447 PetscInt rows,cols,new_local_rows; 7448 PetscInt i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs; 7449 PetscBool ismatis,isdense,newisdense,destroy_mat; 7450 ISLocalToGlobalMapping l2gmap; 7451 PetscInt* l2gmap_indices; 7452 const PetscInt* is_indices; 7453 MatType new_local_type; 7454 /* buffers */ 7455 PetscInt *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs; 7456 PetscInt *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is; 7457 PetscInt *recv_buffer_idxs_local; 7458 PetscScalar *ptr_vals,*send_buffer_vals,*recv_buffer_vals; 7459 PetscScalar *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs; 7460 /* MPI */ 7461 MPI_Comm comm,comm_n; 7462 PetscSubcomm subcomm; 7463 PetscMPIInt n_sends,n_recvs,size; 7464 PetscMPIInt *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is; 7465 PetscMPIInt *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals; 7466 PetscMPIInt len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest; 7467 MPI_Request *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs; 7468 MPI_Request *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs; 7469 PetscErrorCode ierr; 7470 7471 PetscFunctionBegin; 7472 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 7473 ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr); 7474 if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME); 7475 PetscValidLogicalCollectiveInt(mat,n_subdomains,3); 7476 PetscValidLogicalCollectiveBool(mat,restrict_comm,4); 7477 PetscValidLogicalCollectiveBool(mat,restrict_full,5); 7478 PetscValidLogicalCollectiveBool(mat,reuse,6); 7479 PetscValidLogicalCollectiveInt(mat,nis,8); 7480 PetscValidLogicalCollectiveInt(mat,nvecs,10); 7481 if (nvecs) { 7482 if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported"); 7483 PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11); 7484 } 7485 /* further checks */ 7486 ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr); 7487 ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr); 7488 if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE"); 7489 ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr); 7490 if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square"); 7491 if (reuse && *mat_n) { 7492 PetscInt mrows,mcols,mnrows,mncols; 7493 PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7); 7494 ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr); 7495 if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS"); 7496 ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr); 7497 ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr); 7498 if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows); 7499 if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols); 7500 } 7501 ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr); 7502 PetscValidLogicalCollectiveInt(mat,bs,0); 7503 7504 /* prepare IS for sending if not provided */ 7505 if (!is_sends) { 7506 if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains"); 7507 ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr); 7508 } else { 7509 ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr); 7510 is_sends_internal = is_sends; 7511 } 7512 7513 /* get comm */ 7514 ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr); 7515 7516 /* compute number of sends */ 7517 ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr); 7518 ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr); 7519 7520 /* compute number of receives */ 7521 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 7522 ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr); 7523 ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr); 7524 ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr); 7525 for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1; 7526 ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr); 7527 ierr = PetscFree(iflags);CHKERRQ(ierr); 7528 7529 /* restrict comm if requested */ 7530 subcomm = 0; 7531 destroy_mat = PETSC_FALSE; 7532 if (restrict_comm) { 7533 PetscMPIInt color,subcommsize; 7534 7535 color = 0; 7536 if (restrict_full) { 7537 if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */ 7538 } else { 7539 if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */ 7540 } 7541 ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); 7542 subcommsize = size - subcommsize; 7543 /* check if reuse has been requested */ 7544 if (reuse) { 7545 if (*mat_n) { 7546 PetscMPIInt subcommsize2; 7547 ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr); 7548 if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2); 7549 comm_n = PetscObjectComm((PetscObject)*mat_n); 7550 } else { 7551 comm_n = PETSC_COMM_SELF; 7552 } 7553 } else { /* MAT_INITIAL_MATRIX */ 7554 PetscMPIInt rank; 7555 7556 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 7557 ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr); 7558 ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); 7559 ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr); 7560 comm_n = PetscSubcommChild(subcomm); 7561 } 7562 /* flag to destroy *mat_n if not significative */ 7563 if (color) destroy_mat = PETSC_TRUE; 7564 } else { 7565 comm_n = comm; 7566 } 7567 7568 /* prepare send/receive buffers */ 7569 ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr); 7570 ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr); 7571 ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr); 7572 ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr); 7573 if (nis) { 7574 ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr); 7575 } 7576 7577 /* Get data from local matrices */ 7578 if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented"); 7579 /* TODO: See below some guidelines on how to prepare the local buffers */ 7580 /* 7581 send_buffer_vals should contain the raw values of the local matrix 7582 send_buffer_idxs should contain: 7583 - MatType_PRIVATE type 7584 - PetscInt size_of_l2gmap 7585 - PetscInt global_row_indices[size_of_l2gmap] 7586 - PetscInt all_other_info_which_is_needed_to_compute_preallocation_and_set_values 7587 */ 7588 else { 7589 ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr); 7590 ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr); 7591 ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr); 7592 send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE; 7593 send_buffer_idxs[1] = i; 7594 ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr); 7595 ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr); 7596 ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr); 7597 ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr); 7598 for (i=0;i<n_sends;i++) { 7599 ilengths_vals[is_indices[i]] = len*len; 7600 ilengths_idxs[is_indices[i]] = len+2; 7601 } 7602 } 7603 ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr); 7604 /* additional is (if any) */ 7605 if (nis) { 7606 PetscMPIInt psum; 7607 PetscInt j; 7608 for (j=0,psum=0;j<nis;j++) { 7609 PetscInt plen; 7610 ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr); 7611 ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr); 7612 psum += len+1; /* indices + lenght */ 7613 } 7614 ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr); 7615 for (j=0,psum=0;j<nis;j++) { 7616 PetscInt plen; 7617 const PetscInt *is_array_idxs; 7618 ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr); 7619 send_buffer_idxs_is[psum] = plen; 7620 ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr); 7621 ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr); 7622 ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr); 7623 psum += plen+1; /* indices + lenght */ 7624 } 7625 for (i=0;i<n_sends;i++) { 7626 ilengths_idxs_is[is_indices[i]] = psum; 7627 } 7628 ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr); 7629 } 7630 ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr); 7631 7632 buf_size_idxs = 0; 7633 buf_size_vals = 0; 7634 buf_size_idxs_is = 0; 7635 buf_size_vecs = 0; 7636 for (i=0;i<n_recvs;i++) { 7637 buf_size_idxs += (PetscInt)olengths_idxs[i]; 7638 buf_size_vals += (PetscInt)olengths_vals[i]; 7639 if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i]; 7640 if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i]; 7641 } 7642 ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr); 7643 ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr); 7644 ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr); 7645 ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr); 7646 7647 /* get new tags for clean communications */ 7648 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr); 7649 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr); 7650 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr); 7651 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr); 7652 7653 /* allocate for requests */ 7654 ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr); 7655 ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr); 7656 ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr); 7657 ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr); 7658 ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr); 7659 ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr); 7660 ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr); 7661 ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr); 7662 7663 /* communications */ 7664 ptr_idxs = recv_buffer_idxs; 7665 ptr_vals = recv_buffer_vals; 7666 ptr_idxs_is = recv_buffer_idxs_is; 7667 ptr_vecs = recv_buffer_vecs; 7668 for (i=0;i<n_recvs;i++) { 7669 source_dest = onodes[i]; 7670 ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr); 7671 ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr); 7672 ptr_idxs += olengths_idxs[i]; 7673 ptr_vals += olengths_vals[i]; 7674 if (nis) { 7675 source_dest = onodes_is[i]; 7676 ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr); 7677 ptr_idxs_is += olengths_idxs_is[i]; 7678 } 7679 if (nvecs) { 7680 source_dest = onodes[i]; 7681 ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr); 7682 ptr_vecs += olengths_idxs[i]-2; 7683 } 7684 } 7685 for (i=0;i<n_sends;i++) { 7686 ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr); 7687 ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr); 7688 ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr); 7689 if (nis) { 7690 ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr); 7691 } 7692 if (nvecs) { 7693 ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7694 ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr); 7695 } 7696 } 7697 ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr); 7698 ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr); 7699 7700 /* assemble new l2g map */ 7701 ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7702 ptr_idxs = recv_buffer_idxs; 7703 new_local_rows = 0; 7704 for (i=0;i<n_recvs;i++) { 7705 new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */ 7706 ptr_idxs += olengths_idxs[i]; 7707 } 7708 ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr); 7709 ptr_idxs = recv_buffer_idxs; 7710 new_local_rows = 0; 7711 for (i=0;i<n_recvs;i++) { 7712 ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr); 7713 new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */ 7714 ptr_idxs += olengths_idxs[i]; 7715 } 7716 ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr); 7717 ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr); 7718 ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr); 7719 7720 /* infer new local matrix type from received local matrices type */ 7721 /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */ 7722 /* it also assumes that if the block size is set, than it is the same among all local matrices (see checks at the beginning of the function) */ 7723 if (n_recvs) { 7724 MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0]; 7725 ptr_idxs = recv_buffer_idxs; 7726 for (i=0;i<n_recvs;i++) { 7727 if ((PetscInt)new_local_type_private != *ptr_idxs) { 7728 new_local_type_private = MATAIJ_PRIVATE; 7729 break; 7730 } 7731 ptr_idxs += olengths_idxs[i]; 7732 } 7733 switch (new_local_type_private) { 7734 case MATDENSE_PRIVATE: 7735 new_local_type = MATSEQAIJ; 7736 bs = 1; 7737 break; 7738 case MATAIJ_PRIVATE: 7739 new_local_type = MATSEQAIJ; 7740 bs = 1; 7741 break; 7742 case MATBAIJ_PRIVATE: 7743 new_local_type = MATSEQBAIJ; 7744 break; 7745 case MATSBAIJ_PRIVATE: 7746 new_local_type = MATSEQSBAIJ; 7747 break; 7748 default: 7749 SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME); 7750 break; 7751 } 7752 } else { /* by default, new_local_type is seqaij */ 7753 new_local_type = MATSEQAIJ; 7754 bs = 1; 7755 } 7756 7757 /* create MATIS object if needed */ 7758 if (!reuse) { 7759 ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr); 7760 ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr); 7761 } else { 7762 /* it also destroys the local matrices */ 7763 if (*mat_n) { 7764 ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr); 7765 } else { /* this is a fake object */ 7766 ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr); 7767 } 7768 } 7769 ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr); 7770 ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr); 7771 7772 ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7773 7774 /* Global to local map of received indices */ 7775 ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */ 7776 ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr); 7777 ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr); 7778 7779 /* restore attributes -> type of incoming data and its size */ 7780 buf_size_idxs = 0; 7781 for (i=0;i<n_recvs;i++) { 7782 recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs]; 7783 recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1]; 7784 buf_size_idxs += (PetscInt)olengths_idxs[i]; 7785 } 7786 ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr); 7787 7788 /* set preallocation */ 7789 ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr); 7790 if (!newisdense) { 7791 PetscInt *new_local_nnz=0; 7792 7793 ptr_idxs = recv_buffer_idxs_local; 7794 if (n_recvs) { 7795 ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr); 7796 } 7797 for (i=0;i<n_recvs;i++) { 7798 PetscInt j; 7799 if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */ 7800 for (j=0;j<*(ptr_idxs+1);j++) { 7801 new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1); 7802 } 7803 } else { 7804 /* TODO */ 7805 } 7806 ptr_idxs += olengths_idxs[i]; 7807 } 7808 if (new_local_nnz) { 7809 for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows); 7810 ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr); 7811 for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs; 7812 ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr); 7813 for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0); 7814 ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr); 7815 } else { 7816 ierr = MatSetUp(local_mat);CHKERRQ(ierr); 7817 } 7818 ierr = PetscFree(new_local_nnz);CHKERRQ(ierr); 7819 } else { 7820 ierr = MatSetUp(local_mat);CHKERRQ(ierr); 7821 } 7822 7823 /* set values */ 7824 ptr_vals = recv_buffer_vals; 7825 ptr_idxs = recv_buffer_idxs_local; 7826 for (i=0;i<n_recvs;i++) { 7827 if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */ 7828 ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); 7829 ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr); 7830 ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); 7831 ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); 7832 ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr); 7833 } else { 7834 /* TODO */ 7835 } 7836 ptr_idxs += olengths_idxs[i]; 7837 ptr_vals += olengths_vals[i]; 7838 } 7839 ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7840 ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7841 ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr); 7842 ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7843 ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7844 ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr); 7845 7846 #if 0 7847 if (!restrict_comm) { /* check */ 7848 Vec lvec,rvec; 7849 PetscReal infty_error; 7850 7851 ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr); 7852 ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr); 7853 ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr); 7854 ierr = VecScale(lvec,-1.0);CHKERRQ(ierr); 7855 ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr); 7856 ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 7857 ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error); 7858 ierr = VecDestroy(&rvec);CHKERRQ(ierr); 7859 ierr = VecDestroy(&lvec);CHKERRQ(ierr); 7860 } 7861 #endif 7862 7863 /* assemble new additional is (if any) */ 7864 if (nis) { 7865 PetscInt **temp_idxs,*count_is,j,psum; 7866 7867 ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7868 ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr); 7869 ptr_idxs = recv_buffer_idxs_is; 7870 psum = 0; 7871 for (i=0;i<n_recvs;i++) { 7872 for (j=0;j<nis;j++) { 7873 PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */ 7874 count_is[j] += plen; /* increment counting of buffer for j-th IS */ 7875 psum += plen; 7876 ptr_idxs += plen+1; /* shift pointer to received data */ 7877 } 7878 } 7879 ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr); 7880 ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr); 7881 for (i=1;i<nis;i++) { 7882 temp_idxs[i] = temp_idxs[i-1]+count_is[i-1]; 7883 } 7884 ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr); 7885 ptr_idxs = recv_buffer_idxs_is; 7886 for (i=0;i<n_recvs;i++) { 7887 for (j=0;j<nis;j++) { 7888 PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */ 7889 ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr); 7890 count_is[j] += plen; /* increment starting point of buffer for j-th IS */ 7891 ptr_idxs += plen+1; /* shift pointer to received data */ 7892 } 7893 } 7894 for (i=0;i<nis;i++) { 7895 ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr); 7896 ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr); 7897 ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr); 7898 } 7899 ierr = PetscFree(count_is);CHKERRQ(ierr); 7900 ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr); 7901 ierr = PetscFree(temp_idxs);CHKERRQ(ierr); 7902 } 7903 /* free workspace */ 7904 ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr); 7905 ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7906 ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr); 7907 ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7908 if (isdense) { 7909 ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr); 7910 ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr); 7911 ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr); 7912 } else { 7913 /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */ 7914 } 7915 if (nis) { 7916 ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7917 ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr); 7918 } 7919 7920 if (nvecs) { 7921 ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7922 ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7923 ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7924 ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr); 7925 ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr); 7926 ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr); 7927 ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr); 7928 /* set values */ 7929 ptr_vals = recv_buffer_vecs; 7930 ptr_idxs = recv_buffer_idxs_local; 7931 ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7932 for (i=0;i<n_recvs;i++) { 7933 PetscInt j; 7934 for (j=0;j<*(ptr_idxs+1);j++) { 7935 send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j); 7936 } 7937 ptr_idxs += olengths_idxs[i]; 7938 ptr_vals += olengths_idxs[i]-2; 7939 } 7940 ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7941 ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr); 7942 ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr); 7943 } 7944 7945 ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr); 7946 ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr); 7947 ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr); 7948 ierr = PetscFree(recv_req_vals);CHKERRQ(ierr); 7949 ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr); 7950 ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr); 7951 ierr = PetscFree(send_req_idxs);CHKERRQ(ierr); 7952 ierr = PetscFree(send_req_vals);CHKERRQ(ierr); 7953 ierr = PetscFree(send_req_vecs);CHKERRQ(ierr); 7954 ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr); 7955 ierr = PetscFree(ilengths_vals);CHKERRQ(ierr); 7956 ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr); 7957 ierr = PetscFree(olengths_vals);CHKERRQ(ierr); 7958 ierr = PetscFree(olengths_idxs);CHKERRQ(ierr); 7959 ierr = PetscFree(onodes);CHKERRQ(ierr); 7960 if (nis) { 7961 ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr); 7962 ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr); 7963 ierr = PetscFree(onodes_is);CHKERRQ(ierr); 7964 } 7965 ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr); 7966 if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */ 7967 ierr = MatDestroy(mat_n);CHKERRQ(ierr); 7968 for (i=0;i<nis;i++) { 7969 ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr); 7970 } 7971 if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */ 7972 ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr); 7973 } 7974 *mat_n = NULL; 7975 } 7976 PetscFunctionReturn(0); 7977 } 7978 7979 /* temporary hack into ksp private data structure */ 7980 #include <petsc/private/kspimpl.h> 7981 7982 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals) 7983 { 7984 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 7985 PC_IS *pcis = (PC_IS*)pc->data; 7986 Mat coarse_mat,coarse_mat_is,coarse_submat_dense; 7987 Mat coarsedivudotp = NULL; 7988 Mat coarseG,t_coarse_mat_is; 7989 MatNullSpace CoarseNullSpace = NULL; 7990 ISLocalToGlobalMapping coarse_islg; 7991 IS coarse_is,*isarray,corners; 7992 PetscInt i,im_active=-1,active_procs=-1; 7993 PetscInt nis,nisdofs,nisneu,nisvert; 7994 PetscInt coarse_eqs_per_proc; 7995 PC pc_temp; 7996 PCType coarse_pc_type; 7997 KSPType coarse_ksp_type; 7998 PetscBool multilevel_requested,multilevel_allowed; 7999 PetscBool coarse_reuse; 8000 PetscInt ncoarse,nedcfield; 8001 PetscBool compute_vecs = PETSC_FALSE; 8002 PetscScalar *array; 8003 MatReuse coarse_mat_reuse; 8004 PetscBool restr, full_restr, have_void; 8005 PetscMPIInt size; 8006 PetscErrorCode ierr; 8007 8008 PetscFunctionBegin; 8009 ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8010 /* Assign global numbering to coarse dofs */ 8011 if (pcbddc->new_primal_space || pcbddc->coarse_size == -1) { /* a new primal space is present or it is the first initialization, so recompute global numbering */ 8012 PetscInt ocoarse_size; 8013 compute_vecs = PETSC_TRUE; 8014 8015 pcbddc->new_primal_space = PETSC_TRUE; 8016 ocoarse_size = pcbddc->coarse_size; 8017 ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr); 8018 ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr); 8019 /* see if we can avoid some work */ 8020 if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */ 8021 /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */ 8022 if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) { 8023 ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr); 8024 coarse_reuse = PETSC_FALSE; 8025 } else { /* we can safely reuse already computed coarse matrix */ 8026 coarse_reuse = PETSC_TRUE; 8027 } 8028 } else { /* there's no coarse ksp, so we need to create the coarse matrix too */ 8029 coarse_reuse = PETSC_FALSE; 8030 } 8031 /* reset any subassembling information */ 8032 if (!coarse_reuse || pcbddc->recompute_topography) { 8033 ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr); 8034 } 8035 } else { /* primal space is unchanged, so we can reuse coarse matrix */ 8036 coarse_reuse = PETSC_TRUE; 8037 } 8038 if (coarse_reuse && pcbddc->coarse_ksp) { 8039 ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr); 8040 ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr); 8041 coarse_mat_reuse = MAT_REUSE_MATRIX; 8042 } else { 8043 coarse_mat = NULL; 8044 coarse_mat_reuse = MAT_INITIAL_MATRIX; 8045 } 8046 8047 /* creates temporary l2gmap and IS for coarse indexes */ 8048 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr); 8049 ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr); 8050 8051 /* creates temporary MATIS object for coarse matrix */ 8052 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr); 8053 ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,NULL,&t_coarse_mat_is);CHKERRQ(ierr); 8054 ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr); 8055 ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 8056 ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 8057 ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr); 8058 8059 /* count "active" (i.e. with positive local size) and "void" processes */ 8060 im_active = !!(pcis->n); 8061 ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8062 8063 /* determine number of processes partecipating to coarse solver and compute subassembling pattern */ 8064 /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */ 8065 /* full_restr : just use the receivers from the subassembling pattern */ 8066 ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr); 8067 coarse_mat_is = NULL; 8068 multilevel_allowed = PETSC_FALSE; 8069 multilevel_requested = PETSC_FALSE; 8070 coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc); 8071 if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size; 8072 if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE; 8073 if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE; 8074 if (multilevel_requested) { 8075 ncoarse = active_procs/pcbddc->coarsening_ratio; 8076 restr = PETSC_FALSE; 8077 full_restr = PETSC_FALSE; 8078 } else { 8079 ncoarse = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc); 8080 restr = PETSC_TRUE; 8081 full_restr = PETSC_TRUE; 8082 } 8083 if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE; 8084 ncoarse = PetscMax(1,ncoarse); 8085 if (!pcbddc->coarse_subassembling) { 8086 if (pcbddc->coarsening_ratio > 1) { 8087 if (multilevel_requested) { 8088 ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr); 8089 } else { 8090 ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr); 8091 } 8092 } else { 8093 PetscMPIInt rank; 8094 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr); 8095 have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE; 8096 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr); 8097 } 8098 } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */ 8099 PetscInt psum; 8100 if (pcbddc->coarse_ksp) psum = 1; 8101 else psum = 0; 8102 ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8103 have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE; 8104 } 8105 /* determine if we can go multilevel */ 8106 if (multilevel_requested) { 8107 if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */ 8108 else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */ 8109 } 8110 if (multilevel_allowed && have_void) restr = PETSC_TRUE; 8111 8112 /* dump subassembling pattern */ 8113 if (pcbddc->dbg_flag && multilevel_allowed) { 8114 ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr); 8115 } 8116 /* compute dofs splitting and neumann boundaries for coarse dofs */ 8117 nedcfield = -1; 8118 corners = NULL; 8119 if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneded computations */ 8120 PetscInt *tidxs,*tidxs2,nout,tsize,i; 8121 const PetscInt *idxs; 8122 ISLocalToGlobalMapping tmap; 8123 8124 /* create map between primal indices (in local representative ordering) and local primal numbering */ 8125 ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr); 8126 /* allocate space for temporary storage */ 8127 ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr); 8128 ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr); 8129 /* allocate for IS array */ 8130 nisdofs = pcbddc->n_ISForDofsLocal; 8131 if (pcbddc->nedclocal) { 8132 if (pcbddc->nedfield > -1) { 8133 nedcfield = pcbddc->nedfield; 8134 } else { 8135 nedcfield = 0; 8136 if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs); 8137 nisdofs = 1; 8138 } 8139 } 8140 nisneu = !!pcbddc->NeumannBoundariesLocal; 8141 nisvert = 0; /* nisvert is not used */ 8142 nis = nisdofs + nisneu + nisvert; 8143 ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr); 8144 /* dofs splitting */ 8145 for (i=0;i<nisdofs;i++) { 8146 /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */ 8147 if (nedcfield != i) { 8148 ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr); 8149 ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr); 8150 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8151 ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr); 8152 } else { 8153 ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr); 8154 ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr); 8155 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8156 if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout); 8157 ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr); 8158 } 8159 ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr); 8160 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr); 8161 /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */ 8162 } 8163 /* neumann boundaries */ 8164 if (pcbddc->NeumannBoundariesLocal) { 8165 /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */ 8166 ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr); 8167 ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 8168 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8169 ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 8170 ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr); 8171 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr); 8172 /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */ 8173 } 8174 /* coordinates */ 8175 if (pcbddc->corner_selected) { 8176 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr); 8177 ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr); 8178 ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr); 8179 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8180 if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout); 8181 ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr); 8182 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr); 8183 ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr); 8184 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr); 8185 } 8186 ierr = PetscFree(tidxs);CHKERRQ(ierr); 8187 ierr = PetscFree(tidxs2);CHKERRQ(ierr); 8188 ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr); 8189 } else { 8190 nis = 0; 8191 nisdofs = 0; 8192 nisneu = 0; 8193 nisvert = 0; 8194 isarray = NULL; 8195 } 8196 /* destroy no longer needed map */ 8197 ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr); 8198 8199 /* subassemble */ 8200 if (multilevel_allowed) { 8201 Vec vp[1]; 8202 PetscInt nvecs = 0; 8203 PetscBool reuse,reuser; 8204 8205 if (coarse_mat) reuse = PETSC_TRUE; 8206 else reuse = PETSC_FALSE; 8207 ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8208 vp[0] = NULL; 8209 if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */ 8210 ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr); 8211 ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr); 8212 ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr); 8213 nvecs = 1; 8214 8215 if (pcbddc->divudotp) { 8216 Mat B,loc_divudotp; 8217 Vec v,p; 8218 IS dummy; 8219 PetscInt np; 8220 8221 ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr); 8222 ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr); 8223 ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr); 8224 ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); 8225 ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr); 8226 ierr = VecSet(p,1.);CHKERRQ(ierr); 8227 ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr); 8228 ierr = VecDestroy(&p);CHKERRQ(ierr); 8229 ierr = MatDestroy(&B);CHKERRQ(ierr); 8230 ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr); 8231 ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr); 8232 ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr); 8233 ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr); 8234 ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr); 8235 ierr = ISDestroy(&dummy);CHKERRQ(ierr); 8236 ierr = VecDestroy(&v);CHKERRQ(ierr); 8237 } 8238 } 8239 if (reuser) { 8240 ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr); 8241 } else { 8242 ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr); 8243 } 8244 if (vp[0]) { /* vp[0] could have been placed on a different set of processes */ 8245 PetscScalar *arraym,*arrayv; 8246 PetscInt nl; 8247 ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr); 8248 ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr); 8249 ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr); 8250 ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr); 8251 ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr); 8252 ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr); 8253 ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr); 8254 ierr = VecDestroy(&vp[0]);CHKERRQ(ierr); 8255 } else { 8256 ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr); 8257 } 8258 } else { 8259 ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr); 8260 } 8261 if (coarse_mat_is || coarse_mat) { 8262 if (!multilevel_allowed) { 8263 ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr); 8264 } else { 8265 Mat A; 8266 8267 /* if this matrix is present, it means we are not reusing the coarse matrix */ 8268 if (coarse_mat_is) { 8269 if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen"); 8270 ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr); 8271 coarse_mat = coarse_mat_is; 8272 } 8273 /* be sure we don't have MatSeqDENSE as local mat */ 8274 ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr); 8275 ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr); 8276 } 8277 } 8278 ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr); 8279 ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr); 8280 8281 /* create local to global scatters for coarse problem */ 8282 if (compute_vecs) { 8283 PetscInt lrows; 8284 ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 8285 if (coarse_mat) { 8286 ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr); 8287 } else { 8288 lrows = 0; 8289 } 8290 ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr); 8291 ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr); 8292 ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr); 8293 ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 8294 ierr = VecScatterCreateWithData(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 8295 } 8296 ierr = ISDestroy(&coarse_is);CHKERRQ(ierr); 8297 8298 /* set defaults for coarse KSP and PC */ 8299 if (multilevel_allowed) { 8300 coarse_ksp_type = KSPRICHARDSON; 8301 coarse_pc_type = PCBDDC; 8302 } else { 8303 coarse_ksp_type = KSPPREONLY; 8304 coarse_pc_type = PCREDUNDANT; 8305 } 8306 8307 /* print some info if requested */ 8308 if (pcbddc->dbg_flag) { 8309 if (!multilevel_allowed) { 8310 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 8311 if (multilevel_requested) { 8312 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %D (active processes %D, coarsening ratio %D)\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr); 8313 } else if (pcbddc->max_levels) { 8314 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr); 8315 } 8316 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8317 } 8318 } 8319 8320 /* communicate coarse discrete gradient */ 8321 coarseG = NULL; 8322 if (pcbddc->nedcG && multilevel_allowed) { 8323 MPI_Comm ccomm; 8324 if (coarse_mat) { 8325 ccomm = PetscObjectComm((PetscObject)coarse_mat); 8326 } else { 8327 ccomm = MPI_COMM_NULL; 8328 } 8329 ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr); 8330 } 8331 8332 /* create the coarse KSP object only once with defaults */ 8333 if (coarse_mat) { 8334 PetscBool isredundant,isnn,isbddc; 8335 PetscViewer dbg_viewer = NULL; 8336 8337 if (pcbddc->dbg_flag) { 8338 dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat)); 8339 ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr); 8340 } 8341 if (!pcbddc->coarse_ksp) { 8342 char prefix[256],str_level[16]; 8343 size_t len; 8344 8345 ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr); 8346 ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr); 8347 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr); 8348 ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr); 8349 ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr); 8350 ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr); 8351 ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr); 8352 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 8353 /* TODO is this logic correct? should check for coarse_mat type */ 8354 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 8355 /* prefix */ 8356 ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr); 8357 ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr); 8358 if (!pcbddc->current_level) { 8359 ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr); 8360 ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr); 8361 } else { 8362 ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr); 8363 if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */ 8364 if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */ 8365 /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */ 8366 ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr); 8367 ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr); 8368 ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr); 8369 } 8370 ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr); 8371 /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */ 8372 ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr); 8373 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 8374 ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 8375 /* allow user customization */ 8376 ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr); 8377 /* get some info after set from options */ 8378 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 8379 /* multilevel cannot be done with coarse PCs different from BDDC or NN */ 8380 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 8381 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr); 8382 if (multilevel_allowed && !isbddc && !isnn) { 8383 isbddc = PETSC_TRUE; 8384 ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr); 8385 ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr); 8386 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 8387 ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 8388 if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */ 8389 ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr); 8390 ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr); 8391 ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr); 8392 ierr = PetscOptionsEnd();CHKERRQ(ierr); 8393 pc_temp->setfromoptionscalled++; 8394 } 8395 } 8396 } 8397 /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */ 8398 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 8399 if (nisdofs) { 8400 ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr); 8401 for (i=0;i<nisdofs;i++) { 8402 ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr); 8403 } 8404 } 8405 if (nisneu) { 8406 ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr); 8407 ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr); 8408 } 8409 if (nisvert) { 8410 ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr); 8411 ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr); 8412 } 8413 if (coarseG) { 8414 ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 8415 } 8416 8417 /* get some info after set from options */ 8418 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 8419 8420 /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */ 8421 if (isbddc && !multilevel_allowed) { 8422 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 8423 isbddc = PETSC_FALSE; 8424 } 8425 /* multilevel cannot be done with coarse PCs different from BDDC or NN */ 8426 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr); 8427 if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) { 8428 ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr); 8429 isbddc = PETSC_TRUE; 8430 } 8431 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr); 8432 if (isredundant) { 8433 KSP inner_ksp; 8434 PC inner_pc; 8435 8436 ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr); 8437 ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr); 8438 } 8439 8440 /* parameters which miss an API */ 8441 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 8442 if (isbddc) { 8443 PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data; 8444 8445 pcbddc_coarse->detect_disconnected = PETSC_TRUE; 8446 pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc; 8447 pcbddc_coarse->coarse_eqs_limit = pcbddc->coarse_eqs_limit; 8448 pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null; 8449 if (pcbddc_coarse->benign_saddle_point) { 8450 Mat coarsedivudotp_is; 8451 ISLocalToGlobalMapping l2gmap,rl2g,cl2g; 8452 IS row,col; 8453 const PetscInt *gidxs; 8454 PetscInt n,st,M,N; 8455 8456 ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr); 8457 ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr); 8458 st = st-n; 8459 ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr); 8460 ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr); 8461 ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr); 8462 ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr); 8463 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr); 8464 ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr); 8465 ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr); 8466 ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr); 8467 ierr = ISGetSize(row,&M);CHKERRQ(ierr); 8468 ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr); 8469 ierr = ISDestroy(&row);CHKERRQ(ierr); 8470 ierr = ISDestroy(&col);CHKERRQ(ierr); 8471 ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr); 8472 ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr); 8473 ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); 8474 ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr); 8475 ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr); 8476 ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr); 8477 ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr); 8478 ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr); 8479 ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr); 8480 ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr); 8481 pcbddc_coarse->adaptive_userdefined = PETSC_TRUE; 8482 if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE; 8483 } 8484 } 8485 8486 /* propagate symmetry info of coarse matrix */ 8487 ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr); 8488 if (pc->pmat->symmetric_set) { 8489 ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr); 8490 } 8491 if (pc->pmat->hermitian_set) { 8492 ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr); 8493 } 8494 if (pc->pmat->spd_set) { 8495 ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr); 8496 } 8497 if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) { 8498 ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr); 8499 } 8500 /* set operators */ 8501 ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr); 8502 ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr); 8503 ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr); 8504 if (pcbddc->dbg_flag) { 8505 ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr); 8506 } 8507 } 8508 ierr = MatDestroy(&coarseG);CHKERRQ(ierr); 8509 ierr = PetscFree(isarray);CHKERRQ(ierr); 8510 #if 0 8511 { 8512 PetscViewer viewer; 8513 char filename[256]; 8514 sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level); 8515 ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr); 8516 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 8517 ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr); 8518 ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); 8519 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 8520 } 8521 #endif 8522 8523 if (corners) { 8524 Vec gv; 8525 IS is; 8526 const PetscInt *idxs; 8527 PetscInt i,d,N,n,cdim = pcbddc->mat_graph->cdim; 8528 PetscScalar *coords; 8529 8530 if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates"); 8531 ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr); 8532 ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr); 8533 ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr); 8534 ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr); 8535 ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr); 8536 ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr); 8537 ierr = VecSetFromOptions(gv);CHKERRQ(ierr); 8538 ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */ 8539 8540 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr); 8541 ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr); 8542 ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr); 8543 ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr); 8544 for (i=0;i<n;i++) { 8545 for (d=0;d<cdim;d++) { 8546 coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d]; 8547 } 8548 } 8549 ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr); 8550 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr); 8551 8552 ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr); 8553 ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr); 8554 ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr); 8555 ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr); 8556 ierr = PetscFree(coords);CHKERRQ(ierr); 8557 ierr = VecAssemblyBegin(gv);CHKERRQ(ierr); 8558 ierr = VecAssemblyEnd(gv);CHKERRQ(ierr); 8559 ierr = VecGetArray(gv,&coords);CHKERRQ(ierr); 8560 if (pcbddc->coarse_ksp) { 8561 PC coarse_pc; 8562 PetscBool isbddc; 8563 8564 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 8565 ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr); 8566 if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */ 8567 PetscReal *realcoords; 8568 8569 ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr); 8570 #if defined(PETSC_USE_COMPLEX) 8571 ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr); 8572 for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]); 8573 #else 8574 realcoords = coords; 8575 #endif 8576 ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr); 8577 #if defined(PETSC_USE_COMPLEX) 8578 ierr = PetscFree(realcoords);CHKERRQ(ierr); 8579 #endif 8580 } 8581 } 8582 ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr); 8583 ierr = VecDestroy(&gv);CHKERRQ(ierr); 8584 } 8585 ierr = ISDestroy(&corners);CHKERRQ(ierr); 8586 8587 if (pcbddc->coarse_ksp) { 8588 Vec crhs,csol; 8589 8590 ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr); 8591 ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr); 8592 if (!csol) { 8593 ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr); 8594 } 8595 if (!crhs) { 8596 ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr); 8597 } 8598 } 8599 ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr); 8600 8601 /* compute null space for coarse solver if the benign trick has been requested */ 8602 if (pcbddc->benign_null) { 8603 8604 ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr); 8605 for (i=0;i<pcbddc->benign_n;i++) { 8606 ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr); 8607 } 8608 ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr); 8609 ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr); 8610 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8611 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8612 if (coarse_mat) { 8613 Vec nullv; 8614 PetscScalar *array,*array2; 8615 PetscInt nl; 8616 8617 ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr); 8618 ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr); 8619 ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr); 8620 ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr); 8621 ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr); 8622 ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr); 8623 ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr); 8624 ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr); 8625 ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr); 8626 ierr = VecDestroy(&nullv);CHKERRQ(ierr); 8627 } 8628 } 8629 ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8630 8631 ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8632 if (pcbddc->coarse_ksp) { 8633 PetscBool ispreonly; 8634 8635 if (CoarseNullSpace) { 8636 PetscBool isnull; 8637 ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr); 8638 if (isnull) { 8639 ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr); 8640 } 8641 /* TODO: add local nullspaces (if any) */ 8642 } 8643 /* setup coarse ksp */ 8644 ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr); 8645 /* Check coarse problem if in debug mode or if solving with an iterative method */ 8646 ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr); 8647 if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) { 8648 KSP check_ksp; 8649 KSPType check_ksp_type; 8650 PC check_pc; 8651 Vec check_vec,coarse_vec; 8652 PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0; 8653 PetscInt its; 8654 PetscBool compute_eigs; 8655 PetscReal *eigs_r,*eigs_c; 8656 PetscInt neigs; 8657 const char *prefix; 8658 8659 /* Create ksp object suitable for estimation of extreme eigenvalues */ 8660 ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr); 8661 ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr); 8662 ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr); 8663 ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr); 8664 ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr); 8665 /* prevent from setup unneeded object */ 8666 ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr); 8667 ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr); 8668 if (ispreonly) { 8669 check_ksp_type = KSPPREONLY; 8670 compute_eigs = PETSC_FALSE; 8671 } else { 8672 check_ksp_type = KSPGMRES; 8673 compute_eigs = PETSC_TRUE; 8674 } 8675 ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr); 8676 ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr); 8677 ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr); 8678 ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr); 8679 ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr); 8680 ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr); 8681 ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr); 8682 ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr); 8683 ierr = KSPSetUp(check_ksp);CHKERRQ(ierr); 8684 ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr); 8685 ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr); 8686 /* create random vec */ 8687 ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr); 8688 ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr); 8689 ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr); 8690 /* solve coarse problem */ 8691 ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr); 8692 ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr); 8693 /* set eigenvalue estimation if preonly has not been requested */ 8694 if (compute_eigs) { 8695 ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr); 8696 ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr); 8697 ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr); 8698 if (neigs) { 8699 lambda_max = eigs_r[neigs-1]; 8700 lambda_min = eigs_r[0]; 8701 if (pcbddc->use_coarse_estimates) { 8702 if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */ 8703 ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr); 8704 ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr); 8705 } 8706 } 8707 } 8708 } 8709 8710 /* check coarse problem residual error */ 8711 if (pcbddc->dbg_flag) { 8712 PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp)); 8713 ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr); 8714 ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr); 8715 ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 8716 ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr); 8717 ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr); 8718 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr); 8719 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr); 8720 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr); 8721 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error : %1.6e\n",infty_error);CHKERRQ(ierr); 8722 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr); 8723 if (CoarseNullSpace) { 8724 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr); 8725 } 8726 if (compute_eigs) { 8727 PetscReal lambda_max_s,lambda_min_s; 8728 KSPConvergedReason reason; 8729 ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr); 8730 ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr); 8731 ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr); 8732 ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr); 8733 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s, conv reason %d): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,reason,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr); 8734 for (i=0;i<neigs;i++) { 8735 ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr); 8736 } 8737 } 8738 ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr); 8739 ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr); 8740 } 8741 ierr = VecDestroy(&check_vec);CHKERRQ(ierr); 8742 ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr); 8743 ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr); 8744 if (compute_eigs) { 8745 ierr = PetscFree(eigs_r);CHKERRQ(ierr); 8746 ierr = PetscFree(eigs_c);CHKERRQ(ierr); 8747 } 8748 } 8749 } 8750 ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr); 8751 /* print additional info */ 8752 if (pcbddc->dbg_flag) { 8753 /* waits until all processes reaches this point */ 8754 ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr); 8755 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr); 8756 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8757 } 8758 8759 /* free memory */ 8760 ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr); 8761 ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8762 PetscFunctionReturn(0); 8763 } 8764 8765 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n) 8766 { 8767 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 8768 PC_IS* pcis = (PC_IS*)pc->data; 8769 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 8770 IS subset,subset_mult,subset_n; 8771 PetscInt local_size,coarse_size=0; 8772 PetscInt *local_primal_indices=NULL; 8773 const PetscInt *t_local_primal_indices; 8774 PetscErrorCode ierr; 8775 8776 PetscFunctionBegin; 8777 /* Compute global number of coarse dofs */ 8778 if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first"); 8779 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr); 8780 ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr); 8781 ierr = ISDestroy(&subset_n);CHKERRQ(ierr); 8782 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr); 8783 ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr); 8784 ierr = ISDestroy(&subset);CHKERRQ(ierr); 8785 ierr = ISDestroy(&subset_mult);CHKERRQ(ierr); 8786 ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr); 8787 if (local_size != pcbddc->local_primal_size) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid number of local primal indices computed %D != %D",local_size,pcbddc->local_primal_size); 8788 ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr); 8789 ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr); 8790 ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr); 8791 ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr); 8792 ierr = ISDestroy(&subset_n);CHKERRQ(ierr); 8793 8794 /* check numbering */ 8795 if (pcbddc->dbg_flag) { 8796 PetscScalar coarsesum,*array,*array2; 8797 PetscInt i; 8798 PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE; 8799 8800 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8801 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 8802 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr); 8803 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 8804 /* counter */ 8805 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 8806 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 8807 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8808 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8809 ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8810 ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8811 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 8812 for (i=0;i<pcbddc->local_primal_size;i++) { 8813 ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 8814 } 8815 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 8816 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 8817 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 8818 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8819 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8820 ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8821 ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8822 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 8823 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 8824 for (i=0;i<pcis->n;i++) { 8825 if (array[i] != 0.0 && array[i] != array2[i]) { 8826 PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi; 8827 PetscInt neigh = (PetscInt)PetscRealPart(array2[i]); 8828 set_error = PETSC_TRUE; 8829 ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr); 8830 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %D (gid %D) owned by %D processes instead of %D!\n",PetscGlobalRank,i,gi,owned,neigh);CHKERRQ(ierr); 8831 } 8832 } 8833 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 8834 ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8835 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8836 for (i=0;i<pcis->n;i++) { 8837 if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]); 8838 } 8839 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 8840 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 8841 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8842 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8843 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 8844 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr); 8845 if (pcbddc->dbg_flag > 1 || set_error_reduced) { 8846 PetscInt *gidxs; 8847 8848 ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr); 8849 ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr); 8850 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr); 8851 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8852 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 8853 for (i=0;i<pcbddc->local_primal_size;i++) { 8854 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%D]=%D (%D,%D)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i],gidxs[i]);CHKERRQ(ierr); 8855 } 8856 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8857 ierr = PetscFree(gidxs);CHKERRQ(ierr); 8858 } 8859 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8860 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 8861 if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed"); 8862 } 8863 8864 /* get back data */ 8865 *coarse_size_n = coarse_size; 8866 *local_primal_indices_n = local_primal_indices; 8867 PetscFunctionReturn(0); 8868 } 8869 8870 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis) 8871 { 8872 IS localis_t; 8873 PetscInt i,lsize,*idxs,n; 8874 PetscScalar *vals; 8875 PetscErrorCode ierr; 8876 8877 PetscFunctionBegin; 8878 /* get indices in local ordering exploiting local to global map */ 8879 ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr); 8880 ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr); 8881 for (i=0;i<lsize;i++) vals[i] = 1.0; 8882 ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr); 8883 ierr = VecSet(gwork,0.0);CHKERRQ(ierr); 8884 ierr = VecSet(lwork,0.0);CHKERRQ(ierr); 8885 if (idxs) { /* multilevel guard */ 8886 ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr); 8887 ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 8888 } 8889 ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr); 8890 ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr); 8891 ierr = PetscFree(vals);CHKERRQ(ierr); 8892 ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr); 8893 /* now compute set in local ordering */ 8894 ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8895 ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8896 ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr); 8897 ierr = VecGetSize(lwork,&n);CHKERRQ(ierr); 8898 for (i=0,lsize=0;i<n;i++) { 8899 if (PetscRealPart(vals[i]) > 0.5) { 8900 lsize++; 8901 } 8902 } 8903 ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr); 8904 for (i=0,lsize=0;i<n;i++) { 8905 if (PetscRealPart(vals[i]) > 0.5) { 8906 idxs[lsize++] = i; 8907 } 8908 } 8909 ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr); 8910 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr); 8911 *localis = localis_t; 8912 PetscFunctionReturn(0); 8913 } 8914 8915 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc) 8916 { 8917 PC_IS *pcis=(PC_IS*)pc->data; 8918 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 8919 PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs; 8920 Mat S_j; 8921 PetscInt *used_xadj,*used_adjncy; 8922 PetscBool free_used_adj; 8923 PetscErrorCode ierr; 8924 8925 PetscFunctionBegin; 8926 ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8927 /* decide the adjacency to be used for determining internal problems for local schur on subsets */ 8928 free_used_adj = PETSC_FALSE; 8929 if (pcbddc->sub_schurs_layers == -1) { 8930 used_xadj = NULL; 8931 used_adjncy = NULL; 8932 } else { 8933 if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) { 8934 used_xadj = pcbddc->mat_graph->xadj; 8935 used_adjncy = pcbddc->mat_graph->adjncy; 8936 } else if (pcbddc->computed_rowadj) { 8937 used_xadj = pcbddc->mat_graph->xadj; 8938 used_adjncy = pcbddc->mat_graph->adjncy; 8939 } else { 8940 PetscBool flg_row=PETSC_FALSE; 8941 const PetscInt *xadj,*adjncy; 8942 PetscInt nvtxs; 8943 8944 ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 8945 if (flg_row) { 8946 ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr); 8947 ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr); 8948 ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr); 8949 free_used_adj = PETSC_TRUE; 8950 } else { 8951 pcbddc->sub_schurs_layers = -1; 8952 used_xadj = NULL; 8953 used_adjncy = NULL; 8954 } 8955 ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 8956 } 8957 } 8958 8959 /* setup sub_schurs data */ 8960 ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr); 8961 if (!sub_schurs->schur_explicit) { 8962 /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */ 8963 ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr); 8964 ierr = PCBDDCSubSchursSetUp(sub_schurs,NULL,S_j,PETSC_FALSE,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,NULL,pcbddc->adaptive_selection,PETSC_FALSE,PETSC_FALSE,0,NULL,NULL,NULL,NULL);CHKERRQ(ierr); 8965 } else { 8966 Mat change = NULL; 8967 Vec scaling = NULL; 8968 IS change_primal = NULL, iP; 8969 PetscInt benign_n; 8970 PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis; 8971 PetscBool isseqaij,need_change = PETSC_FALSE; 8972 PetscBool discrete_harmonic = PETSC_FALSE; 8973 8974 if (!pcbddc->use_vertices && reuse_solvers) { 8975 PetscInt n_vertices; 8976 8977 ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr); 8978 reuse_solvers = (PetscBool)!n_vertices; 8979 } 8980 ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 8981 if (!isseqaij) { 8982 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 8983 if (matis->A == pcbddc->local_mat) { 8984 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 8985 ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 8986 } else { 8987 ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 8988 } 8989 } 8990 if (!pcbddc->benign_change_explicit) { 8991 benign_n = pcbddc->benign_n; 8992 } else { 8993 benign_n = 0; 8994 } 8995 /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc. 8996 We need a global reduction to avoid possible deadlocks. 8997 We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */ 8998 if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) { 8999 PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change); 9000 ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 9001 need_change = (PetscBool)(!need_change); 9002 } 9003 /* If the user defines additional constraints, we import them here. 9004 We need to compute the change of basis according to the quadrature weights attached to pmat via MatSetNearNullSpace, and this could not be done (at the moment) without some hacking */ 9005 if (need_change) { 9006 PC_IS *pcisf; 9007 PC_BDDC *pcbddcf; 9008 PC pcf; 9009 9010 if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph"); 9011 ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr); 9012 ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr); 9013 ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr); 9014 9015 /* hacks */ 9016 pcisf = (PC_IS*)pcf->data; 9017 pcisf->is_B_local = pcis->is_B_local; 9018 pcisf->vec1_N = pcis->vec1_N; 9019 pcisf->BtoNmap = pcis->BtoNmap; 9020 pcisf->n = pcis->n; 9021 pcisf->n_B = pcis->n_B; 9022 pcbddcf = (PC_BDDC*)pcf->data; 9023 ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr); 9024 pcbddcf->mat_graph = pcbddc->mat_graph; 9025 pcbddcf->use_faces = PETSC_TRUE; 9026 pcbddcf->use_change_of_basis = PETSC_TRUE; 9027 pcbddcf->use_change_on_faces = PETSC_TRUE; 9028 pcbddcf->use_qr_single = PETSC_TRUE; 9029 pcbddcf->fake_change = PETSC_TRUE; 9030 9031 /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */ 9032 ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr); 9033 sub_schurs->change_with_qr = pcbddcf->use_qr_single; 9034 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr); 9035 change = pcbddcf->ConstraintMatrix; 9036 pcbddcf->ConstraintMatrix = NULL; 9037 9038 /* free unneeded memory allocated in PCBDDCConstraintsSetUp */ 9039 ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr); 9040 ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr); 9041 ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr); 9042 ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr); 9043 ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr); 9044 ierr = PetscFree(pcf->data);CHKERRQ(ierr); 9045 pcf->ops->destroy = NULL; 9046 pcf->ops->reset = NULL; 9047 ierr = PCDestroy(&pcf);CHKERRQ(ierr); 9048 } 9049 if (!pcbddc->use_deluxe_scaling) scaling = pcis->D; 9050 9051 ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr); 9052 if (iP) { 9053 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr); 9054 ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr); 9055 ierr = PetscOptionsEnd();CHKERRQ(ierr); 9056 } 9057 if (discrete_harmonic) { 9058 Mat A; 9059 ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr); 9060 ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr); 9061 ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr); 9062 ierr = PCBDDCSubSchursSetUp(sub_schurs,A,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal);CHKERRQ(ierr); 9063 ierr = MatDestroy(&A);CHKERRQ(ierr); 9064 } else { 9065 ierr = PCBDDCSubSchursSetUp(sub_schurs,pcbddc->local_mat,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal);CHKERRQ(ierr); 9066 } 9067 ierr = MatDestroy(&change);CHKERRQ(ierr); 9068 ierr = ISDestroy(&change_primal);CHKERRQ(ierr); 9069 } 9070 ierr = MatDestroy(&S_j);CHKERRQ(ierr); 9071 9072 /* free adjacency */ 9073 if (free_used_adj) { 9074 ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr); 9075 } 9076 ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 9077 PetscFunctionReturn(0); 9078 } 9079 9080 PetscErrorCode PCBDDCInitSubSchurs(PC pc) 9081 { 9082 PC_IS *pcis=(PC_IS*)pc->data; 9083 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 9084 PCBDDCGraph graph; 9085 PetscErrorCode ierr; 9086 9087 PetscFunctionBegin; 9088 /* attach interface graph for determining subsets */ 9089 if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */ 9090 IS verticesIS,verticescomm; 9091 PetscInt vsize,*idxs; 9092 9093 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr); 9094 ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr); 9095 ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr); 9096 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr); 9097 ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr); 9098 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr); 9099 ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr); 9100 ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr); 9101 ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr); 9102 ierr = ISDestroy(&verticescomm);CHKERRQ(ierr); 9103 ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr); 9104 } else { 9105 graph = pcbddc->mat_graph; 9106 } 9107 /* print some info */ 9108 if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) { 9109 IS vertices; 9110 PetscInt nv,nedges,nfaces; 9111 ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr); 9112 ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr); 9113 ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr); 9114 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 9115 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 9116 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr); 9117 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr); 9118 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr); 9119 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 9120 ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 9121 ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr); 9122 } 9123 9124 /* sub_schurs init */ 9125 if (!pcbddc->sub_schurs) { 9126 ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr); 9127 } 9128 ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr); 9129 9130 /* free graph struct */ 9131 if (pcbddc->sub_schurs_rebuild) { 9132 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 9133 } 9134 PetscFunctionReturn(0); 9135 } 9136 9137 PetscErrorCode PCBDDCCheckOperator(PC pc) 9138 { 9139 PC_IS *pcis=(PC_IS*)pc->data; 9140 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 9141 PetscErrorCode ierr; 9142 9143 PetscFunctionBegin; 9144 if (pcbddc->n_vertices == pcbddc->local_primal_size) { 9145 IS zerodiag = NULL; 9146 Mat S_j,B0_B=NULL; 9147 Vec dummy_vec=NULL,vec_check_B,vec_scale_P; 9148 PetscScalar *p0_check,*array,*array2; 9149 PetscReal norm; 9150 PetscInt i; 9151 9152 /* B0 and B0_B */ 9153 if (zerodiag) { 9154 IS dummy; 9155 9156 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr); 9157 ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr); 9158 ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr); 9159 ierr = ISDestroy(&dummy);CHKERRQ(ierr); 9160 } 9161 /* I need a primal vector to scale primal nodes since BDDC sums contibutions */ 9162 ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr); 9163 ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr); 9164 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9165 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9166 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9167 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9168 ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr); 9169 /* S_j */ 9170 ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr); 9171 ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr); 9172 9173 /* mimic vector in \widetilde{W}_\Gamma */ 9174 ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr); 9175 /* continuous in primal space */ 9176 ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr); 9177 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9178 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9179 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9180 ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr); 9181 for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i]; 9182 ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr); 9183 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9184 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 9185 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 9186 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9187 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9188 ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr); 9189 ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr); 9190 9191 /* assemble rhs for coarse problem */ 9192 /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */ 9193 /* local with Schur */ 9194 ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr); 9195 if (zerodiag) { 9196 ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr); 9197 for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i]; 9198 ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr); 9199 ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 9200 } 9201 /* sum on primal nodes the local contributions */ 9202 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9203 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9204 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 9205 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 9206 for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]]; 9207 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 9208 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 9209 ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr); 9210 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9211 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9212 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9213 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9214 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9215 /* scale primal nodes (BDDC sums contibutions) */ 9216 ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr); 9217 ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr); 9218 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9219 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 9220 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 9221 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9222 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9223 /* global: \widetilde{B0}_B w_\Gamma */ 9224 if (zerodiag) { 9225 ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr); 9226 ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr); 9227 for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i]; 9228 ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr); 9229 } 9230 /* BDDC */ 9231 ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr); 9232 ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr); 9233 9234 ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr); 9235 ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr); 9236 ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr); 9237 ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr); 9238 for (i=0;i<pcbddc->benign_n;i++) { 9239 ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%D] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));CHKERRQ(ierr); 9240 } 9241 ierr = PetscFree(p0_check);CHKERRQ(ierr); 9242 ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr); 9243 ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr); 9244 ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr); 9245 ierr = MatDestroy(&S_j);CHKERRQ(ierr); 9246 ierr = MatDestroy(&B0_B);CHKERRQ(ierr); 9247 } 9248 PetscFunctionReturn(0); 9249 } 9250 9251 #include <../src/mat/impls/aij/mpi/mpiaij.h> 9252 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B) 9253 { 9254 Mat At; 9255 IS rows; 9256 PetscInt rst,ren; 9257 PetscErrorCode ierr; 9258 PetscLayout rmap; 9259 9260 PetscFunctionBegin; 9261 rst = ren = 0; 9262 if (ccomm != MPI_COMM_NULL) { 9263 ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr); 9264 ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr); 9265 ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr); 9266 ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr); 9267 ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr); 9268 } 9269 ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr); 9270 ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr); 9271 ierr = ISDestroy(&rows);CHKERRQ(ierr); 9272 9273 if (ccomm != MPI_COMM_NULL) { 9274 Mat_MPIAIJ *a,*b; 9275 IS from,to; 9276 Vec gvec; 9277 PetscInt lsize; 9278 9279 ierr = MatCreate(ccomm,B);CHKERRQ(ierr); 9280 ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr); 9281 ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr); 9282 ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr); 9283 ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr); 9284 a = (Mat_MPIAIJ*)At->data; 9285 b = (Mat_MPIAIJ*)(*B)->data; 9286 ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr); 9287 ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr); 9288 ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr); 9289 ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr); 9290 b->A = a->A; 9291 b->B = a->B; 9292 9293 b->donotstash = a->donotstash; 9294 b->roworiented = a->roworiented; 9295 b->rowindices = 0; 9296 b->rowvalues = 0; 9297 b->getrowactive = PETSC_FALSE; 9298 9299 (*B)->rmap = rmap; 9300 (*B)->factortype = A->factortype; 9301 (*B)->assembled = PETSC_TRUE; 9302 (*B)->insertmode = NOT_SET_VALUES; 9303 (*B)->preallocated = PETSC_TRUE; 9304 9305 if (a->colmap) { 9306 #if defined(PETSC_USE_CTABLE) 9307 ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr); 9308 #else 9309 ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr); 9310 ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr); 9311 ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr); 9312 #endif 9313 } else b->colmap = 0; 9314 if (a->garray) { 9315 PetscInt len; 9316 len = a->B->cmap->n; 9317 ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr); 9318 ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr); 9319 if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); } 9320 } else b->garray = 0; 9321 9322 ierr = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr); 9323 b->lvec = a->lvec; 9324 ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr); 9325 9326 /* cannot use VecScatterCopy */ 9327 ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr); 9328 ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr); 9329 ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr); 9330 ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr); 9331 ierr = VecScatterCreateWithData(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr); 9332 ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr); 9333 ierr = ISDestroy(&from);CHKERRQ(ierr); 9334 ierr = ISDestroy(&to);CHKERRQ(ierr); 9335 ierr = VecDestroy(&gvec);CHKERRQ(ierr); 9336 } 9337 ierr = MatDestroy(&At);CHKERRQ(ierr); 9338 PetscFunctionReturn(0); 9339 } 9340